module Main where import Data.List import Data.Ord (comparing) main = docExtend docExtend = do -- read the abstract syntax file funds <- readFile "../src/abstract/Extend.gf" >>= return . map words . lines -- function format: -- GenNP : NP -> Quant ; -- this man's let funs = [[fu,unwords ty,unwords co] | fu:":":ws <- funds, (ty,_:_:co) <- [break (==";") ws]] --- mapM print funs -- read the concrete syntax functor funcs <- readFile "../src/common/ExtendFunctor.gf" >>= return . map words . lines -- definition format: one of -- GenNP = variants {} ; -- NP -> Quant ; -- this man's -- UttDatIP ip = UttAccIP (lin IP ip) ; -- whom (dative) ; DEFAULT who let defs = [[[fu],de,co] | fuws <- funcs, (fu:_,_:ws) <- [break (=="=") fuws], (de,_:_:co) <- [break (==";") ws]] let undef de co = if de == ["variants", "{}"] then "-" else unwords (tail (dropWhile (/="DEFAULT") co)) let fundefs = [[fu,ty,co,undef d c] | fu:ty:co:_ <- funs, [f]:d:c:_ <- defs, f==fu] --- mapM print fundefs -- read the functor exclusion lists for each language let langs = [("Eng","english"),("Dut","dutch"),("Spa","spanish"),("Swe","swedish")] funss <- mapM getExclusions langs --- mapM_ print funss let langfuns = zip (map fst langs) funss let funlangs = [(fu,[lang | (lang,fs) <- langfuns, elem fu fs]) | fu:_ <- funs] let fundeflangs = [[fu,ty,co,de,unwords ls] | fu:ty:co:de:_ <- fundefs, (f,ls) <- funlangs, f==fu] --- mapM print fundeflangs writeFile "GF-RGL-Extend.html" $ printHTML $ sortBy (comparing (\z -> (last (words (z !! 1)), z!!0))) fundeflangs putStrLn "wrote file GF-RGL-Extend.html" -- exclusion format: -- concrete ExtendEng of Extend = -- CatEng ** ExtendFunctor - -- [ -- VPS, ListVPS, RNP, RNPList --- lines between the first [ and ] lines are read -- ] getExclusions (lan,language) = do rs <- readFile ("../src/" ++ language ++ "/Extend" ++ lan ++ ".gf") >>= return . map words . lines let excls = case dropWhile (/=["["]) rs of [] -> [] _:es -> map (filter (/=',')) $ concat $ takeWhile (/= ["]"]) es return excls printHTML fs = unlines $ "" : "" : "" : map prRow fs ++ [ "
", "", "" ] where prRow ss = concat $ "" : ["" ++ s ++ "" | s <- ss] ++ [""]