msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

auxiliaries for making the synopsis with multilingual examples

Browse Source
This commit is contained in:
aarne
2010-12-11 20:47:53 +00:00
parent da670babaa
commit bbb79126b8
5 changed files with 196 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
lib/doc/Makefile
View File

@@ -14,3 +14,20 @@ abstract:
gfdoc -txthtml ../src/abstract/*.gf
mv ../src/abstract/*.html abstract
exx-script:
runghc MkExx.hs <api-examples.txt >api-examples.gfs
exx: exx-script
gf -retain -s ../alltenses/TryBul.gfo <api-examples.gfs >api-examples-Bul.txt
gf -retain -s ../alltenses/TryCat.gfo <api-examples.gfs >api-examples-Cat.txt
gf -retain -s ../alltenses/TryDan.gfo <api-examples.gfs >api-examples-Dan.txt
gf -retain -s ../alltenses/TryDut.gfo <api-examples.gfs >api-examples-Dut.txt
gf -retain -s ../alltenses/TryEng.gfo <api-examples.gfs >api-examples-Eng.txt
gf -retain -s ../alltenses/TryFin.gfo <api-examples.gfs >api-examples-Fin.txt
gf -retain -s ../alltenses/TryFre.gfo <api-examples.gfs >api-examples-Fre.txt
gf -retain -s ../alltenses/TryGer.gfo <api-examples.gfs >api-examples-Ger.txt
gf -retain -s ../alltenses/TryIta.gfo <api-examples.gfs >api-examples-Ita.txt
gf -retain -s ../alltenses/TryNor.gfo <api-examples.gfs >api-examples-Nor.txt
gf -retain -s ../alltenses/TryPol.gfo <api-examples.gfs >api-examples-Pol.txt
gf -retain -s ../alltenses/TryRon.gfo <api-examples.gfs >api-examples-Ron.txt
gf -retain -s ../alltenses/TrySpa.gfo <api-examples.gfs >api-examples-Spa.txt
gf -retain -s ../alltenses/TrySwe.gfo <api-examples.gfs >api-examples-Swe.txt

7
lib/doc/MkExx.hs
View File

@@ -1,9 +1,9 @@
-- make a script for computing examples
-- usage: runghc MkExx.hs <koe.txt >koe.gfs
-- then: gf -retain -s ../alltenses/TryRon.gfo <koe.gfs
-- called automatically by 'make exx'
main = interact (unlines . concatMap mkScript . lines)
main = interact (unlines . concatMap mkScript . takeWhile (/="--.") . lines)
mkScript l = case l of
' ':_ ->
@@ -12,7 +12,8 @@ mkScript l = case l of
'-':_ -> []
_ -> [
add $ psq l,
add $ "cc -one " ++ l
add $ "cc -one " ++ l,
add $ psq "*"
]
add = ('\n':)

79
lib/doc/MkExxTable.hs Normal file
View File

@@ -0,0 +1,79 @@
module MkExxTable (getApiExx, ApiExx, prApiEx) where
import System
import qualified Data.Map as M
import Data.Char
main = do
xx <- getArgs
aexx <- getApiExx xx
return () -- putStrLn $ prApiExx aexx
getApiExx :: [FilePath] -> IO ApiExx
getApiExx xx = do
s <- readFile (head xx)
let aet = getApiExxTrees $ dropInit $ lines s
aeos <- mapM readApiExxOne xx
let aexx = mkApiExx $ ("API",aet) : aeos
putStrLn $ prApiExx aexx
return aexx
readApiExxOne file = do
s <- readFile file
let lang = reverse (take 3 (drop 4 (reverse file))) -- api-exx-*Eng*.txt
let api = getApiExxOne (dropInit $ lines s)
putStrLn $ unlines $ prApiEx api
return (lang,api)
-- map function -> language -> example
type ApiExx = M.Map String (M.Map String String)
-- map function -> example
type ApiExxOne = M.Map String String
-- get a map function -> example
getApiExxOne :: [String] -> ApiExxOne
getApiExxOne = M.fromList . pairs . map cleanUp
where
pairs ss = case ss of
f:_:e:rest -> (f,e) : pairs (drop 1 (dropWhile (notElem '*') rest))
_ -> []
-- get the map function -> tree
getApiExxTrees :: [String] -> ApiExxOne
getApiExxTrees = M.fromList . pairs . map cleanUp
where
pairs ss = case ss of
f:e:_:rest -> (f,e) : pairs (drop 1 (dropWhile (notElem '*') rest))
_ -> []
-- remove leading prompts and spaces
cleanUp = dropWhile (\c -> not (isAlpha c || c == '*'))
-- drop GF welcome
dropInit = dropWhile ((/=">") . take 1)
mkApiExx :: [(String,ApiExxOne)] -> ApiExx
mkApiExx ltes =
M.fromList [(t,
M.fromList [(l,maybe "NONE" id (M.lookup t te)) | (l,te) <- ltes])
| t <- M.keys firstL]
where
firstL = snd (head ltes)
prApiExx :: ApiExx -> String
prApiExx aexx = unlines
[unlines (t:prApiEx lexx) | (t,lexx) <- M.toList aexx]
prApiEx :: M.Map String String -> [String]
prApiEx apexx = case M.toList apexx of
(a,e):lexx -> (a ++ ": ``" ++ unwords (words e) ++ "``"):
[l ++ ": //" ++ doBind e ++ "//" | (l,e) <- lexx]
doBind = unwords . bind . words
bind ws = case ws of
w : "&+" : u : ws2 -> bind ((w ++ u) : ws2)
"&+":ws2 -> bind ws2
w : ws2 -> w : bind ws2
_ -> ws

92
lib/doc/MkSynopsis.hs
View File

@@ -1,7 +1,10 @@
import MkExxTable
import System
import Char
import List
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as M
import Debug.Trace ----
type Cats = [(String,String,String)]
type Rules = [(String,String,String)]
@@ -9,6 +12,9 @@ type Rules = [(String,String,String)]
-- the file generated
synopsis = "synopsis.txt"
apiExxFiles = ["api-examples-" ++ lang ++ ".txt" | lang <- words
"Bul Cat Dan Dut Eng Fin Fre Ger Ita Nor Pol Ron Spa Swe"]
main = do
xx <- getArgs
let isLatex = case xx of
@@ -18,8 +24,17 @@ main = do
cs2 <- getCats catAPI
let cs = sortCats (cs1 ++ cs2)
writeFile synopsis "GF Resource Grammar Library: Synopsis"
append "B. Bringert and A. Ranta"
append "B. Bringert, T. Hallgren, and A. Ranta"
space
append "%!Encoding:utf-8"
append "%!style(html): ./revealpopup.css"
space
append "%!postproc(html): '#divreveal' '<div class=reveal>'"
append "%!postproc(html): '#divpopup' '<div class=popup>'"
append "%!postproc(html): '#ediv' '</div>'"
append "%!postproc(html): '#UL' '<ul>'"
append "%!postproc(html): '#EUL' '</ul>'"
append "%!postproc(html): '#LI' '<li>'"
append "%!postproc(html): '(SRC=\"categories.png\")' '\\1 USEMAP=\"#categories\"'"
append "%!postproc(html): '#LParadigms' '<a name=\"RParadigms\"></a>'"
append "%!postproc(tex): '#LParadigms' ''"
@@ -42,13 +57,14 @@ main = do
space
link "Source 2:" structuralAPI
space
rs <- getRules syntaxAPI
apiExx <- getApiExx apiExxFiles
rs <- getRules apiExx syntaxAPI
--- putStrLn $ unlines ["p -cat=" ++ last (words t) ++
--- " \"" ++ e ++ "\"" | (_,t,e) <- rs, not (null e)] ----
rs2 <- getRules structuralAPI
rs2 <- getRules apiExx structuralAPI
let rss = rs ++ rs2
mapM_ putStrLn [f ++ " " ++ e | (f,_,e) <- rss]
delimit $ mkSplitTables True isLatex cs rss
--- mapM_ putStrLn [f ++ " " ++ e | (f,_,e) <- rss]
delimit $ mkSplitTables True isLatex apiExx cs rss
space
-- title "Structural Words"
-- space
@@ -66,8 +82,12 @@ main = do
space
include "synopsis-example.txt"
space
title "Table of Contents"
space
append "%%toc"
space
let format = if isLatex then "tex" else "html"
system $ "txt2tags -t" ++ format ++ " --toc " ++ synopsis
system $ "txt2tags -t" ++ format ++ " " ++ " --toc " ++ synopsis
if isLatex then (system $ "pdflatex synopsis.tex") >> return () else return ()
addToolTips :: Cats -> [String]
@@ -89,14 +109,14 @@ getCats file = do
(expl,ex) = span (/="e.g.") exp
_ -> getrs rs ss2
rulesTable :: Bool -> Bool -> Cats -> FilePath -> IO [String]
rulesTable hasEx isLatex cs file = do
rs <- getRules file
return $ mkTable hasEx isLatex cs rs
rulesTable :: ApiExx -> Bool -> Bool -> Cats -> FilePath -> IO [String]
rulesTable aexx hasEx isLatex cs file = do
rs <- getRules aexx file
return $ mkTable hasEx isLatex aexx cs rs
getRules :: FilePath -> IO Rules
getRules file = do
getRules :: ApiExx -> FilePath -> IO Rules
getRules aexx file = do
ss <- readFileC file >>= return . filter (not . hiddenLine) . lines
return $ getrs [] ss
where
@@ -127,7 +147,7 @@ putParadigms isLatex cs (lang,file) = do
space
link "source" file
space
rs <- rulesTable False isLatex cs file
rs <- rulesTable M.empty False isLatex cs file
space
delimit rs
space
@@ -139,32 +159,60 @@ inChunks i f = concat . intersperse ["\n\n"] . map f . chunks i where
-- Makes one table per result category.
-- Adds a subsection header for each table.
mkSplitTables :: Bool -> Bool -> Cats -> Rules -> [String]
mkSplitTables hasEx isLatex cs = concatMap t . addLexicalCats cs . sortRules
mkSplitTables :: Bool -> Bool -> ApiExx -> Cats -> Rules -> [String]
mkSplitTables hasEx isLatex aexx cs = concatMap t . addLexicalCats cs . sortRules
where t (c, xs) = [subtitle c expl] ++ tableOrLink
where
expl = case [e | (n,e,_) <- cs, n == c] of
[] -> ""
e:_ -> e
tableOrLink = if null xs then parad else mkTable hasEx isLatex cs xs
tableOrLink = if null xs then parad else mkTable hasEx isLatex aexx cs xs
parad = [
"Lexical category, constructors given in",
"[lexical paradigms #RParadigms]."
]
mkTable :: Bool -> Bool -> Cats -> Rules -> [String]
mkTable hasEx isLatex cs = inChunks chsize (\rs -> header : map (unwords . row) rs)
mkTable :: Bool -> Bool -> ApiExx -> Cats -> Rules -> [String]
mkTable hasEx isLatex aexx cs = inChunks chsize (\rs -> header : map (unwords . row) rs)
where
chsize = if isLatex then 40 else 1000
header = if hasEx then "|| Function | Type | Example ||"
else "|| Function | Type ||"
row (name,typ,ex)
= if hasEx then ["|", name', "|", typ', "|", ex', "|"]
else ["|", name', "|", typ', "|"]
row (name,typ,ex) =
let ntyp = mkIdent (name ++ " : " ++ typ) in
if hasEx then ["|", name', "|", typ', "|", ex' ntyp, "|"]
else ["|", name', "|", typ', "|"]
where
name' = ttf name
typ' = showTyp cs typ
ex' = if null ex then itf (takeWhile (/='_') name) else itf ex
ex' typ = if null ex then itf (takeWhile (/='_') name) else
case M.lookup typ aexx of
Just es -> mkExample es ex
_ -> trace typ $ itf ex
-- make an example with hover-popup translations
mkExample es ex = unwords [
"#divreveal",
itf ex,
"#divpopup",
"#UL",
unwords ["#LI" ++ e | e <- prApiEx es],
"#EUL",
"#ediv",
"#ediv"
]
-- makes mkUtt : QS -> Utt to mkUtt-QS-Utt
mkIdent :: String -> String
mkIdent = concatMap unspec where
unspec c = case c of
' ' -> ""
'>' -> ""
'(' -> ""
')' -> ""
':' -> "-"
_ -> [c]
mkCatTable :: Bool -> Cats -> [String]
mkCatTable isLatex cs = inChunks chsize (\rs -> header ++ map mk1 rs) cs

26
lib/doc/revealpopup.css Normal file
View File

@@ -0,0 +1,26 @@
/* Popup boxes will have a light yellow background and a black border */
div.popup {
display: none;
background: #ffc;
border: 1px solid black;
}
div.expand { display: none }
div.reveal:hover div.popup {
display: block;
position: absolute;
margin-left: 3em;
}
.popup dl { margin: 5px; }
tr:hover div.expand {
display: block;
}
/* Just some optional color and border styles: */
body { background: #eee; }
table { border-collapse: collapse; }
td, th { padding: 5px; }
th { background: #9df; }
td { background: white }