Fixed handling of juxtaposition at toplevel

4 files changed, 13 insertions, 9 deletions

diff --git a/bbcode/bbcode.cabal b/bbcode/bbcode.cabal
index 58ea8d1..49e7a01 100644
--- a/bbcode/bbcode.cabal
+++ b/bbcode/bbcode.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                bbcode
-version:             1.0.0
+version:             2.0.0
 synopsis:            A parser for bbcode
 -- description:         
 homepage:            http://dirty-haskell.org/tags/thermoprint.html
diff --git a/bbcode/bbcode.nix b/bbcode/bbcode.nix
index 97f8982..ddb055c 100644
--- a/bbcode/bbcode.nix
+++ b/bbcode/bbcode.nix
@@ -3,7 +3,7 @@
 }:
 mkDerivation {
   pname = "bbcode";
-  version = "1.0.0";
+  version = "2.0.0";
   src = ./.;
   libraryHaskellDepends = [
     attoparsec base case-insensitive containers rosezipper text
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
diff --git a/bbcode/test/Text/BBCodeSpec.hs b/bbcode/test/Text/BBCodeSpec.hs
index 241cd76..a6e66b6 100644
--- a/bbcode/test/Text/BBCodeSpec.hs
+++ b/bbcode/test/Text/BBCodeSpec.hs
@@ -59,5 +59,7 @@ examples = [ ("[t]test[/t]"
              , [[Content "foo"], [Content "bar"]])
            , ("[b]foo[/b]\n\n[b]bar[/b]"
              , [[Element "b" [] [Content "foo"]], [Element "b" [] [Content "bar"]]])
+           , ("[b]foo[/b][b]bar[/b]"
+             , [[Element "b" [] [Content "foo"], Element "b" [] [Content "bar"]]])
            ]