Add KeyDot.
authorJulien Moutinho <julm+tct@autogeree.net>
Thu, 26 Oct 2017 21:20:02 +0000 (23:20 +0200)
committerJulien Moutinho <julm+tct@autogeree.net>
Thu, 26 Oct 2017 22:05:59 +0000 (00:05 +0200)
Language/TCT/Read/Tree.hs
Language/TCT/Write/DTC.hs
Language/TCT/Write/HTML5/Source.hs

index 24611fd4be67b0357fbdb3ba3aa9d7a5b94fc2a1..17b4d688574429ad7913cf98393046c1928d8e71 100644 (file)
@@ -47,15 +47,15 @@ p_CellKey row = pdbg "CellKey" $ do
        key <- pdbg "Key" $
                P.choice $
                 [ P.try $ P.string "- " $> KeyDash
-                -- TODO: KeyNum
+                , P.try $ KeyDot . Text.pack
+                        <$> P.some (P.satisfy Char.isDigit)
+                        <* P.char '.'
+                        <* P.lookAhead (P.try $ P.eof <|> void (P.satisfy $ \c -> c=='\n'||c==' '))
                 -- TODO: KeyComment
                 , P.try $ P.some (P.char '#') <* P.lookAhead (P.try $ P.char ' ') >>= \hs ->
                        return $ KeySection $ List.length hs
                 , do
-                       name <-
-                               Text.pack
-                                <$> many (P.satisfy $ \c ->
-                                       Char.isAlphaNum c || c=='-' || c=='_')
+                       name <- p_Name
                        wh <- Text.pack <$> P.many (P.char ' ')
                        P.choice
                         [ P.try $ KeyColon name wh
@@ -72,18 +72,27 @@ p_CellKey row = pdbg "CellKey" $ do
        case key of
         KeySection{} -> p_CellEnd row'
         KeyDash{}    -> p_Row     row'
+        KeyDot{}     -> p_Row     row'
         KeyColon{}   -> p_Row     row'
         KeyGreat{}   -> p_Row     row'
         KeyEqual{}   -> p_CellEnd row'
         KeyBar{}     -> p_CellEnd row'
         KeyLower{}   -> undefined -- NOTE: handled in 'p_CellLower'
 
+p_Name :: Parser e s Name
+p_Name =
+       (\h t -> Text.pack (h:t))
+        <$> (P.satisfy $ \c ->
+               Char.isAlphaNum c || c=='_')
+        <*> many (P.satisfy $ \c ->
+               Char.isAlphaNum c || c=='-' || c=='_')
+
 p_CellLower :: Row -> Parser e s Row
 p_CellLower row = pdbg "CellLower" $ do
        P.skipMany $ P.char ' '
        pos <- p_Position
        void $ P.char '<'
-       name <- p_name
+       name <- p_Name
        attrs <- p_attrs
        posClose <- p_Position
        let treeHere =
@@ -100,11 +109,6 @@ p_CellLower row = pdbg "CellLower" $ do
                (P.eof $> treeHere (Cell posClose posClose ""))
        return (tree:row)
        where
-       p_name :: Parser e s Name
-       p_name =
-               Text.pack
-                <$> many (P.satisfy $ \c ->
-                       Char.isAlphaNum c || c=='-' || c=='_')
        p_attrs = P.many $ P.try $
                (,)
                 <$> (Text.pack <$> P.some (P.char ' '))
@@ -126,7 +130,7 @@ p_CellLower row = pdbg "CellLower" $ do
                posEnd <- p_Position
                return $ Cell pos posEnd content
        p_CellLinesUntilElemEnd :: String -> Text -> Parser e s (Cell Text)
-       p_CellLinesUntilElemEnd indent name = P.dbg "CellLinesUntilElemEnd" $ do
+       p_CellLinesUntilElemEnd indent name = do
                pos     <- p_Position
                content <- Text.intercalate "\n" . List.reverse <$> go []
                posEnd  <- p_Position
index c9647d6405fca4d0c35ef33f9e6c4ef6ac4d5c9a..894b87b4fce0f3e49caa1dcb10d5ad613b40662d 100644 (file)
@@ -90,20 +90,23 @@ dtc ts = do
 d_Trees :: [Key] -> Trees (Cell Key) (Cell Tokens) -> DTC
 d_Trees path ts =
        case () of
-        _ | (ul,ts') <- gatherLIs ts, not (null ul) -> do
+        _ | (ul,ts') <- gatherUL ts, not (null ul) -> do
                D.ul $ forM_ ul $ d_Tree path
                d_Trees path ts'
+        _ | (ol,ts') <- gatherOL ts, not (null ol) -> do
+               D.ol $ forM_ ol $ d_Tree path
+               d_Trees path ts'
         _ | t:<ts' <- Seq.viewl ts -> do
                d_Tree path t
                d_Trees path ts'
         _ ->
                return ()
 
-gatherLIs ::
+gatherUL ::
  Trees (Cell Key) (Cell Tokens) ->
  ( Trees (Cell Key) (Cell Tokens)
  , Trees (Cell Key) (Cell Tokens) )
-gatherLIs ts =
+gatherUL ts =
        let (lis, ts') = spanLIs ts in
        foldl' accumLIs (mempty,ts') lis
        where
@@ -132,6 +135,39 @@ gatherLIs ts =
                 TokenPlain{} -> False
                 _ -> True
 
+gatherOL ::
+ Trees (Cell Key) (Cell Tokens) ->
+ ( Trees (Cell Key) (Cell Tokens)
+ , Trees (Cell Key) (Cell Tokens) )
+gatherOL ts =
+       let (lis, ts') = spanLIs ts in
+       foldl' accumLIs (mempty,ts') lis
+       where
+       spanLIs = Seq.spanl $ \case
+                TreeN (unCell -> KeyDot{}) _ -> True
+                Tree0 (unCell -> Tokens toks) ->
+                       (`any` toks) $ \case
+                        TokenPair (PairElem "li" _) _ -> True
+                        _ -> False
+                _ -> False
+       accumLIs acc@(oks,kos) t =
+               case t of
+                TreeN (unCell -> KeyDot{}) _ -> (oks|>t,kos)
+                Tree0 (Cell pos posEnd (Tokens toks)) ->
+                       let mk = Tree0 . Cell pos posEnd . Tokens in
+                       let (ok,ko) =
+                               (`Seq.spanl` toks) $ \case
+                                TokenPair (PairElem "li" _) _ -> True
+                                TokenPlain txt -> Char.isSpace`Text.all`txt
+                                _ -> False in
+                       ( if null ok then oks else oks|>mk (rmTokenPlain ok)
+                       , if null ko then kos else mk ko<|kos )
+                _ -> acc
+       rmTokenPlain =
+               Seq.filter $ \case
+                TokenPlain{} -> False
+                _ -> True
+
 d_Tree :: [Key] -> Tree (Cell Key) (Cell Tokens) -> DTC
 d_Tree path (TreeN (unCell -> key@KeySection{}) ts) =
        case Seq.viewl children of
@@ -173,7 +209,8 @@ d_CellKey path (Cell _pos _posEnd key) cells = do
         KeyGreat n _wh -> d_Key n
         KeyEqual n _wh -> d_Key n
         KeyBar   n _wh -> d_Key n
-        KeyDash -> D.li $ d_Trees (key:path) cells
+        KeyDot _n -> D.li $ d_Trees (key:path) cells
+        KeyDash   -> D.li $ d_Trees (key:path) cells
         {-
         KeyLower name attrs -> do
                B.Content $ "<"<>B.toMarkup name
index 9d7f3ce256b5421ecacef81c058879aeef95ecb7..81e963aa00c9f55b8670ae1f1c91b53bbfaf77c2 100644 (file)
@@ -129,6 +129,7 @@ h_CellKey (Cell _pos _posEnd key) cells = do
         KeyDash -> do
                H.toMarkup ("- "::Text)
                forM_ cells h_TreeCell
+        KeyDot n -> h_Key n "" "." "dot"
         KeyLower name attrs -> do
                H.span ! HA.class_ (mconcat ["key key-lower"," key-name-",attrValue name]) $ do
                        H.span ! HA.class_ "key-mark" $ H.toMarkup '<'