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
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 =
(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 ' '))
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
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
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
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