mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-04 16:52:50 -06:00
123 lines
3.3 KiB
Haskell
123 lines
3.3 KiB
Haskell
import System
|
|
import Char
|
|
|
|
main = do
|
|
writeFile synopsis "GF Resource Grammar Library: Synopsis"
|
|
append "Aarne Ranta"
|
|
space
|
|
title "Categories"
|
|
space
|
|
link "Source 1:" commonAPI
|
|
space
|
|
link "Source 2:" catAPI
|
|
space
|
|
cs1 <- getCats True commonAPI
|
|
cs2 <- getCats False catAPI
|
|
delimit $ cs1 ++ cs2
|
|
space
|
|
title "Syntax Rules"
|
|
space
|
|
link "Source:" syntaxAPI
|
|
space
|
|
rs <- getRules syntaxAPI
|
|
delimit rs
|
|
space
|
|
title "Structural Words"
|
|
space
|
|
link "Source:" structuralAPI
|
|
space
|
|
rs <- getRules structuralAPI
|
|
delimit rs
|
|
space
|
|
mapM_ putParadigms paradigmFiles
|
|
space
|
|
title "Example Usage"
|
|
space
|
|
ss <- readFile "synopsis-example.txt" >>= return . lines
|
|
mapM_ append ss
|
|
space
|
|
system $ "txt2tags -thtml --toc " ++ synopsis
|
|
|
|
getCats isBeg file = do
|
|
ss <- readFile file >>= return . lines
|
|
return $ mkCatTable isBeg $ getrs [] ss
|
|
where
|
|
getrs rs ss = case ss of
|
|
('-':'-':'.':_):_ -> reverse rs
|
|
[] -> reverse rs
|
|
('-':'-':_):ss2 -> getrs rs ss2
|
|
s:ss2 -> case words s of
|
|
cat:";":"--":exp -> getrs ((cat,unwords expl, unwords (tail ex)):rs) ss2 where
|
|
(expl,ex) = span (/="e.g.") exp
|
|
_ -> getrs rs ss2
|
|
|
|
getRules file = do
|
|
ss <- readFile file >>= return . lines
|
|
return $ mkTable $ getrs [] ss
|
|
where
|
|
getrs rs ss = case ss of
|
|
('-':'-':'.':_):_ -> reverse rs
|
|
[] -> reverse rs
|
|
('-':'-':_):ss2 -> getrs rs ss2
|
|
s:ss2 -> case words s of
|
|
_:_:"overload":_ -> getrs rs ss2
|
|
_:":":_ -> getrs (layout s:rs) ss2
|
|
_ -> getrs rs ss2
|
|
layout s = " " ++ dropWhile isSpace s
|
|
|
|
putParadigms (lang,file) = do
|
|
title ("Paradigms for " ++ lang)
|
|
space
|
|
link "source" file
|
|
space
|
|
rs <- getRules file
|
|
space
|
|
delimit rs
|
|
space
|
|
|
|
|
|
mkTable rs = "|| Function | Type | Example ||" : map (unwords . row . words) rs where
|
|
row ws = ["|", name, "|", typ, "|", ex, "|"] where
|
|
name = ttf (head ws)
|
|
(t,e) = span (/="--") (tail ws)
|
|
typ = ttf (unwords $ filtype (drop 1 t))
|
|
ex = if null e then "-" else itf (unwords $ unnumber $ drop 1 e)
|
|
unnumber e = case e of
|
|
n:ws | last n == '.' && not (null (init n)) && all isDigit (init n) -> ws
|
|
_ -> e
|
|
filtype = filter (/=";")
|
|
|
|
mkCatTable isBeg rs =
|
|
(if isBeg then ("|| Category | Explanation | Example ||" :) else id)
|
|
(map mk1 rs)
|
|
where
|
|
mk1 (name,typ,ex) = unwords ["|", ttf name, "|", typ, "|", ex, "|"]
|
|
|
|
synopsis = "synopsis.txt"
|
|
commonAPI = "../abstract/Common.gf"
|
|
catAPI = "../abstract/Cat.gf"
|
|
syntaxAPI = "../api/Constructors.gf"
|
|
structuralAPI = "../abstract/Structural.gf"
|
|
paradigmFiles = [
|
|
("Danish", "../danish/ParadigmsDan.gf"),
|
|
("English", "../english/ParadigmsEng.gf"),
|
|
("Finnish", "../finnish/ParadigmsFin.gf"),
|
|
("French", "../french/ParadigmsFre.gf"),
|
|
("German", "../german/ParadigmsGer.gf"),
|
|
("Italian", "../italian/ParadigmsIta.gf"),
|
|
("Norwegian", "../norwegian/ParadigmsNor.gf"),
|
|
("Russian", "../russian/ParadigmsRus.gf"),
|
|
("Spanish", "../spanish/ParadigmsSpa.gf"),
|
|
("Swedish", "../swedish/ParadigmsSwe.gf")
|
|
]
|
|
|
|
append s = appendFile synopsis ('\n':s)
|
|
title s = append $ "=" ++ s ++ "="
|
|
space = append "\n"
|
|
delimit ss = mapM_ append ss
|
|
link s f = append $ s ++ " [``" ++ fa ++ "`` " ++ f ++ "]" where
|
|
fa = "http://www.cs.chalmers.se/~aarne/GF/lib/resource" ++ dropWhile (=='.') f
|
|
|
|
ttf s = "``" ++ s ++ "``"
|
|
itf s = "//" ++ s ++ "//"
|