git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Parse/Module.hs
278 lines 6.2 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 symbol "/*"
32 freshLine
33 imports <- chompImports []
34 symbol "*/"
35 return imports
39-- HEADER DECL
42maybeHeaderDecl :: Parser (Maybe Module.HeaderDecl)
43maybeHeaderDecl =
44 oneOf
45 [ Just <$> headerDecl
46 , return Nothing
47 ]
50headerDecl :: Parser Module.HeaderDecl
51headerDecl =
52 do start <- getPosition
53 pushContext start E.Module
54 tag <- sourceTag
55 spaces
56 name <- qualifiedCapVar
57 spaces
58 settings <- effectSettings
59 hint E.Exposing $ keyword "exposing"
60 spaces
61 exports <- exposing exposingEntry
62 popContext ()
63 docs <- maybeDocComment
64 return (Module.HeaderDecl tag name exports settings docs)
68-- MODULE TAGS - module, effect module, port module
71sourceTag :: Parser Module.SourceTag
72sourceTag =
73 oneOf
74 [
75 do keyword "module"
76 return Module.Normal
77 ,
78 do start <- getPosition
79 keyword "port"
80 spaces
81 keyword "module"
82 end <- getPosition
83 return (Module.Port (R.Region start end))
84 ,
85 do start <- getPosition
86 keyword "effect"
87 spaces
88 keyword "module"
89 end <- getPosition
90 return (Module.Effect (R.Region start end))
91 ]
95-- EFFECTS - where { command = MyCmd }
98effectSettings :: Parser Module.SourceSettings
99effectSettings =
100 oneOf
101 [ do keyword "where"
102 spaces
103 start <- getPosition
104 leftCurly
105 spaces
106 entry <- setting
107 spaces
108 effectSettingsHelp start [entry]
109 , return Module.emptySettings
110 ]
113effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings
114effectSettingsHelp start entries =
115 oneOf
116 [ do comma
117 spaces
118 entry <- setting
119 spaces
120 effectSettingsHelp start (entry:entries)
121 , do rightCurly
122 end <- getPosition
123 spaces
124 return (A.at start end entries)
125 ]
128setting :: Parser (A.Located Text, A.Located Text)
129setting =
130 do name <- addLocation lowVar
131 spaces
132 equals
133 spaces
134 tipe <- addLocation capVar
135 return (name, tipe)
139-- DOC COMMENTS
142maybeDocComment :: Parser (A.Located (Maybe Text))
143maybeDocComment =
144 do oldEnd <- getPosition
145 freshLine
146 newStart <- getPosition
147 oneOf
148 [ do doc <- docComment
149 end <- getPosition
150 freshLine
151 return (A.at newStart end (Just doc))
152 , return (A.at oldEnd newStart Nothing)
153 ]
157-- IMPORTS
160chompImports :: [Module.UserImport] -> Parser [Module.UserImport]
161chompImports imports =
162 oneOf
163 [ do start <- getPosition
164 keyword "import"
165 pushContext start E.Import
166 spaces
167 name <- qualifiedCapVar
168 end <- getPosition
169 pos <- whitespace
170 oneOf
171 [ do checkFreshLine pos
172 let userImport = method start end name Nothing Exposing.closed
173 popContext ()
174 chompImports (userImport:imports)
175 , do checkSpace pos
176 oneOf
177 [ chompAs start name imports
178 , chompExposing start name Nothing imports
179 ]
180 ]
181 , return (reverse imports)
182 ]
185chompAs :: R.Position -> Text -> [Module.UserImport] -> Parser [Module.UserImport]
186chompAs start name imports =
187 do keyword "as"
188 spaces
189 alias <- capVar
190 end <- getPosition
191 pos <- whitespace
192 oneOf
193 [ do checkFreshLine pos
194 let userImport = method start end name (Just alias) (Exposing.Explicit [])
195 popContext ()
196 chompImports (userImport:imports)
197 , do checkSpace pos
198 chompExposing start name (Just alias) imports
199 ]
202chompExposing :: R.Position -> Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]
203chompExposing start name maybeAlias imports =
204 do keyword "exposing"
205 spaces
206 exposed <- exposing exposingEntry
207 end <- getPosition
208 freshLine
209 let userImport = method start end name maybeAlias exposed
210 popContext ()
211 chompImports (userImport:imports)
214method :: R.Position -> R.Position -> Text -> Maybe Text -> Exposing.Raw -> Module.UserImport
215method start end name maybeAlias exposed =
216 A.at start end ( name, Module.ImportMethod maybeAlias exposed )
220-- LISTING
223exposing :: Parser a -> Parser (Exposing.Exposing a)
224exposing parser =
225 hint E.Listing $
226 do leftParen
227 spaces
228 oneOf
229 [ do dot
230 dot
231 spaces
232 rightParen
233 return Exposing.Open
234 , do value <- addLocation parser
235 spaces
236 exposingHelp parser [value]
237 ]
240exposingHelp :: Parser a -> [A.Located a] -> Parser (Exposing.Exposing a)
241exposingHelp parser values =
242 oneOf
243 [ do comma
244 spaces
245 value <- addLocation parser
246 spaces
247 exposingHelp parser (value:values)
248 , do rightParen
249 return (Exposing.Explicit (reverse values))
250 ]
253exposingEntry :: Parser Exposing.Entry
254exposingEntry =
255 oneOf
256 [ Exposing.Lower <$> lowVar
257 , do leftParen
258 op <- infixOp
259 rightParen
260 return (Exposing.Lower op)
261 , do name <- capVar
262 spaces
263 Exposing.Upper name <$>
264 oneOf
265 [ Just <$> exposing capVar
266 , return Nothing
267 ]
268 ]
272-- FRESH LINES
275freshLine :: Parser ()
276freshLine =
277 checkFreshLine =<< whitespace