{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
module Text.Docvim.Visitor (endSection, extract, extractBlocks) where
import Control.Applicative
import Control.Monad
import Control.Monad.Writer
import Data.Data.Lens
import Text.Docvim.AST
import qualified Data.DList as DList
-- | Returns True if a node marks the end of a region/block/section.
endSection :: Node -> Bool
endSection = \case
CommandAnnotation {} -> True
CommandsAnnotation -> True
FooterAnnotation -> True
FunctionAnnotation _ -> True
FunctionsAnnotation -> True
MappingAnnotation _ -> True
MappingsAnnotation -> True
OptionAnnotation {} -> True
OptionsAnnotation -> True
PluginAnnotation {} -> True
_ -> False
extract :: ([Node] -> ([[a]], [Node])) -> Node -> (Node, [a])
extract extractNodes = toList . runWriter . postorder uniplate extractor
where
toList (ast, dlist) = (ast, concat $ DList.toList dlist)
extractor (DocBlock nodes) = do
let (extracted, remainder) = extractNodes nodes
tell (DList.fromList extracted)
return (DocBlock remainder)
extractor node = return node
extractBlocks :: Alternative f => (a -> Maybe (a -> Bool)) -> [a] -> (f [a], [a])
extractBlocks start = go
where
go [] = (empty, [])
go (x:xs) = maybe noExtract extract' (start x)
where
noExtract = (extracted, x:unextracted)
where
~(extracted, unextracted) = go xs
extract' stop = (pure (x:block) <|> extracted, unextracted)
where
~(block, remainder) = break stop xs
~(extracted, unextracted) = go remainder
postorder :: Monad m => ((a -> m c) -> (a -> m b)) -> (b -> m c) -> (a -> m c)
postorder t f = go
where
go = t go >=> f