From dc99dae05d94f324c710748191e2241674af7ce1 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 13 Jan 2016 04:08:44 +0100 Subject: minor code cleanup --- bbcode/src/Text/BBCode.hs | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) (limited to 'bbcode') 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) import Control.Exception (Exception) import Data.Typeable (Typeable) -import Control.Monad (unless, join) +import Control.Monad (unless, join, foldM) import Data.Function (on) import Control.Applicative @@ -87,16 +87,12 @@ rose :: [BBToken] -> Either TreeError (Forest BBLabel) -- 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. -- -- 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 -rose = fmap Z.toForest . flip rose' (Z.fromForest []) +rose = fmap Z.toForest . foldM (flip rose') (Z.fromForest []) where - rose' :: [BBToken] -> TreePos Empty BBLabel -> Either TreeError (TreePos Empty BBLabel) - rose' [] = return - rose' (x:xs) = (>>= rose' xs) . rose'' x - - rose'' (BBStr t) = return . Z.nextSpace . Z.insert (Node (BBPlain t) []) - rose'' (BBOpen t attrs) = return . Z.children . Z.insert (Node (BBTag t $ Map.fromList attrs) []) - rose'' (BBContained t attrs) = return . Z.nextSpace . Z.insert (Node (BBTag t $ Map.fromList attrs) []) - rose'' (BBClose t) = close t -- for more pointless + rose' (BBStr t) = return . Z.nextSpace . Z.insert (Node (BBPlain t) []) + rose' (BBOpen t attrs) = return . Z.children . Z.insert (Node (BBTag t $ Map.fromList attrs) []) + rose' (BBContained t attrs) = return . Z.nextSpace . Z.insert (Node (BBTag t $ Map.fromList attrs) []) + rose' (BBClose t) = close t -- for more pointless close :: Text -> TreePos Empty BBLabel -> Either TreeError (TreePos Empty BBLabel) close tag pos = do -- cgit v1.2.3