git.iko.soy/elk
on 2deedfb help sign in
elk/src/Parse/Module.hs
295 lines 6.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module
4 ( module_
5 , chompImports
6 , freshLine
7 )
8 where
11import qualified Data.ByteString as B
12import Data.Text (Text)
14import qualified AST.Source as Src
15import qualified Elm.Name as N
16import Parse.Primitives (Parser, oneOf)
17import qualified Parse.Primitives as P
18import qualified Parse.Primitives.Keyword as Keyword
19import qualified Parse.Primitives.Symbol as Symbol
20import qualified Parse.Primitives.Variable as Var
21import qualified Parse.Primitives.Whitespace as W
22import qualified Reporting.Annotation as A
23import qualified Reporting.Error.Syntax as E
24import qualified Reporting.Region as R
28-- MODULE
31module_ :: Parser decls -> Parser (Src.Module decls)
32module_ chompDecls =
33 do freshLine
34 header <- oneOf [ Just <$> chompHeader, return Nothing ]
35 imports <- chompImports []
36 decls <- chompDecls
37 return (Src.Module header imports decls)
40chompHeader :: Parser Src.Header
41chompHeader =
42 do start <- P.getPosition
43 P.pushContext start E.Module
44 (name, effects) <- chompNameAndEffects
45 P.hint E.Exposing $ Keyword.exposing_
46 P.spaces
47 exports <- exposing
48 P.popContext ()
49 docs <- maybeDocComment
50 return (Src.Header name effects exports docs)
54-- MODULE NAME
55--
56-- module MyThing
57-- port module MyThing
58-- effect module MyThing where { command = MyCmd }
59--
60chompNameAndEffects :: Parser (N.Name, Src.Effects)
61chompNameAndEffects =
62 oneOf
63 [
64 do Keyword.module_
65 P.spaces
66 name <- Var.moduleName
67 P.spaces
68 return ( name, Src.NoEffects )
69 ,
70 do start <- P.getPosition
71 Keyword.port_
72 P.spaces
73 Keyword.module_
74 end <- P.getPosition
75 P.spaces
76 name <- Var.moduleName
77 P.spaces
78 return ( name, Src.Ports (R.Region start end) )
79 ,
80 do start <- P.getPosition
81 Keyword.effect_
82 P.spaces
83 Keyword.module_
84 end <- P.getPosition
85 P.spaces
86 name <- Var.moduleName
87 P.spaces
88 manager <- chompManager
89 return ( name, Src.Manager (R.Region start end) manager )
90 ]
94-- MANAGER
95--
96-- where { command = MyCmd }
97-- where { subscription = MySub }
98-- where { command = MyCmd, subscription = MySub }
99--
100chompManager :: Parser Src.Manager
101chompManager =
102 do Keyword.where_
103 P.spaces
104 Symbol.leftCurly
105 P.spaces
106 oneOf
107 [ do cmd <- chompCommand
108 P.spaces
109 oneOf
110 [ do Symbol.rightCurly
111 P.spaces
112 return (Src.Cmd cmd)
113 , do Symbol.comma
114 P.spaces
115 sub <- chompSubscription
116 P.spaces
117 Symbol.rightCurly
118 P.spaces
119 return (Src.Fx cmd sub)
120 ]
121 , do sub <- chompSubscription
122 P.spaces
123 oneOf
124 [ do Symbol.rightCurly
125 P.spaces
126 return (Src.Sub sub)
127 , do Symbol.comma
128 P.spaces
129 cmd <- chompCommand
130 P.spaces
131 Symbol.rightCurly
132 P.spaces
133 return (Src.Fx cmd sub)
134 ]
135 ]
138chompCommand :: Parser (A.Located Text)
139chompCommand =
140 do Keyword.command_
141 P.spaces
142 Symbol.equals
143 P.spaces
144 P.addLocation Var.upper
147chompSubscription :: Parser (A.Located Text)
148chompSubscription =
149 do Keyword.subscription_
150 P.spaces
151 Symbol.equals
152 P.spaces
153 P.addLocation Var.upper
157-- DOC COMMENTS
160maybeDocComment :: Parser (Maybe (A.Located B.ByteString))
161maybeDocComment =
162 do freshLine
163 newStart <- P.getPosition
164 oneOf
165 [ do doc <- W.docComment
166 end <- P.getPosition
167 freshLine
168 return (Just (A.at newStart end doc))
169 , return Nothing
170 ]
174-- IMPORTS
177chompImports :: [Src.Import] -> Parser [Src.Import]
178chompImports imports =
179 oneOf
180 [ do start <- P.getPosition
181 Keyword.import_
182 P.pushContext start E.Import
183 P.spaces
184 name <- P.addLocation Var.moduleName
185 pos <- W.whitespace
186 oneOf
187 [ do P.checkFreshLine pos
188 P.popContext ()
189 chompImports $
190 Src.Import name Nothing (Src.Explicit []) : imports
191 , do P.checkSpace pos
192 oneOf
193 [ chompAs name imports
194 , chompExposing name Nothing imports
195 ]
196 ]
197 , return (reverse imports)
198 ]
201chompAs :: A.Located Text -> [Src.Import] -> Parser [Src.Import]
202chompAs name imports =
203 do Keyword.as_
204 P.spaces
205 alias <- Var.upper
206 pos <- W.whitespace
207 oneOf
208 [ do P.checkFreshLine pos
209 P.popContext ()
210 chompImports $
211 Src.Import name (Just alias) (Src.Explicit []) : imports
212 , do P.checkSpace pos
213 chompExposing name (Just alias) imports
214 ]
217chompExposing :: A.Located Text -> Maybe Text -> [Src.Import] -> Parser [Src.Import]
218chompExposing name maybeAlias imports =
219 do Keyword.exposing_
220 P.spaces
221 exposed <- exposing
222 freshLine
223 P.popContext ()
224 chompImports $
225 Src.Import name maybeAlias exposed : imports
229-- LISTING
232exposing :: Parser Src.Exposing
233exposing =
234 P.hint E.Listing $
235 do Symbol.leftParen
236 P.spaces
237 oneOf
238 [ do Symbol.doubleDot
239 P.spaces
240 Symbol.rightParen
241 return Src.Open
242 , do entry <- P.addLocation chompEntry
243 P.spaces
244 exposingHelp [entry]
245 ]
248exposingHelp :: [A.Located Src.Exposed] -> Parser Src.Exposing
249exposingHelp revEntries =
250 oneOf
251 [ do Symbol.comma
252 P.spaces
253 entry <- P.addLocation chompEntry
254 P.spaces
255 exposingHelp (entry:revEntries)
256 , do Symbol.rightParen
257 return (Src.Explicit (reverse revEntries))
258 ]
261chompEntry :: Parser Src.Exposed
262chompEntry =
263 oneOf
264 [ Src.Lower <$> Var.lower
265 , do Symbol.leftParen
266 op <- Symbol.binop
267 Symbol.rightParen
268 return (Src.Lower op)
269 , do name <- Var.upper
270 P.spaces
271 Src.Upper name <$> privacy
272 ]
275privacy :: Parser Src.Privacy
276privacy =
277 oneOf
278 [ do Symbol.leftParen
279 P.spaces
280 Symbol.doubleDot
281 P.spaces
282 Symbol.rightParen
283 return Src.Public
284 , return Src.Private
285 ]
289-- FRESH LINES
292freshLine :: Parser ()
293freshLine =
294 P.checkFreshLine =<< W.whitespace