forked from GitHub/gf-core
removed src for 2.9
This commit is contained in:
aarne
@@ -1,366 +0,0 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/16 05:40:50 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.7 $
|
||||
--
|
||||
-- produce a HTML document from a list of GF grammar files. AR 6\/10\/2002
|
||||
--
|
||||
-- Added @--!@ (NewPage) and @--*@ (Item) 21\/11\/2003
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Main (main) where
|
||||
|
||||
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import System.Cmd
|
||||
import System.Directory
|
||||
import System.Environment
|
||||
import System.Locale
|
||||
import System.Time
|
||||
|
||||
-- to read files and write a file
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
xx <- getArgs
|
||||
let
|
||||
(typ,format,names) = case xx of
|
||||
"-latex" : xs -> (0,doc2latex,xs)
|
||||
"-htmls" : xs -> (2,doc2html,xs)
|
||||
"-txt" : xs -> (3,doc2txt,xs)
|
||||
"-txt2" : xs -> (3,doc2txt2,xs)
|
||||
"-txthtml": xs -> (4,doc2txt,xs)
|
||||
xs -> (1,doc2html,xs)
|
||||
if null xx
|
||||
then do
|
||||
putStrLn welcome
|
||||
putStrLn help
|
||||
else flip mapM_ names (\name -> do
|
||||
ss <- readFile name
|
||||
time <- modTime name
|
||||
let outfile = fileFormat typ name
|
||||
writeFile outfile $ format $ pDoc time ss)
|
||||
case typ of
|
||||
2 ->
|
||||
mapM_ (\name -> system $ "htmls " ++ (fileFormat typ name)) names
|
||||
4 ->
|
||||
mapM_ (\name ->
|
||||
system $ "txt2tags -thtml --toc " ++ (fileFormat typ name)) names
|
||||
_ -> return ()
|
||||
return ()
|
||||
|
||||
modTime :: FilePath -> IO ModTime
|
||||
modTime name =
|
||||
do
|
||||
t <- getModificationTime name
|
||||
ct <- toCalendarTime t
|
||||
let timeFmt = "%Y-%m-%d %H:%M:%S %Z"
|
||||
return $ formatCalendarTime defaultTimeLocale timeFmt ct
|
||||
|
||||
welcome = unlines [
|
||||
"",
|
||||
"gfdoc - a rudimentary GF document generator.",
|
||||
"(c) Aarne Ranta (aarne@cs.chalmers.se) 2002 under GNU GPL."
|
||||
]
|
||||
|
||||
help = unlines $ [
|
||||
"",
|
||||
"Usage: gfdoc (-latex|-htmls|-txt|-txthtml) <file>+",
|
||||
"",
|
||||
"The program operates with lines in GF code, treating them into LaTeX",
|
||||
"(flag -latex), to a set of HTML documents (flag -htmls), to a txt2tags file",
|
||||
"(flag -txt), to HTML via txt (flag -txthtml), or to one",
|
||||
"HTML file (by default). The output is written in a file",
|
||||
"whose name is formed from the input file name by replacing its suffix",
|
||||
"with html or tex; in case of set of HTML files, the names are prefixed",
|
||||
"by 01-, 02-, etc, and each file has navigation links.",
|
||||
"",
|
||||
"The translation is line by line",
|
||||
"depending as follows on how the line begins",
|
||||
"",
|
||||
" --[Int] heading of level Int",
|
||||
" -- new paragraph",
|
||||
" --! new page (in HTML, recognized by the htmls program)",
|
||||
" --. end of document",
|
||||
--- " --- ignore this comment line in document",
|
||||
--- " {---} ignore this code line in document",
|
||||
" --*[Text] Text paragraph starting with a bullet",
|
||||
" --[Text] Text belongs to text paragraph",
|
||||
" [Text] Text belongs to code paragraph",
|
||||
"",
|
||||
"Within a text paragraph, text enclosed between certain characters",
|
||||
"is treated specially:",
|
||||
"",
|
||||
" *[Text]* emphasized (boldface)",
|
||||
" \"[Text]\" example string (italics)",
|
||||
" $[Text]$ example code (courier)",
|
||||
"",
|
||||
"For other formatting and links, we recommend the txt2tags format."
|
||||
]
|
||||
|
||||
fileFormat typ x = body ++ suff where
|
||||
body = reverse $ dropWhile (/='.') $ reverse x
|
||||
suff = case typ of
|
||||
0 -> "tex"
|
||||
_ | typ < 3 -> "html"
|
||||
_ -> "txt"
|
||||
|
||||
-- the document datatype
|
||||
|
||||
data Doc = Doc Title ModTime [Paragraph]
|
||||
|
||||
type ModTime = String
|
||||
|
||||
type Title = [TextItem]
|
||||
|
||||
data Paragraph =
|
||||
Text [TextItem] -- text line starting with --
|
||||
| List [[TextItem]] --
|
||||
| Code String -- other text line
|
||||
| Item [TextItem] -- bulleted item: line prefixed by --*
|
||||
| New -- new paragraph: line consisting of --
|
||||
| NewPage -- new parage: line consisting of --!
|
||||
| Heading Int [TextItem] -- text line starting with --n where n = 1,2,3,4
|
||||
|
||||
data TextItem =
|
||||
Str String
|
||||
| Emp String -- emphasized, *...*
|
||||
| Lit String -- string literal, "..."
|
||||
| Inl String -- inlined code, '...'
|
||||
|
||||
|
||||
-- parse document
|
||||
|
||||
pDoc :: ModTime -> String -> Doc
|
||||
pDoc time s = case dropWhile emptyOrPragma (lines s) of
|
||||
('-':'-':'1':title) : paras -> Doc (pItems title) time (map pPara (grp paras))
|
||||
paras -> Doc [] time (map pPara (grp paras))
|
||||
where
|
||||
grp ss = case ss of
|
||||
s : rest --- | ignore s -> grp rest
|
||||
| isEnd s -> []
|
||||
| begComment s -> let (s1,s2) = getComment (drop 2 s : rest)
|
||||
in map ("-- " ++) s1 ++ grp s2
|
||||
| isComment s -> s : grp rest
|
||||
| all isSpace s -> grp rest
|
||||
[] -> []
|
||||
_ -> unlines code : grp rest where (code,rest) = span (not . isComment) ss
|
||||
pPara s = case s of
|
||||
'-':'-':d:text | isDigit d -> Heading (read [d]) (pItems text)
|
||||
'-':'-':'!':[] -> NewPage
|
||||
'-':'-':[] -> New
|
||||
'-':'-':'*':text -> Item (pItems (dropWhile isSpace text))
|
||||
'-':'-':text -> Text (pItems (dropWhile isSpace text))
|
||||
_ -> Code s
|
||||
pItems s = case s of
|
||||
'*' : cs -> get 1 Emp (=='*') cs
|
||||
'"' : cs -> get 1 Lit (=='"') cs
|
||||
'$' : cs -> get 1 Inl (=='$') cs
|
||||
[] -> []
|
||||
_ -> get 0 Str (flip elem "*\"$") s
|
||||
|
||||
get _ _ _ [] = []
|
||||
get k con isEnd cs = con beg : pItems (drop k rest)
|
||||
where (beg,rest) = span (not . isEnd) cs
|
||||
|
||||
ignore s = case s of
|
||||
'-':'-':'-':_ -> True
|
||||
'{':'-':'-':'-':'}':_ -> True
|
||||
_ -> False
|
||||
|
||||
isEnd s = case s of
|
||||
'-':'-':'.':_ -> True
|
||||
_ -> False
|
||||
|
||||
emptyOrPragma s = all isSpace s || "--#" `isPrefixOf` s
|
||||
|
||||
-- render in html
|
||||
|
||||
doc2html :: Doc -> String
|
||||
doc2html (Doc title time paras) = unlines $
|
||||
tagXML "html" $
|
||||
tagXML "body" $
|
||||
unwords (tagXML "i" ["Produced by " ++ welcome]) :
|
||||
mkTagXML "p" :
|
||||
concat (tagXML "h1" [concat (map item2html title)]) :
|
||||
empty :
|
||||
map para2html paras
|
||||
|
||||
para2html :: Paragraph -> String
|
||||
para2html p = case p of
|
||||
Text its -> concat (map item2html its)
|
||||
Item its -> mkTagXML "li" ++ concat (map item2html its)
|
||||
Code s -> unlines $ tagXML "pre" $ map (indent 2) $
|
||||
remEmptyLines $ lines $ spec s
|
||||
New -> mkTagXML "p"
|
||||
NewPage -> mkTagXML "p" ++ "\n" ++ mkTagXML "!-- NEW --"
|
||||
Heading i its -> concat $ tagXML ('h':show i) [concat (map item2html its)]
|
||||
|
||||
item2html :: TextItem -> String
|
||||
item2html i = case i of
|
||||
Str s -> spec s
|
||||
Emp s -> concat $ tagXML "b" [spec s]
|
||||
Lit s -> concat $ tagXML "i" [spec s]
|
||||
Inl s -> concat $ tagXML "tt" [spec s]
|
||||
|
||||
mkTagXML t = '<':t ++ ">"
|
||||
mkEndTagXML t = mkTagXML ('/':t)
|
||||
tagXML t ss = mkTagXML t : ss ++ [mkEndTagXML t]
|
||||
|
||||
spec = elimLt
|
||||
|
||||
elimLt s = case s of
|
||||
'<':cs -> "<" ++ elimLt cs
|
||||
c :cs -> c : elimLt cs
|
||||
_ -> s
|
||||
|
||||
|
||||
-- render in latex
|
||||
|
||||
doc2latex :: Doc -> String
|
||||
doc2latex (Doc title time paras) = unlines $
|
||||
preludeLatex :
|
||||
funLatex "title" [concat (map item2latex title)] :
|
||||
funLatex "author" [fontLatex "footnotesize" (welcome)] :
|
||||
envLatex "document" (
|
||||
funLatex "maketitle" [] :
|
||||
map para2latex paras)
|
||||
|
||||
para2latex :: Paragraph -> String
|
||||
para2latex p = case p of
|
||||
Text its -> concat (map item2latex its)
|
||||
Item its -> "\n\n$\\bullet$" ++ concat (map item2latex its) ++ "\n\n"
|
||||
Code s -> unlines $ envLatex "verbatim" $ map (indent 2) $
|
||||
remEmptyLines $ lines $ s
|
||||
New -> "\n"
|
||||
NewPage -> "\\newpage"
|
||||
Heading i its -> headingLatex i (concat (map item2latex its))
|
||||
|
||||
item2latex :: TextItem -> String
|
||||
item2latex i = case i of
|
||||
Str s -> specl s
|
||||
Emp s -> fontLatex "bf" (specl s)
|
||||
Lit s -> fontLatex "it" (specl s)
|
||||
Inl s -> fontLatex "tt" (specl s)
|
||||
|
||||
funLatex :: String -> [String] -> String
|
||||
funLatex f xs = "\\" ++ f ++ concat ["{" ++ x ++ "}" | x <- xs]
|
||||
|
||||
envLatex :: String -> [String] -> [String]
|
||||
envLatex e ss =
|
||||
funLatex "begin" [e] :
|
||||
ss ++
|
||||
[funLatex "end" [e]]
|
||||
|
||||
headingLatex :: Int -> String -> String
|
||||
-- for slides
|
||||
-- headingLatex _ s = funLatex "newone" [] ++ "\n" ++ funLatex "heading" [s]
|
||||
headingLatex i s = funLatex t [s] where
|
||||
t = case i of
|
||||
2 -> "section"
|
||||
3 -> "subsection"
|
||||
_ -> "subsubsection"
|
||||
|
||||
fontLatex :: String -> String -> String
|
||||
fontLatex f s = "{\\" ++ f ++ " " ++ s ++ "}"
|
||||
|
||||
specl = eliml
|
||||
|
||||
eliml s = case s of
|
||||
'|':cs -> mmath "mid" ++ elimLt cs
|
||||
'{':cs -> mmath "\\{" ++ elimLt cs
|
||||
'}':cs -> mmath "\\}" ++ elimLt cs
|
||||
_ -> s
|
||||
|
||||
mmath s = funLatex "mbox" ["$" ++ s ++ "$"]
|
||||
|
||||
preludeLatex = unlines $ [
|
||||
"\\documentclass[12pt]{article}",
|
||||
"\\usepackage{isolatin1}",
|
||||
"\\setlength{\\oddsidemargin}{0mm}",
|
||||
"\\setlength{\\evensidemargin}{-2mm}",
|
||||
"\\setlength{\\topmargin}{-16mm}",
|
||||
"\\setlength{\\textheight}{240mm}",
|
||||
"\\setlength{\\textwidth}{158mm}",
|
||||
"\\setlength{\\parskip}{2mm}",
|
||||
"\\setlength{\\parindent}{0mm}"
|
||||
]
|
||||
|
||||
-- render in txt2tags
|
||||
-- as main document (welcome, top-level subtitles)
|
||||
-- as chapter (no welcome, subtitle level + i)
|
||||
|
||||
doc2txt :: Doc -> String
|
||||
doc2txt (Doc title time paras) = unlines $
|
||||
let tit = concat (map item2txt title) in
|
||||
tit:
|
||||
("Last update: " ++ time):
|
||||
"":
|
||||
"% NOTE: this is a txt2tags file.":
|
||||
"% Create an html file from this file using:":
|
||||
("% txt2tags " ++ tit):
|
||||
"\n":
|
||||
concat (["Produced by " ++ welcome]) :
|
||||
"\n" :
|
||||
empty :
|
||||
map (para2txt 0) paras
|
||||
|
||||
doc2txt2 :: Doc -> String
|
||||
doc2txt2 (Doc title time paras) = unlines $
|
||||
let tit = concat (map item2txt title) in
|
||||
tit:
|
||||
"":
|
||||
concat (tagTxt (replicate 2 '=') [tit]):
|
||||
"\n":
|
||||
empty :
|
||||
map (para2txt 2) paras
|
||||
|
||||
para2txt :: Int -> Paragraph -> String
|
||||
para2txt j p = case p of
|
||||
Text its -> concat (map item2txt its)
|
||||
Item its -> "- " ++ concat (map item2txt its)
|
||||
Code s -> unlines $ tagTxt "```" $ map (indent 2) $
|
||||
remEmptyLines $ lines s
|
||||
New -> "\n"
|
||||
NewPage -> "\n" ++ "!-- NEW --"
|
||||
Heading i its ->
|
||||
concat $ tagTxt (replicate (i + j) '=') [concat (map item2txt its)]
|
||||
|
||||
item2txt :: TextItem -> String
|
||||
item2txt i = case i of
|
||||
Str s -> s
|
||||
Emp s -> concat $ tagTxt "**" [spec s]
|
||||
Lit s -> concat $ tagTxt "//" [spec s]
|
||||
Inl s -> concat $ tagTxt "``" [spec s]
|
||||
|
||||
tagTxt t ss = t : ss ++ [t]
|
||||
|
||||
|
||||
|
||||
-- auxiliaries
|
||||
|
||||
empty = ""
|
||||
|
||||
isComment = (== "--") . take 2
|
||||
|
||||
begComment = (== "{-") . take 2
|
||||
|
||||
getComment ss = case ss of
|
||||
"-}":ls -> ([],ls)
|
||||
l:ls -> (l : s1, s2) where (s1,s2) = getComment ls
|
||||
_ -> ([],[])
|
||||
|
||||
indent n = (replicate n ' ' ++)
|
||||
|
||||
remEmptyLines = rem False where
|
||||
rem prevGood ls = case span empty ls of
|
||||
(_ :_, ss@(_ : _)) -> (if prevGood then ("":) else id) $ rem False ss
|
||||
(_, []) -> []
|
||||
(_, s:ss) -> s : rem True ss
|
||||
empty = all isSpace
|
||||
Reference in New Issue
Block a user