]> git.wincent.com - docvim.git/blob - lib/Docvim/Visitor/Section.hs
7133647efdb8d665029f2056f2c1cb05ffc6ae61
[docvim.git] / lib / Docvim / Visitor / Section.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE MultiWayIf #-}
3 {-# LANGUAGE TemplateHaskell #-}
4
5 module Docvim.Visitor.Section ( injectCommands
6                               , injectFunctions
7                               , injectMappings
8                               , injectOptions
9                               ) where
10
11 import Control.Lens
12 import Control.Monad.State
13 import Data.Data.Lens (uniplate)
14 import Docvim.AST
15
16 data SectionInfo = SectionInfo { _hasCommand :: Bool
17                                , _hasCommands :: Bool
18                                , _hasFunction :: Bool
19                                , _hasFunctions :: Bool
20                                , _hasMapping :: Bool
21                                , _hasMappings :: Bool
22                                , _hasOption :: Bool
23                                , _hasOptions :: Bool
24                                } deriving (Show)
25
26 type Env = State SectionInfo
27
28 -- Could also have written record setters by hand, but too lazy to do this:
29 --
30 --     setHasCommand :: SectionInfo -> SectionInfo
31 --     setHasCommand info = info { hasCommand = True }
32 --
33 -- With lenses, we can auto-generate functions that we call like this:
34 --
35 --     view hasCommand info             (reading)
36 --     info ^. hasCommand               (reading, using operator)
37 --     set hasCommand True info         (writing)
38 --     info & hasCommand .~ True        (writing, using operators)
39 --
40 -- Or, given that we are using the State monad here, we'll be using the `.=`
41 -- operator to update the state using a lens.
42 --
43 makeLenses ''SectionInfo
44
45 defaultSectionInfo :: SectionInfo
46 defaultSectionInfo = SectionInfo { _hasCommand = False
47                                  , _hasCommands = False
48                                  , _hasFunction = False
49                                  , _hasFunctions = False
50                                  , _hasMapping = False
51                                  , _hasMappings = False
52                                  , _hasOption = False
53                                  , _hasOptions = False
54                                  }
55
56 -- | Walks the supplied AST detecting whether it contains
57 -- `@commands`/`@command`, `@functions`/`@function`, `@mappings`/`@mapping` or
58 -- `@options`/`@options` sections.
59 --
60 -- Will be used as follows:
61 --   - DO have @commands? -> do nothing
62 --   - DON'T have @commands but DO have @command? -> Synthesize CommandsAnnotation
63 --   - DON'T we have either? -> do nothing
64 --
65 getSectionInfo :: Node -> SectionInfo
66 getSectionInfo n = execState (mapMOf_ (cosmosOf uniplate) check n) defaultSectionInfo
67   where
68     check CommandAnnotation {}   = hasCommand .= True
69     check CommandsAnnotation     = hasCommands .= True
70     check (FunctionAnnotation _) = hasFunction .= True
71     check FunctionsAnnotation    = hasFunctions .= True
72     check (MappingAnnotation _)  = hasMapping .= True
73     check MappingsAnnotation     = hasMappings .= True
74     check OptionAnnotation {}    = hasOption .= True
75     check OptionsAnnotation      = hasOptions .= True
76     check _                      = modify id
77
78 injectCommands :: Node -> Node
79 injectCommands n =
80   if | info ^. hasCommands -> n
81      | info ^. hasCommand -> inject n
82      | otherwise -> n
83   where
84     info = getSectionInfo n
85     inject (Project ns) = Project $ ns ++ [CommandsAnnotation]
86     inject _ = n
87
88 injectFunctions :: Node -> Node
89 injectFunctions n =
90   if | info ^. hasFunctions -> n
91      | info ^. hasFunction -> inject n
92      | otherwise -> n
93   where
94     info = getSectionInfo n
95     inject (Project ns) = Project $ ns ++ [FunctionsAnnotation]
96     inject _ = n
97
98 injectMappings :: Node -> Node
99 injectMappings n =
100   if | info ^. hasMappings -> n
101      | info ^. hasMapping -> inject n
102      | otherwise -> n
103   where
104     info = getSectionInfo n
105     inject (Project ns) = Project $ ns ++ [MappingsAnnotation]
106     inject _ = n
107
108 injectOptions :: Node -> Node
109 injectOptions n =
110   if | info ^. hasOptions -> n
111      | info ^. hasOption -> inject n
112      | otherwise -> n
113   where
114     info = getSectionInfo n
115     inject (Project ns) = Project $ ns ++ [OptionsAnnotation]
116     inject _ = n