GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-28 22:12:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

more automatic creation of files in CheckDict ; words for translation in DictionaryFre

Browse Source
This commit is contained in:
aarne
2014-04-10 07:06:57 +00:00
parent 37c473a559
commit 4b34c51e4c
2 changed files with 21 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
lib/src/translator/CheckDict.hs
View File

@@ -1,20 +1,27 @@
import qualified Data.Map
import Data.List
createConcrete lang = do
bnc <- readFile "bnc-to-check.txt" >>= return . words -- list of BNC funs
dict <- readFile (gfFile "Dictionary" lang) >>= return . map words . lines -- current lang lexicon
let dictmap = Data.Map.fromList [(f,unwords ws) | "lin":f:"=":ws <- dict]
let bncdict = [(f,maybe "variants{} ;" id $ Data.Map.lookup f dictmap) | f <- bnc] -- current lang for BNC
writeFile (gfFile "todo/TopDict" lang) $ unlines [unwords ("lin":f:"=":[ws]) | (f,ws) <- bncdict] -- print inspectable file
bnc <- readFile "bnc-to-check.txt" >>= return . words -- list of BNC funs
dict <- readFile (gfFile "Dictionary" lang) >>= return . lines -- current lang lexicon
let header = getHeader dict
let dictmap = Data.Map.fromList [(f,unwords ws) | "lin":f:"=":ws <- map words dict]
let bncdict = [(f,maybe "variants{} ;" id $ Data.Map.lookup f dictmap) | f <- bnc] -- current lang for BNC
writeFile (gfFile "todo/tmp/Dictionary" lang) $
unlines $ header ++ [unwords ("lin":f:"=":[ws]) | (f,ws) <- bncdict] ++ ["}"] -- print inspectable file, to todo/tmp/
gfFile body lang = body ++ lang ++ ".gf"
mergeDict lang = do
old <- readFile (gfFile "Dictionary" lang) >>= return . map words . lines -- read old lexicon
new <- readFile "corrects.txt" >>= return . map words . lines -- read corrected and new words
let oldmap = Data.Map.fromList [(f,unwords ws) | "lin":f:"=":ws <- old]
let newlist = [(f,unwords (takeWhile (/= "--") ws)) | "lin":f:"=":ws <- new] -- drop comments from corrected words
let newmap = foldr (uncurry Data.Map.insert) oldmap newlist -- insert corrected words
writeFile "newdict.txt" $ unlines [unwords ("lin":f:"=":[ws]) | (f,ws) <- Data.Map.assocs newmap] -- print lin rules
old <- readFile (gfFile "Dictionary" lang) >>= return . lines -- read old lexicon
new <- readFile (gfFile "todo/Dictionary" lang) >>= return . lines -- read corrected and new words
let header = getHeader new
let oldmap = Data.Map.fromList [(f,unwords ws) | "lin":f:"=":ws <- map words old]
let newlist = [(f,unwords (takeWhile (/= "--") ws)) | "lin":f:"=":ws <- map words new] -- drop comments from corrected words
let newmap = foldr (uncurry Data.Map.insert) oldmap newlist -- insert corrected words
writeFile (gfFile "tmp/Dictionary" lang) $
unlines $ header ++ [unwords ("lin":f:"=":[ws]) | (f,ws) <- Data.Map.assocs newmap] ++ ["}"] -- print revised file to tmp/
-- get the part of Dict before the first lin rule
getHeader = takeWhile ((/= "lin") . take 3)