X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=src%2FMain.lhs;h=bcac25b972ea011d710697d2937c807be3b1e5d2;hb=a2008a0c57702f49ed7f8be682e4e29484fded38;hp=d9d862f1b9216339f9b334ef7f11704ce3fd34aa;hpb=e84029a8b861075d6d0ed5040f919b2e4da4c98f;p=sbp.git diff --git a/src/Main.lhs b/src/Main.lhs index d9d862f..bcac25b 100644 --- a/src/Main.lhs +++ b/src/Main.lhs @@ -2,9 +2,178 @@ module Main where import SBP -main = do t <- parseFile "../fleeterpreter/fleet.g" "../fleeterpreter/demo.fleet" - putStrLn $ "hi" - putStrLn $ show (prettyPrintTree t) +main = do t <- parseFile "../wix/wix.g" "../wix/lasik.wix" + putStrLn $ toHtml $ ((fromTree $ coalesceFlatHeadlessNodes t) :: Doc) + +-- url crap +-- ul/ol +-- glyphs + +------------------------------------------------------------------------------ +data Doc = Doc Header [Section] +data Section = Section [Text] [Paragraph] +data Paragraph = Blockquote [Text] + | HR + | OL + | P [Text] +data Text = WS + | Chars String + | Symbol String + | Quotes [Text] + | Block [Text] + | Command String [Text] + | Verbatim String + | Link [Text] URL + | Underline [Text] + | Footnote [Text] + | TT [Text] + | Citation [Text] + | Strikethrough [Text] + | Superscript [Text] + | Subscript [Text] + | Smallcap [Text] + | Bold [Text] + | Keyword [Text] + | Italic [Text] +data Header = Header +data URL = URL + deriving Show + +{- +glyph = euro:: "(e)" + | r:: "(r)" + | c:: "(c)" + | tm:: "(tm)" + | emdash:: "--" + | ellipses:: "..." + | cent:: "\\cent" +-} + +------------------------------------------------------------------------------ +class FromTree a where + fromTree :: Tree -> a +class FromTrees a where + fromTrees :: [Tree] -> a +instance FromTree a => FromTree [a] where + fromTree (Tree _ c _) = map fromTree c + +instance FromTree Doc where + fromTree (Tree "Doc" [a,b] _) = Doc Header $ fromTree b + fromTree (Tree "Doc" [b] _) = Doc Header $ fromTree b + fromTree _ = error "top level must be Doc" + +instance FromTree Section where + fromTree (Tree "Section" [(Tree _ c _),(Tree _ paragraphs _)] _) = + Section (map fromTree c) $ map fromTree paragraphs + +instance FromTree Paragraph where + fromTree (Tree "P" [Tree _ text _] _) = P $ map fromTree text + fromTree (Tree "HR" _ _) = HR + +instance FromTree Text where + fromTree (Tree "Chars" chars _) = Chars $ fromTrees chars + fromTree (Tree "WS" _ _) = WS + fromTree (Tree "Symbol" sym _) = Symbol $ fromTrees sym + fromTree (Tree "Quotes" x _) = Quotes $ map fromTree x + fromTree (Tree "Block" x _) = Block $ map fromTree x + fromTree (Tree "Command" [x,y] _) = Command (fromTree x) (fromTree y) + fromTree (Tree "Verbatim" x _) = Verbatim $ fromTrees x + fromTree (Tree "Link" [word,link] _) = Link (fromTree word) (fromTree link) + fromTree (Tree "Underline" x _) = Underline $ map fromTree x + fromTree (Tree "Footnote" x _) = Footnote $ map fromTree x + fromTree (Tree "TT" x _) = TT $ map fromTree x + fromTree (Tree "Citation" x _) = Citation $ map fromTree x + fromTree (Tree "Strikethrough" x _) = Strikethrough $ map fromTree x + fromTree (Tree "Superscript" x _) = Superscript $ map fromTree x + fromTree (Tree "Subscript" x _) = Subscript $ map fromTree x + fromTree (Tree "Smallcap" x _) = Smallcap $ map fromTree x + fromTree (Tree "Bold" x _) = Bold $ map fromTree x + fromTree (Tree "Keyword" x _) = Keyword $ map fromTree x + fromTree (Tree "Italic" x _) = Italic $ map fromTree x + fromTree (Tree x _ _) = Chars $ x + +instance FromTree URL where + fromTree x = URL + +instance FromTree String where + fromTree (Tree h c _) = h++(concatMap fromTree c) +instance FromTrees String where + fromTrees ts = concatMap (fromTree :: Tree -> String) ts + +------------------------------------------------------------------------------ +class ToHtml a where + toHtml :: a -> String +instance ToHtml a => ToHtml [a] where + toHtml x = concatMap toHtml x + +instance ToHtml Doc where + toHtml (Doc h secs) = "
" ++ (toHtml secs) ++ "" +instance ToHtml Section where + toHtml (Section header paragraphs) = ""++(toHtml t)++"" + toHtml HR = "
"++(toHtml t)++"
" +instance ToHtml Text where + toHtml WS = " " + toHtml (Chars s) = toHtml s + toHtml (Symbol s) = toHtml s + toHtml (Quotes x) = "\""++(toHtml x)++"\"" + toHtml (Block x) = toHtml x + toHtml (Verbatim x) = "\n"++x++"\n" + toHtml (Link t ref) = ""++(toHtml t)++"" + toHtml (Underline x) = ""++(toHtml x)++"" + toHtml (TT x) = ""++(toHtml x)++"" + toHtml (Citation x) = ""++(toHtml x)++"" + toHtml (Strikethrough x) = "