From c180b22047e09ec35daf3746d50b6a5765d30b88 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+tct@autogeree.net>
Date: Wed, 25 Oct 2017 05:19:09 +0200
Subject: [PATCH] Add <li> and KeyDash merging.
---
Language/TCT/Write/DTC.hs | 51 ++++++++++++++++++++++++++++++++-------
1 file changed, 42 insertions(+), 9 deletions(-)
diff --git a/Language/TCT/Write/DTC.hs b/Language/TCT/Write/DTC.hs
index 86e1329..8b495a2 100644
--- a/Language/TCT/Write/DTC.hs
+++ b/Language/TCT/Write/DTC.hs
@@ -7,23 +7,26 @@ module Language.TCT.Write.DTC where
import Control.Monad (Monad(..), forM_, when)
import Data.Bool
-import Data.Foldable (Foldable(..))
+import Data.Foldable (foldr, null, foldMap, foldl', any)
import Data.Function (($), (.), flip)
import Data.Functor ((<$>))
+import Data.Map.Strict (Map)
+import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
-import Data.Sequence (ViewL(..))
+import Data.Sequence (ViewL(..), (<|), (|>))
import Data.String (String)
import Data.Text (Text)
+import GHC.Exts (toList)
import Text.Blaze ((!))
import Text.Show (Show(..))
-import Data.Map.Strict (Map)
+import qualified Data.Char as Char
+import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq
import qualified Data.Text as Text
+import qualified Data.Text.Lazy as TL
import qualified Text.Blaze as B
import qualified Text.Blaze.Internal as B
-import qualified Data.Text.Lazy as TL
-import qualified Data.Map.Strict as Map
import Language.TCT.Tree
import Language.TCT.Token
@@ -87,10 +90,7 @@ dtc ts = do
d_Trees :: [Key] -> Trees (Cell Key) (Cell Tokens) -> DTC
d_Trees path ts =
case () of
- _ | (ul,ts') <- Seq.spanl (\case TreeN (unCell -> KeyDash) _ -> True
- Tree0 (unCell -> unTokens -> toList -> [TokenPair (PairElem "li" _) _]) -> True
- _ -> False) ts
- , not (null ul) -> do
+ _ | (ul,ts') <- gatherLIs ts, not (null ul) -> do
D.ul $ forM_ ul $ d_Tree path
d_Trees path ts'
_ | t:<ts' <- Seq.viewl ts -> do
@@ -99,6 +99,39 @@ d_Trees path ts =
_ ->
return ()
+gatherLIs ::
+ Trees (Cell Key) (Cell Tokens) ->
+ ( Trees (Cell Key) (Cell Tokens)
+ , Trees (Cell Key) (Cell Tokens) )
+gatherLIs ts =
+ let (lis, ts') = spanLIs ts in
+ foldl' accumLIs (mempty,ts') lis
+ where
+ spanLIs = Seq.spanl $ \case
+ TreeN (unCell -> KeyDash) _ -> True
+ Tree0 (unCell -> Tokens toks) ->
+ (`any` toks) $ \case
+ TokenPair (PairElem "li" _) _ -> True
+ _ -> False
+ _ -> False
+ accumLIs acc@(oks,kos) t =
+ case t of
+ TreeN (unCell -> KeyDash) _ -> (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
--
2.47.2