mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 13:09:33 -06:00
58 lines
2.4 KiB
Haskell
58 lines
2.4 KiB
Haskell
import System.Process(system)
|
|
import qualified Data.Map as M
|
|
import qualified Data.Set as S
|
|
import Data.List
|
|
|
|
|
|
-- building a table of RGL functions and their types, examples, and documentation
|
|
-- to run:
|
|
-- $ runghc AbsFunDoc.hs >absfuns.txt
|
|
-- $ txt2tags -thtml absfuns.txt
|
|
-- this creates the file absfuns.html
|
|
|
|
main = do
|
|
system "grep \" : \" ../src/abstract/*.gf ../src/translator/Extensions.gf | grep \" -- \" >absfuns.tmp"
|
|
funs <- readFile "absfuns.tmp" >>= return . lines
|
|
deps <- readFile "../src/uddeps.labels" >>= return . lines
|
|
let depmap = M.fromListWith (\x y -> x ++ [";"] ++ y) [(fun,deps) | fun:deps <- map words deps]
|
|
let rows = sort $ filter (flip S.notMember hiddenModules . last) $ map (mkRow depmap) (map words funs)
|
|
let entries = map (sepFields . addLink) rows
|
|
putStrLnIf $ "GF RGL Functions"
|
|
putStrLnIf $ "generated by lib/src/doc/AbsFunFoc.hs"
|
|
putStrLnIf $ "%%date"
|
|
putStrLnIf $ ""
|
|
putStrLnIf $ "Functions in this table have links, e.g. http://www.grammaticalframework.org/lib/doc/absfuns.html#PredVP"
|
|
putStrLn $ sepFields ["**Function**","**Type**","**Example**","**Dependencies**","**Module**"]
|
|
putStrLn $ unlines entries
|
|
|
|
|
|
hiddenModules = S.fromList
|
|
["Backward","Structural","Extra","Compatibility",
|
|
"Documentation","Lexicon","NumeralTransfer","Terminology","Transfer","MarkHTML","Markup","ERROR"] ----
|
|
|
|
mkRow depmap ws = case ws of
|
|
file:fun:":":typecomment -> named fun : getTypeComment typecomment ++ [getDep fun, getModule file]
|
|
_ -> ["ERROR"]
|
|
where
|
|
getModule = reverse . takeWhile (/='/') . tail . dropWhile (/='.') . reverse -- ../src/abstract/Adverb.gf: --> Adverb
|
|
getTypeComment ws = case span (/= ";") ws of
|
|
(ty,rest) -> [unwords ty, italics (unwords (drop 2 rest))] -- PredVP : NP -> VP -> Cl ; -- John walks
|
|
getDep fun = maybe "-" (unwords . takeWhile (/="--")) $ M.lookup fun depmap
|
|
|
|
-- for html (via txt2tags) generation
|
|
sepFields fs = "| " ++ concat (intersperse " | " fs) ++ " |"
|
|
named f = f ++ "''<a name=\"" ++ f ++ "\"></a>''"
|
|
italics e = "//" ++ map (\c -> case c of '[' -> '(' ; ']'->')'; _ -> c) e ++ "//"
|
|
putStrLnIf = putStrLn
|
|
addLink fs =
|
|
let m = last fs ; abstract = case m of "Extensions" -> "translator/" ; _ -> "abstract/"
|
|
in init fs ++ ["[" ++ m ++ " ../src/" ++ abstract ++ m ++ ".gf]"]
|
|
|
|
-- for tab separated generation
|
|
-- sepFields = concat . intersperse "\t"
|
|
-- named f = f
|
|
-- italics e = e
|
|
-- putStrLnIf = return ()
|
|
-- addLink fs = fs
|
|
|