Fix ToC.
[doclang.git] / Language / TCT / Write / HTML5.hs
index ba4a359666b3f4a39483443dcb58fbf2cfb10196..511596dc65f14d8c24707da62b61d6e277a3a5ea 100644 (file)
@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 -- | Render TCT as HTML5.
 module Language.TCT.Write.HTML5 where
@@ -145,68 +144,70 @@ html5CellKey (Cell _pos _posEnd key) ts = do
                                html5TreesCell ts
 
 html5IndentToken :: Tokens -> Html
-html5IndentToken (Seq.viewl -> EmptyL) = ""
-html5IndentToken toks@(Seq.viewl -> Cell pos _ _ :< _) =
-       goTokens toks `S.evalState` linePos pos
-       where
-       indent = Text.replicate (columnPos pos - 1) " "
-       go :: Cell Token -> S.State Int Html
-       go tok =
-               case unCell tok of
-                TokenPlain txt -> do
-                       lin <- S.get
-                       let lines = Text.splitOn "\n" txt
-                       let lnums = H.toMarkup :
-                                [ \line -> do
-                                       H.toMarkup '\n'
-                                       H.a ! HA.id ("line-"<>attrValue lnum) $ return ()
-                                       H.toMarkup indent
-                                       H.toMarkup line
-                                | lnum <- [lin+1..]
-                                ]
-                       S.put (lin - 1 + L.length lines)
-                       return $ mconcat $ L.zipWith ($) lnums lines
-                TokenTag v ->
-                       return $
-                               H.span ! HA.class_ "tag" $ do
-                                       H.span ! HA.class_ "tag-open" $ H.toMarkup '#'
-                                       H.toMarkup v
-                TokenEscape c -> return $ H.toMarkup ['\\',c]
-                TokenLink lnk ->
-                       return $
-                               H.a ! HA.href (attrValue lnk) $
-                                       H.toMarkup lnk
-                TokenPair (PairElem name attrs) ts -> do
-                       h <- goTokens ts
-                       return $ do
-                               let cl = mconcat ["pair-PairElem", " pair-elem-", attrValue name]
-                               H.span ! HA.class_ cl $ do
-                                       whenMarkup o $ H.span ! HA.class_ "pair-open" $ o
-                                       whenMarkup h $ H.span ! HA.class_ "pair-content" $ h
-                                       whenMarkup c $ H.span ! HA.class_ "pair-close" $ c
-                       where
-                       html5name = H.span ! HA.class_ "elem-name" $ H.toMarkup name
-                       o,c :: Html
-                       (o,c) =
-                               if Seq.null ts
-                               then
-                                       ( "<"<>html5name<>html5Attrs attrs<>"/>"
-                                       , mempty )
-                               else
-                                       ( "<"<>html5name<>html5Attrs attrs<>">"
-                                       , "</"<>html5name<>">" )
-                TokenPair grp ts -> do
-                       h <- goTokens ts
-                       return $ do
-                               let (o,c) = pairBorders grp ts
-                               H.span ! HA.class_ (mconcat ["pair-", fromString $ show grp]) $ do
-                                       H.span ! HA.class_ "pair-open"    $ H.toMarkup o
-                                       H.span ! HA.class_ "pair-content" $ h
-                                       H.span ! HA.class_ "pair-close"   $ H.toMarkup c
-       goTokens :: Tokens -> S.State Int Html
-       goTokens ts = do
-               ts' <- go`mapM`ts
-               return $ foldr (<>) mempty ts'
+html5IndentToken toks =
+       case Seq.viewl toks of
+        EmptyL -> ""
+        Cell pos _ _ :< _ ->
+               goTokens toks `S.evalState` linePos pos
+               where
+               indent = Text.replicate (columnPos pos - 1) " "
+               go :: Cell Token -> S.State Int Html
+               go tok =
+                       case unCell tok of
+                        TokenPlain txt -> do
+                               lin <- S.get
+                               let lines = Text.splitOn "\n" txt
+                               let lnums = H.toMarkup :
+                                        [ \line -> do
+                                               H.toMarkup '\n'
+                                               H.a ! HA.id ("line-"<>attrValue lnum) $ return ()
+                                               H.toMarkup indent
+                                               H.toMarkup line
+                                        | lnum <- [lin+1..]
+                                        ]
+                               S.put (lin - 1 + L.length lines)
+                               return $ mconcat $ L.zipWith ($) lnums lines
+                        TokenTag v ->
+                               return $
+                                       H.span ! HA.class_ "tag" $ do
+                                               H.span ! HA.class_ "tag-open" $ H.toMarkup '#'
+                                               H.toMarkup v
+                        TokenEscape c -> return $ H.toMarkup ['\\',c]
+                        TokenLink lnk ->
+                               return $
+                                       H.a ! HA.href (attrValue lnk) $
+                                               H.toMarkup lnk
+                        TokenPair (PairElem name attrs) ts -> do
+                               h <- goTokens ts
+                               return $ do
+                                       let cl = mconcat ["pair-PairElem", " pair-elem-", attrValue name]
+                                       H.span ! HA.class_ cl $ do
+                                               whenMarkup o $ H.span ! HA.class_ "pair-open" $ o
+                                               whenMarkup h $ H.span ! HA.class_ "pair-content" $ h
+                                               whenMarkup c $ H.span ! HA.class_ "pair-close" $ c
+                               where
+                               html5name = H.span ! HA.class_ "elem-name" $ H.toMarkup name
+                               o,c :: Html
+                               (o,c) =
+                                       if Seq.null ts
+                                       then
+                                               ( "<"<>html5name<>html5Attrs attrs<>"/>"
+                                               , mempty )
+                                       else
+                                               ( "<"<>html5name<>html5Attrs attrs<>">"
+                                               , "</"<>html5name<>">" )
+                        TokenPair grp ts -> do
+                               h <- goTokens ts
+                               return $ do
+                                       let (o,c) = pairBorders grp ts
+                                       H.span ! HA.class_ (mconcat ["pair-", fromString $ show grp]) $ do
+                                               H.span ! HA.class_ "pair-open"    $ H.toMarkup o
+                                               H.span ! HA.class_ "pair-content" $ h
+                                               H.span ! HA.class_ "pair-close"   $ H.toMarkup c
+               goTokens :: Tokens -> S.State Int Html
+               goTokens ts = do
+                       ts' <- go`mapM`ts
+                       return $ foldr (<>) mempty ts'
 
 html5Attrs :: Attrs -> Html
 html5Attrs = foldMap html5Attr