git.iko.soy/elk
on 7dd0bbd help sign in
elk/src/Parse/Module.hs
262 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.Module as Module
8import qualified AST.Variable as Var
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 start <- getPosition
22 freshLine E.ModuleDecl
23 end <- getPosition
24 oneOf
25 [ fullHeader end
26 , Module.defaultHeader start end <$> chompImports []
27 ]
31-- FULL HEADER
34fullHeader :: R.Position -> Parser (Module.Header [Module.UserImport])
35fullHeader start =
36 do pushContext start E.Module
37 tag <- sourceTag
38 spaces
39 name <- qualifiedCapVar
40 spaces
41 settings <- effectSettings
42 hint E.Exposing $ keyword "exposing"
43 spaces
44 exports <- listing (addLocation listingValue)
45 popContext ()
46 docs <- maybeDocComment
47 imports <- chompImports []
48 return (Module.Header tag name exports settings docs imports)
52-- MODULE TAGS - module, effect module, port module
55sourceTag :: Parser Module.SourceTag
56sourceTag =
57 oneOf
58 [
59 do keyword "module"
60 return Module.Normal
61 ,
62 do start <- getPosition
63 keyword "port"
64 spaces
65 keyword "module"
66 end <- getPosition
67 return (Module.Port (R.Region start end))
68 ,
69 do start <- getPosition
70 keyword "effect"
71 spaces
72 keyword "module"
73 end <- getPosition
74 return (Module.Effect (R.Region start end))
75 ]
79-- EFFECTS - where { command = MyCmd }
82effectSettings :: Parser Module.SourceSettings
83effectSettings =
84 oneOf
85 [ do keyword "where"
86 spaces
87 start <- getPosition
88 leftCurly
89 spaces
90 entry <- setting
91 spaces
92 effectSettingsHelp start [entry]
93 , return Module.emptySettings
94 ]
97effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings
98effectSettingsHelp start entries =
99 oneOf
100 [ do comma
101 spaces
102 entry <- setting
103 spaces
104 effectSettingsHelp start (entry:entries)
105 , do rightCurly
106 end <- getPosition
107 spaces
108 return (A.at start end entries)
109 ]
112setting :: Parser (A.Located Text, A.Located Text)
113setting =
114 do name <- addLocation lowVar
115 spaces
116 equals
117 spaces
118 tipe <- addLocation capVar
119 return (name, tipe)
123-- DOC COMMENTS
126maybeDocComment :: Parser (A.Located (Maybe Text))
127maybeDocComment =
128 do oldEnd <- getPosition
129 freshLine E.DocCommentDecl
130 newStart <- getPosition
131 oneOf
132 [ do doc <- docComment
133 end <- getPosition
134 freshLine E.ImportDecl
135 return (A.at newStart end (Just doc))
136 , return (A.at oldEnd newStart Nothing)
137 ]
141-- IMPORTS
144chompImports :: [Module.UserImport] -> Parser [Module.UserImport]
145chompImports imports =
146 oneOf
147 [ do start <- getPosition
148 keyword "import"
149 pushContext start E.Import
150 spaces
151 name <- qualifiedCapVar
152 end <- getPosition
153 pos <- whitespace
154 oneOf
155 [ do checkFreshLine E.ImportDecl pos
156 let userImport = method start end name Nothing Var.closedListing
157 popContext ()
158 chompImports (userImport:imports)
159 , do checkSpace pos
160 oneOf
161 [ chompAs start name imports
162 , chompExposing start name Nothing imports
163 ]
164 ]
165 , return (reverse imports)
166 ]
169chompAs :: R.Position -> Text -> [Module.UserImport] -> Parser [Module.UserImport]
170chompAs start name imports =
171 do keyword "as"
172 spaces
173 alias <- capVar
174 end <- getPosition
175 pos <- whitespace
176 oneOf
177 [ do checkFreshLine E.ImportDecl pos
178 let userImport = method start end name (Just alias) Var.closedListing
179 popContext ()
180 chompImports (userImport:imports)
181 , do checkSpace pos
182 chompExposing start name (Just alias) imports
183 ]
186chompExposing :: R.Position -> Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]
187chompExposing start name maybeAlias imports =
188 do keyword "exposing"
189 spaces
190 exposed <- listing listingValue
191 end <- getPosition
192 freshLine E.ImportDecl
193 let userImport = method start end name maybeAlias exposed
194 popContext ()
195 chompImports (userImport:imports)
198method :: R.Position -> R.Position -> Text -> Maybe Text -> Var.Listing Var.Value -> Module.UserImport
199method start end name maybeAlias exposed =
200 A.at start end ( name, Module.ImportMethod maybeAlias exposed )
204-- LISTING
207listing :: Parser a -> Parser (Var.Listing a)
208listing parser =
209 hint E.Listing $
210 do leftParen
211 spaces
212 oneOf
213 [ do dot
214 dot
215 spaces
216 rightParen
217 return (Var.Listing [] True)
218 , do value <- parser
219 spaces
220 listingHelp parser [value]
221 ]
224listingHelp :: Parser a -> [a] -> Parser (Var.Listing a)
225listingHelp parser values =
226 oneOf
227 [ do comma
228 spaces
229 value <- parser
230 spaces
231 listingHelp parser (value:values)
232 , do rightParen
233 return (Var.Listing (reverse values) False)
234 ]
237listingValue :: Parser Var.Value
238listingValue =
239 oneOf
240 [ Var.Value <$> lowVar
241 , do leftParen
242 op <- infixOp
243 rightParen
244 return (Var.Value op)
245 , do name <- capVar
246 spaces
247 oneOf
248 [ Var.Union name <$> listing capVar
249 , return (Var.Alias name)
250 ]
251 ]
255-- FRESH LINES
258freshLine :: E.NextDecl -> Parser ()
259freshLine nextDecl =
260 do pos <- whitespace
261 checkFreshLine nextDecl pos