Fixed handling of juxtaposition at toplevel

1 files changed, 9 insertions, 7 deletions

diff --git a/bbcode/src/Text/BBCode.hs b/bbcode/src/Text/BBCode.hs
index 8f04f19..ac56974 100644
--- a/bbcode/src/Text/BBCode.hs
+++ b/bbcode/src/Text/BBCode.hs
@@ -50,14 +50,16 @@ type DomForest = [[DomTree]]
 dom :: Forest BBLabel -> DomForest
 -- ^ Parse semantically constrained rose tree to syntactically constrained version
 --
--- Silently drops children of semantically terminal nodes ('BBPlain') and paragraphs anywhere but at top level
-dom = map fromPar
+-- Silently drops children of semantically terminal nodes ('BBPlain')
+--
+-- We already ensured that paragraphs occur nowhere but at toplevel
+dom = map (\(Node BBPar ts) -> map dom' ts) . ensureTopLevelPar
   where
-    fromPar (Node BBPar ts) = concatMap dom' ts
-    fromPar x               = dom' x
-    dom' (Node (BBPlain t) _)      = pure $ Content t
-    dom' (Node (BBTag t attrs) ts) = pure . Element (CI.mk t) (Map.mapKeys CI.mk attrs) $ concatMap dom' ts
-    dom' (Node BBPar _)            = []
+    ensureTopLevelPar xs@((Node BBPar _):_) = xs
+    ensureTopLevelPar xs                    = pure $ Node BBPar xs
+    
+    dom' (Node (BBPlain t) _)      = Content t
+    dom' (Node (BBTag t attrs) ts) = Element (CI.mk t) (Map.mapKeys CI.mk attrs) $ map dom' ts
 
 -- | Errors encountered during parsing
 data BBCodeError = LexerError String -- ^ Error while parsing input to stream of tokens