git.iko.soy/elk
on 9111afa help sign in
elk/src/Parse/Module.hs
290 lines 6.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module
4 ( header
5 , kernelHeader
6 )
7 where
9import Data.Text (Text)
11import qualified AST.Exposing as Exposing
12import qualified AST.Module as Module
13import Parse.Helpers
14import qualified Reporting.Annotation as A
15import qualified Reporting.Error.Syntax as E
16import qualified Reporting.Region as R
20-- MODULE HEADER
23header :: Parser (Module.Header [Module.UserImport])
24header =
25 do freshLine
26 Module.Header <$> maybeHeaderDecl <*> chompImports []
29kernelHeader :: Parser [Module.UserImport]
30kernelHeader =
31 do headerOpen
32 freshLine
33 imports <- chompImports []
34 headerClose
35 return imports
38{-# NOINLINE headerOpen #-}
39headerOpen :: Parser ()
40headerOpen =
41 symbol "/*"
44{-# NOINLINE headerClose #-}
45headerClose :: Parser ()
46headerClose =
47 symbol "*/"
51-- HEADER DECL
54maybeHeaderDecl :: Parser (Maybe Module.HeaderDecl)
55maybeHeaderDecl =
56 oneOf
57 [ Just <$> headerDecl
58 , return Nothing
59 ]
62headerDecl :: Parser Module.HeaderDecl
63headerDecl =
64 do start <- getPosition
65 pushContext start E.Module
66 tag <- sourceTag
67 spaces
68 name <- qualifiedCapVar
69 spaces
70 settings <- effectSettings
71 hint E.Exposing $ keyword "exposing"
72 spaces
73 exports <- exposing exposingEntry
74 popContext ()
75 docs <- maybeDocComment
76 return (Module.HeaderDecl tag name exports settings docs)
80-- MODULE TAGS - module, effect module, port module
83sourceTag :: Parser Module.SourceTag
84sourceTag =
85 oneOf
86 [
87 do keyword "module"
88 return Module.Normal
89 ,
90 do start <- getPosition
91 keyword "port"
92 spaces
93 keyword "module"
94 end <- getPosition
95 return (Module.Port (R.Region start end))
96 ,
97 do start <- getPosition
98 keyword "effect"
99 spaces
100 keyword "module"
101 end <- getPosition
102 return (Module.Effect (R.Region start end))
103 ]
107-- EFFECTS - where { command = MyCmd }
110effectSettings :: Parser Module.SourceSettings
111effectSettings =
112 oneOf
113 [ do keyword "where"
114 spaces
115 start <- getPosition
116 leftCurly
117 spaces
118 entry <- setting
119 spaces
120 effectSettingsHelp start [entry]
121 , return Module.emptySettings
122 ]
125effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings
126effectSettingsHelp start entries =
127 oneOf
128 [ do comma
129 spaces
130 entry <- setting
131 spaces
132 effectSettingsHelp start (entry:entries)
133 , do rightCurly
134 end <- getPosition
135 spaces
136 return (A.at start end entries)
137 ]
140setting :: Parser (A.Located Text, A.Located Text)
141setting =
142 do name <- addLocation lowVar
143 spaces
144 equals
145 spaces
146 tipe <- addLocation capVar
147 return (name, tipe)
151-- DOC COMMENTS
154maybeDocComment :: Parser (A.Located (Maybe Text))
155maybeDocComment =
156 do oldEnd <- getPosition
157 freshLine
158 newStart <- getPosition
159 oneOf
160 [ do doc <- docComment
161 end <- getPosition
162 freshLine
163 return (A.at newStart end (Just doc))
164 , return (A.at oldEnd newStart Nothing)
165 ]
169-- IMPORTS
172chompImports :: [Module.UserImport] -> Parser [Module.UserImport]
173chompImports imports =
174 oneOf
175 [ do start <- getPosition
176 keyword "import"
177 pushContext start E.Import
178 spaces
179 name <- addLocation qualifiedCapVar
180 end <- getPosition
181 pos <- whitespace
182 oneOf
183 [ do checkFreshLine pos
184 let userImport = method start end name Nothing Exposing.closed
185 popContext ()
186 chompImports (userImport:imports)
187 , do checkSpace pos
188 oneOf
189 [ chompAs start name imports
190 , chompExposing start name Nothing imports
191 ]
192 ]
193 , return (reverse imports)
194 ]
197chompAs :: R.Position -> A.Located Text -> [Module.UserImport] -> Parser [Module.UserImport]
198chompAs start name imports =
199 do keyword "as"
200 spaces
201 alias <- capVar
202 end <- getPosition
203 pos <- whitespace
204 oneOf
205 [ do checkFreshLine pos
206 let userImport = method start end name (Just alias) (Exposing.Explicit [])
207 popContext ()
208 chompImports (userImport:imports)
209 , do checkSpace pos
210 chompExposing start name (Just alias) imports
211 ]
214chompExposing :: R.Position -> A.Located Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]
215chompExposing start name maybeAlias imports =
216 do keyword "exposing"
217 spaces
218 exposed <- exposing exposingEntry
219 end <- getPosition
220 freshLine
221 let userImport = method start end name maybeAlias exposed
222 popContext ()
223 chompImports (userImport:imports)
226method :: R.Position -> R.Position -> A.Located Text -> Maybe Text -> Exposing.Raw -> Module.UserImport
227method start end name maybeAlias exposed =
228 A.at start end ( name, Module.ImportMethod maybeAlias exposed )
232-- LISTING
235exposing :: Parser a -> Parser (Exposing.Exposing a)
236exposing parser =
237 hint E.Listing $
238 do leftParen
239 spaces
240 oneOf
241 [ do dot
242 dot
243 spaces
244 rightParen
245 return Exposing.Open
246 , do value <- addLocation parser
247 spaces
248 exposingHelp parser [value]
249 ]
252exposingHelp :: Parser a -> [A.Located a] -> Parser (Exposing.Exposing a)
253exposingHelp parser values =
254 oneOf
255 [ do comma
256 spaces
257 value <- addLocation parser
258 spaces
259 exposingHelp parser (value:values)
260 , do rightParen
261 return (Exposing.Explicit (reverse values))
262 ]
265exposingEntry :: Parser Exposing.Entry
266exposingEntry =
267 oneOf
268 [ Exposing.Lower <$> lowVar
269 , do leftParen
270 op <- infixOp
271 rightParen
272 return (Exposing.Lower op)
273 , do name <- capVar
274 spaces
275 Exposing.Upper name <$>
276 oneOf
277 [ Just <$> exposing capVar
278 , return Nothing
279 ]
280 ]
284-- FRESH LINES
287freshLine :: Parser ()
288freshLine =
289 checkFreshLine =<< whitespace