Add some comments, fix a single typo
Getty Ritter
9 years ago
| 8 | 8 | import Text.Blaze.Html5 hiding (map, head, html) |
| 9 | 9 | import Text.Blaze.Html5.Attributes hiding (name) |
| 10 | 10 | |
| 11 | -- | Render a TeLML document with an extra set of possible tags. | |
| 11 | 12 | renderWith :: [(String, Renderer)] -> Document -> Either String Html |
| 12 | 13 | renderWith rs = |
| 13 | 14 | fmap (void . sequence) . mapM (renderPara (basicTags ++ rs)) . gatherPara |
| 14 | 15 | |
| 16 | -- | Render a TeLML document with the default set of tags. | |
| 15 | 17 | render :: Document -> Either String Html |
| 16 | 18 | render = renderWith [] |
| 17 | 19 | |
| 20 | -- This is a gross function, but I'm not sure how to decompose it any | |
| 21 | -- other way. It takes a Document---i.e. a set of Fragments---and | |
| 22 | -- splits it apart whenever it comes across double newlines. | |
| 18 | 23 | gatherPara :: Document -> [Document] |
| 19 | 24 | gatherPara = reverse . map reverse . go [[]] |
| 20 | 25 | where go rs [] = rs |
| 26 | 31 | ((Text (head xs):r) : rs)) ts |
| 27 | 32 | go _ _ = error "[unreachable]" |
| 28 | 33 | |
| 34 | -- Split a string at double-newlines. | |
| 29 | 35 | splitString :: String -> [String] |
| 30 | 36 | splitString = filter (/= "") . go |
| 31 | 37 | where go ('\n':'\n':xs) = "\n":go xs |
| 32 | 38 | go (x:xs) = let r:rs = go xs in ((x:r):rs) |
| 33 |
go |
|
| 39 | go "" = [""] | |
| 34 | 40 | |
| 41 | -- This is just to make type signatures shorter | |
| 35 | 42 | type HtmlE = Either String Html |
| 36 | 43 | |
| 37 | 44 | type Renderer = (Fragment -> HtmlE, [Document]) -> HtmlE |
| 38 | 45 | |
| 46 | -- The built-in set of tags (subject to change) | |
| 39 | 47 | basicTags :: [(String, Renderer)] |
| 40 | 48 | basicTags = |
| 41 | 49 | [ ("em" |
| 48 | 56 | ) |
| 49 | 57 | , ("code" |
| 50 | 58 | , \case (f,[rs]) -> fmap (code . sequence_) (mapM f rs) |
| 51 |
_ -> Left "wrong arity for |
|
| 59 | _ -> Left "wrong arity for code/1" | |
| 52 | 60 | ) |
| 53 | 61 | , ("link" |
| 54 | 62 | , \case (f,[[Text l],r]) -> let go h = a ! href (stringValue l) $ h |
| 58 | 66 | ) |
| 59 | 67 | ] |
| 60 | 68 | |
| 69 | -- render a single paragraph | |
| 61 | 70 | renderPara :: [(String, Renderer)] -> Document -> Either String Html |
| 62 | 71 | renderPara taglist ds = fmap (p . sequence_) (mapM go ds) |
| 63 | 72 | where go (Text ts) = Right (toMarkup ts) |