]> git.wincent.com - docvim.git/blob - lib/Docvim/Visitor/Section.hs
DRY up injection
[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 -- | Appends a node to the end of a Project.
79 inject :: Node -> Node -> Node
80 inject (Project ns) n = Project $ ns ++ [n]
81 inject other _ = other
82
83 injectCommands :: Node -> Node
84 injectCommands n =
85   if | getSectionInfo n ^. hasCommands -> n
86      | getSectionInfo n ^. hasCommand -> inject n CommandsAnnotation
87      | otherwise -> n
88
89 injectFunctions :: Node -> Node
90 injectFunctions n =
91   if | getSectionInfo n ^. hasFunctions -> n
92      | getSectionInfo n ^. hasFunction -> inject n FunctionsAnnotation
93      | otherwise -> n
94
95 injectMappings :: Node -> Node
96 injectMappings n =
97   if | getSectionInfo n ^. hasMappings -> n
98      | getSectionInfo n ^. hasMapping -> inject n MappingsAnnotation
99      | otherwise -> n
100
101 injectOptions :: Node -> Node
102 injectOptions n =
103   if | getSectionInfo n ^. hasOptions -> n
104      | getSectionInfo n ^. hasOption -> inject n OptionsAnnotation
105      | otherwise -> n