git.iko.soy/elk
on ae8d75c help sign in
elk/src/Parse/Module.hs
268 lines 6.1 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module
4 ( header
5 )
6 where
8import Data.Text (Text)
10import qualified AST.Exposing as Exposing
11import qualified AST.Module as Module
12import Parse.Helpers
13import qualified Reporting.Annotation as A
14import qualified Reporting.Error.Syntax as E
15import qualified Reporting.Region as R
19-- MODULE HEADER
22header :: Parser (Module.Header [Module.UserImport])
23header =
24 do freshLine
25 Module.Header <$> maybeHeaderDecl <*> chompImports []
29-- HEADER DECL
32maybeHeaderDecl :: Parser (Maybe Module.HeaderDecl)
33maybeHeaderDecl =
34 oneOf
35 [ Just <$> headerDecl
36 , return Nothing
37 ]
40headerDecl :: Parser Module.HeaderDecl
41headerDecl =
42 do start <- getPosition
43 pushContext start E.Module
44 tag <- sourceTag
45 spaces
46 name <- qualifiedCapVar
47 spaces
48 settings <- effectSettings
49 hint E.Exposing $ keyword "exposing"
50 spaces
51 exports <- exposing exposingEntry
52 popContext ()
53 docs <- maybeDocComment
54 return (Module.HeaderDecl tag name exports settings docs)
58-- MODULE TAGS - module, effect module, port module
61sourceTag :: Parser Module.SourceTag
62sourceTag =
63 oneOf
64 [
65 do keyword "module"
66 return Module.Normal
67 ,
68 do start <- getPosition
69 keyword "port"
70 spaces
71 keyword "module"
72 end <- getPosition
73 return (Module.Port (R.Region start end))
74 ,
75 do start <- getPosition
76 keyword "effect"
77 spaces
78 keyword "module"
79 end <- getPosition
80 return (Module.Effect (R.Region start end))
81 ]
85-- EFFECTS - where { command = MyCmd }
88effectSettings :: Parser Module.SourceSettings
89effectSettings =
90 oneOf
91 [ do keyword "where"
92 spaces
93 start <- getPosition
94 leftCurly
95 spaces
96 entry <- setting
97 spaces
98 effectSettingsHelp start [entry]
99 , return Module.emptySettings
100 ]
103effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings
104effectSettingsHelp start entries =
105 oneOf
106 [ do comma
107 spaces
108 entry <- setting
109 spaces
110 effectSettingsHelp start (entry:entries)
111 , do rightCurly
112 end <- getPosition
113 spaces
114 return (A.at start end entries)
115 ]
118setting :: Parser (A.Located Text, A.Located Text)
119setting =
120 do name <- addLocation lowVar
121 spaces
122 equals
123 spaces
124 tipe <- addLocation capVar
125 return (name, tipe)
129-- DOC COMMENTS
132maybeDocComment :: Parser (A.Located (Maybe Text))
133maybeDocComment =
134 do oldEnd <- getPosition
135 freshLine
136 newStart <- getPosition
137 oneOf
138 [ do doc <- docComment
139 end <- getPosition
140 freshLine
141 return (A.at newStart end (Just doc))
142 , return (A.at oldEnd newStart Nothing)
143 ]
147-- IMPORTS
150chompImports :: [Module.UserImport] -> Parser [Module.UserImport]
151chompImports imports =
152 oneOf
153 [ do start <- getPosition
154 keyword "import"
155 pushContext start E.Import
156 spaces
157 name <- qualifiedCapVar
158 end <- getPosition
159 pos <- whitespace
160 oneOf
161 [ do checkFreshLine pos
162 let userImport = method start end name Nothing Exposing.closed
163 popContext ()
164 chompImports (userImport:imports)
165 , do checkSpace pos
166 oneOf
167 [ chompAs start name imports
168 , chompExposing start name Nothing imports
169 ]
170 ]
171 , return (reverse imports)
172 ]
175chompAs :: R.Position -> Text -> [Module.UserImport] -> Parser [Module.UserImport]
176chompAs start name imports =
177 do keyword "as"
178 spaces
179 alias <- capVar
180 end <- getPosition
181 pos <- whitespace
182 oneOf
183 [ do checkFreshLine pos
184 let userImport = method start end name (Just alias) (Exposing.Explicit [])
185 popContext ()
186 chompImports (userImport:imports)
187 , do checkSpace pos
188 chompExposing start name (Just alias) imports
189 ]
192chompExposing :: R.Position -> Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]
193chompExposing start name maybeAlias imports =
194 do keyword "exposing"
195 spaces
196 exposed <- exposing exposingEntry
197 end <- getPosition
198 freshLine
199 let userImport = method start end name maybeAlias exposed
200 popContext ()
201 chompImports (userImport:imports)
204method :: R.Position -> R.Position -> Text -> Maybe Text -> Exposing.Raw -> Module.UserImport
205method start end name maybeAlias exposed =
206 A.at start end ( name, Module.ImportMethod maybeAlias exposed )
210-- LISTING
213exposing :: Parser a -> Parser (Exposing.Exposing a)
214exposing parser =
215 hint E.Listing $
216 do leftParen
217 spaces
218 oneOf
219 [ do dot
220 dot
221 spaces
222 rightParen
223 return Exposing.Open
224 , do value <- addLocation parser
225 spaces
226 exposingHelp parser [value]
227 ]
230exposingHelp :: Parser a -> [A.Located a] -> Parser (Exposing.Exposing a)
231exposingHelp parser values =
232 oneOf
233 [ do comma
234 spaces
235 value <- addLocation parser
236 spaces
237 exposingHelp parser (value:values)
238 , do rightParen
239 return (Exposing.Explicit (reverse values))
240 ]
243exposingEntry :: Parser Exposing.Entry
244exposingEntry =
245 oneOf
246 [ Exposing.Lower <$> lowVar
247 , do leftParen
248 op <- infixOp
249 rightParen
250 return (Exposing.Lower op)
251 , do name <- capVar
252 spaces
253 Exposing.Upper name <$>
254 oneOf
255 [ Just <$> exposing capVar
256 , return Nothing
257 ]
258 ]
262-- FRESH LINES
265freshLine :: Parser ()
266freshLine =
267 checkFreshLine =<< whitespace