diff --git a/lib/Text/TEIWA/Annotation.hs b/lib/Text/TEIWA/Annotation.hs index 6fd9f82515972c5d076bd4d16887ad73e63d50c2..8c1d502433afaf5f2878724dfbf8a9f2deeee61c 100644 --- a/lib/Text/TEIWA/Annotation.hs +++ b/lib/Text/TEIWA/Annotation.hs @@ -32,12 +32,12 @@ data Annotation = Token Text | Annotations [Node] deriving Show attribute :: (Text, Text) -> Text attribute (k, v) = Text.concat [" ", k, "=\"", v, "\""] -openTag :: Tag -> String -openTag (Tag {name, annotated}) = +openTag :: Tag -> Editor m +openTag (Tag {name, annotated}) = tell . Text.pack $ printf "<%s%s>" name . Text.concat $ attribute <$> annotated -closeTag :: Tag -> String -closeTag = printf "</%s>" . name +closeTag :: Tag -> Editor m +closeTag = tell . Text.pack $ printf "</%s>" . name data EditorState = EditorState { input :: Text @@ -45,15 +45,13 @@ data EditorState = EditorState { } type Editor m = RWST Config Text EditorState m () -enter :: Monad m => Tag -> Editor m -enter t = modify $ - \editorState -> editorState {tagStack = t:tagStack editorState} +editStack :: MonadState EditorState m => ([Tag] -> (a, [Tag])) -> m a +editStack f = state $ \editorState -> + let (output, newTagStack) = f $ tagStack editorState in + (output, editorState {tagStack = newTagStack}) flushTags :: Monad m => Editor m -flushTags = do - tags <- gets tagStack - modify $ \editorState -> editorState {tagStack = []} - mapM_ (tell . Text.pack . openTag) tags +flushTags = editStack (\stack -> (stack, [])) >>= mapM_ openTag forget :: Monad m => Int64 -> Editor m forget count = modify $ @@ -61,7 +59,7 @@ forget count = modify $ annotateNode :: MonadError Error m => Node -> Editor m annotateNode (Node {tag, inside}) = - enter tag *> annotator inside *> tell (Text.pack $ closeTag tag) + editStack (\s -> ((), tag:s)) *> annotator inside *> closeTag tag annotator :: MonadError Error m => Annotation -> Editor m annotator (Token t) = gets (Text.breakOn t . input) >>= wrap