git.iko.soy/elk
on fe7bbbd help sign in
elk/src/Parse/Module.hs
265 lines 6.1 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module where
5import Data.Text (Text)
7import qualified AST.Exposing as Exposing
8import qualified AST.Module as Module
9import Parse.Helpers
10import qualified Reporting.Annotation as A
11import qualified Reporting.Error.Syntax as E
12import qualified Reporting.Region as R
16-- MODULE HEADER
19header :: Parser (Module.Header [Module.UserImport])
20header =
21 do freshLine
22 Module.Header <$> maybeHeaderDecl <*> chompImports []
26-- HEADER DECL
29maybeHeaderDecl :: Parser (Maybe Module.HeaderDecl)
30maybeHeaderDecl =
31 oneOf
32 [ Just <$> headerDecl
33 , return Nothing
34 ]
37headerDecl :: Parser Module.HeaderDecl
38headerDecl =
39 do start <- getPosition
40 pushContext start E.Module
41 tag <- sourceTag
42 spaces
43 name <- qualifiedCapVar
44 spaces
45 settings <- effectSettings
46 hint E.Exposing $ keyword "exposing"
47 spaces
48 exports <- exposing exposingEntry
49 popContext ()
50 docs <- maybeDocComment
51 return (Module.HeaderDecl tag name exports settings docs)
55-- MODULE TAGS - module, effect module, port module
58sourceTag :: Parser Module.SourceTag
59sourceTag =
60 oneOf
61 [
62 do keyword "module"
63 return Module.Normal
64 ,
65 do start <- getPosition
66 keyword "port"
67 spaces
68 keyword "module"
69 end <- getPosition
70 return (Module.Port (R.Region start end))
71 ,
72 do start <- getPosition
73 keyword "effect"
74 spaces
75 keyword "module"
76 end <- getPosition
77 return (Module.Effect (R.Region start end))
78 ]
82-- EFFECTS - where { command = MyCmd }
85effectSettings :: Parser Module.SourceSettings
86effectSettings =
87 oneOf
88 [ do keyword "where"
89 spaces
90 start <- getPosition
91 leftCurly
92 spaces
93 entry <- setting
94 spaces
95 effectSettingsHelp start [entry]
96 , return Module.emptySettings
97 ]
100effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings
101effectSettingsHelp start entries =
102 oneOf
103 [ do comma
104 spaces
105 entry <- setting
106 spaces
107 effectSettingsHelp start (entry:entries)
108 , do rightCurly
109 end <- getPosition
110 spaces
111 return (A.at start end entries)
112 ]
115setting :: Parser (A.Located Text, A.Located Text)
116setting =
117 do name <- addLocation lowVar
118 spaces
119 equals
120 spaces
121 tipe <- addLocation capVar
122 return (name, tipe)
126-- DOC COMMENTS
129maybeDocComment :: Parser (A.Located (Maybe Text))
130maybeDocComment =
131 do oldEnd <- getPosition
132 freshLine
133 newStart <- getPosition
134 oneOf
135 [ do doc <- docComment
136 end <- getPosition
137 freshLine
138 return (A.at newStart end (Just doc))
139 , return (A.at oldEnd newStart Nothing)
140 ]
144-- IMPORTS
147chompImports :: [Module.UserImport] -> Parser [Module.UserImport]
148chompImports imports =
149 oneOf
150 [ do start <- getPosition
151 keyword "import"
152 pushContext start E.Import
153 spaces
154 name <- qualifiedCapVar
155 end <- getPosition
156 pos <- whitespace
157 oneOf
158 [ do checkFreshLine pos
159 let userImport = method start end name Nothing Exposing.closed
160 popContext ()
161 chompImports (userImport:imports)
162 , do checkSpace pos
163 oneOf
164 [ chompAs start name imports
165 , chompExposing start name Nothing imports
166 ]
167 ]
168 , return (reverse imports)
169 ]
172chompAs :: R.Position -> Text -> [Module.UserImport] -> Parser [Module.UserImport]
173chompAs start name imports =
174 do keyword "as"
175 spaces
176 alias <- capVar
177 end <- getPosition
178 pos <- whitespace
179 oneOf
180 [ do checkFreshLine pos
181 let userImport = method start end name (Just alias) (Exposing.Explicit [])
182 popContext ()
183 chompImports (userImport:imports)
184 , do checkSpace pos
185 chompExposing start name (Just alias) imports
186 ]
189chompExposing :: R.Position -> Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]
190chompExposing start name maybeAlias imports =
191 do keyword "exposing"
192 spaces
193 exposed <- exposing exposingEntry
194 end <- getPosition
195 freshLine
196 let userImport = method start end name maybeAlias exposed
197 popContext ()
198 chompImports (userImport:imports)
201method :: R.Position -> R.Position -> Text -> Maybe Text -> Exposing.Raw -> Module.UserImport
202method start end name maybeAlias exposed =
203 A.at start end ( name, Module.ImportMethod maybeAlias exposed )
207-- LISTING
210exposing :: Parser a -> Parser (Exposing.Exposing a)
211exposing parser =
212 hint E.Listing $
213 do leftParen
214 spaces
215 oneOf
216 [ do dot
217 dot
218 spaces
219 rightParen
220 return Exposing.Open
221 , do value <- addLocation parser
222 spaces
223 exposingHelp parser [value]
224 ]
227exposingHelp :: Parser a -> [A.Located a] -> Parser (Exposing.Exposing a)
228exposingHelp parser values =
229 oneOf
230 [ do comma
231 spaces
232 value <- addLocation parser
233 spaces
234 exposingHelp parser (value:values)
235 , do rightParen
236 return (Exposing.Explicit (reverse values))
237 ]
240exposingEntry :: Parser Exposing.Entry
241exposingEntry =
242 oneOf
243 [ Exposing.Lower <$> lowVar
244 , do leftParen
245 op <- infixOp
246 rightParen
247 return (Exposing.Lower op)
248 , do name <- capVar
249 spaces
250 Exposing.Upper name <$>
251 oneOf
252 [ Just <$> exposing capVar
253 , return Nothing
254 ]
255 ]
259-- FRESH LINES
262freshLine :: Parser ()
263freshLine =
264 checkFreshLine =<< whitespace