aboutsummaryrefslogtreecommitdiff
path: root/bbcode/src
diff options
context:
space:
mode:
Diffstat (limited to 'bbcode/src')
-rw-r--r--bbcode/src/Text/BBCode.hs16
1 files changed, 6 insertions, 10 deletions
diff --git a/bbcode/src/Text/BBCode.hs b/bbcode/src/Text/BBCode.hs
index 75fa219..2e3a753 100644
--- a/bbcode/src/Text/BBCode.hs
+++ b/bbcode/src/Text/BBCode.hs
@@ -19,7 +19,7 @@ import GHC.Generics (Generic)
19import Control.Exception (Exception) 19import Control.Exception (Exception)
20import Data.Typeable (Typeable) 20import Data.Typeable (Typeable)
21 21
22import Control.Monad (unless, join) 22import Control.Monad (unless, join, foldM)
23import Data.Function (on) 23import Data.Function (on)
24import Control.Applicative 24import Control.Applicative
25 25
@@ -87,16 +87,12 @@ rose :: [BBToken] -> Either TreeError (Forest BBLabel)
87-- We use @'Tree' 'BBLabel'@ only as another intermediate structure because it carries no guarantee that the data is semantically valid -- a 'BBPlain'-value semantically has no children. 87-- We use @'Tree' 'BBLabel'@ only as another intermediate structure because it carries no guarantee that the data is semantically valid -- a 'BBPlain'-value semantically has no children.
88-- 88--
89-- The use of 'Tree' was still deemed desirable because the morphism to a more sensible structure is straightforward and 'Data.Tree.Zipper' provides all the tools needed to implement 'rose' in a sensible fashion 89-- The use of 'Tree' was still deemed desirable because the morphism to a more sensible structure is straightforward and 'Data.Tree.Zipper' provides all the tools needed to implement 'rose' in a sensible fashion
90rose = fmap Z.toForest . flip rose' (Z.fromForest []) 90rose = fmap Z.toForest . foldM (flip rose') (Z.fromForest [])
91 where 91 where
92 rose' :: [BBToken] -> TreePos Empty BBLabel -> Either TreeError (TreePos Empty BBLabel) 92 rose' (BBStr t) = return . Z.nextSpace . Z.insert (Node (BBPlain t) [])
93 rose' [] = return 93 rose' (BBOpen t attrs) = return . Z.children . Z.insert (Node (BBTag t $ Map.fromList attrs) [])
94 rose' (x:xs) = (>>= rose' xs) . rose'' x 94 rose' (BBContained t attrs) = return . Z.nextSpace . Z.insert (Node (BBTag t $ Map.fromList attrs) [])
95 95 rose' (BBClose t) = close t -- for more pointless
96 rose'' (BBStr t) = return . Z.nextSpace . Z.insert (Node (BBPlain t) [])
97 rose'' (BBOpen t attrs) = return . Z.children . Z.insert (Node (BBTag t $ Map.fromList attrs) [])
98 rose'' (BBContained t attrs) = return . Z.nextSpace . Z.insert (Node (BBTag t $ Map.fromList attrs) [])
99 rose'' (BBClose t) = close t -- for more pointless
100 96
101 close :: Text -> TreePos Empty BBLabel -> Either TreeError (TreePos Empty BBLabel) 97 close :: Text -> TreePos Empty BBLabel -> Either TreeError (TreePos Empty BBLabel)
102 close tag pos = do 98 close tag pos = do