]> git.wincent.com - docvim.git/blob - lib/Docvim/Visitor.hs
Don't rely on transformers
[docvim.git] / lib / Docvim / Visitor.hs
1 {-# LANGUAGE LambdaCase #-}
2 {-# LANGUAGE FlexibleContexts #-}
3
4 module Docvim.Visitor (endBlock, extract, extractBlocks) where
5
6 import Control.Applicative (Alternative, (<|>), empty)
7 import Control.Monad ((>=>))
8 import Control.Monad.Writer (runWriter, tell)
9 import Data.Data.Lens
10 import Docvim.AST
11 import qualified Data.DList as DList
12
13 -- | Returns True if a node marks the end of a region/block.
14 endBlock :: Node -> Bool
15 endBlock = \case
16   CommandAnnotation _    -> True
17   FooterAnnotation       -> True
18   FunctionAnnotation _   -> True
19   MappingAnnotation _    -> True
20   MappingsAnnotation     -> True
21   OptionAnnotation {}    -> True
22   PluginAnnotation {}    -> True
23   _                      -> False
24
25 extract extractNodes = toList . runWriter . postorder uniplate extractor
26   where
27     toList (ast, dlist) = (ast, concat $ DList.toList dlist)
28     extractor (DocBlock nodes) = do
29       let (extracted, remainder) = extractNodes nodes
30       tell (DList.fromList extracted)
31       return (DocBlock remainder)
32     extractor node = return node
33
34 extractBlocks :: Alternative f => (a -> Maybe (a -> Bool)) -> [a] -> (f [a], [a])
35 extractBlocks start = go
36   where
37     go     [] = (empty, [])
38     go (x:xs) = maybe no_extract extract (start x)
39       where
40         no_extract = (extracted, x:unextracted)
41           where
42             ~(extracted, unextracted) = go xs
43         extract stop = (pure (x:block) <|> extracted, unextracted)
44           where
45             ~(block, remainder) = break stop xs
46             ~(extracted, unextracted) = go remainder
47
48 postorder :: Monad m => ((a -> m c) -> (a -> m b)) -> (b -> m c) -> (a -> m c)
49 postorder t f = go
50   where
51     go = t go >=> f