git.iko.soy/elk
on 26ec347 help sign in
elk/src/Parse/Module.hs
257 lines 6.0 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module where
5import Control.Monad (guard)
6import Data.Text (Text)
8import qualified AST.Module as Module
9import qualified AST.Variable as Var
10import Parse.Helpers
11import qualified Reporting.Annotation as A
12import qualified Reporting.Region as R
16-- MODULE HEADER
19header :: Parser (Module.Header [Module.UserImport])
20header =
21 do space <- whitespace
22 guard (space == Freshline || space == None)
23 oneOf
24 [ fullHeader
25 , Module.defaultHeader <$> chompImports []
26 ]
30-- FULL HEADER
33fullHeader :: Parser (Module.Header [Module.UserImport])
34fullHeader =
35 do tag <- sourceTag
36 spaces
37 name <- qualifiedCapVar -- TODO <?> "the name of this module"
38 spaces
39 settings <- effectSettings
40 keyword "exposing" -- TODO <?> "something like `exposing (..)` which replaced `where` in 0.17"
41 spaces
42 exports <- listing (addLocation listingValue)
43 freshLine
44 docs <- maybeDocComment
45 imports <- chompImports []
46 return (Module.Header tag name exports settings docs imports)
50-- MODULE TAGS - module, effect module, port module
53sourceTag :: Parser Module.SourceTag
54sourceTag =
55 oneOf
56 [
57 do keyword "module"
58 return Module.Normal
59 ,
60 do start <- getPosition
61 keyword "port"
62 spaces
63 keyword "module"
64 end <- getPosition
65 return (Module.Port (R.Region start end))
66 ,
67 do start <- getPosition
68 keyword "effect"
69 spaces
70 keyword "module"
71 end <- getPosition
72 return (Module.Effect (R.Region start end))
73 ]
77-- EFFECTS - where { command = MyCmd }
80effectSettings :: Parser Module.SourceSettings
81effectSettings =
82 oneOf
83 [ do keyword "where"
84 spaces
85 start <- getPosition
86 leftCurly
87 spaces
88 entry <- setting
89 spaces
90 effectSettingsHelp start [entry]
91 , return Module.emptySettings
92 ]
95effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings
96effectSettingsHelp start entries =
97 oneOf
98 [ do comma
99 spaces
100 entry <- setting
101 spaces
102 effectSettingsHelp start (entry:entries)
103 , do rightCurly
104 end <- getPosition
105 spaces
106 return (A.at start end entries)
107 ]
110setting :: Parser (A.Located Text, A.Located Text)
111setting =
112 do name <- addLocation lowVar
113 spaces
114 equals
115 spaces
116 tipe <- addLocation capVar
117 return (name, tipe)
121-- DOC COMMENTS
124maybeDocComment :: Parser (Maybe (A.Located Text))
125maybeDocComment =
126 oneOf
127 [ do doc <- addLocation docComment
128 freshLine
129 return (Just doc)
130 , return Nothing
131 ]
135-- IMPORTS
138chompImports :: [Module.UserImport] -> Parser [Module.UserImport]
139chompImports imports =
140 oneOf
141 [ do start <- getPosition
142 keyword "import"
143 spaces
144 name <- qualifiedCapVar
145 end <- getPosition
146 space <- whitespace
147 oneOf
148 [ do guard (space == Freshline)
149 let userImport = method start end name Nothing Var.closedListing
150 chompImports (userImport:imports)
151 , do checkSpaces space
152 oneOf
153 [ chompAs start name imports
154 , chompExposing start name Nothing imports
155 ]
156 ]
157 , return (reverse imports)
158 ]
161chompAs :: R.Position -> Text -> [Module.UserImport] -> Parser [Module.UserImport]
162chompAs start name imports =
163 do keyword "as"
164 spaces
165 alias <- capVar
166 end <- getPosition
167 space <- whitespace
168 oneOf
169 [ do guard (space == Freshline)
170 let userImport = method start end name (Just alias) Var.closedListing
171 chompImports (userImport:imports)
172 , do checkSpaces space
173 chompExposing start name (Just alias) imports
174 ]
177chompExposing :: R.Position -> Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]
178chompExposing start name maybeAlias imports =
179 do keyword "exposing"
180 spaces
181 exposed <- listing listingValue
182 end <- getPosition
183 freshLine
184 let userImport = method start end name maybeAlias exposed
185 chompImports (userImport:imports)
188method :: R.Position -> R.Position -> Text -> Maybe Text -> Var.Listing Var.Value -> Module.UserImport
189method start end name maybeAlias exposed =
190 A.at start end ( name, Module.ImportMethod maybeAlias exposed )
194-- LISTING
197listing :: Parser a -> Parser (Var.Listing a)
198listing parser =
199 expecting "a listing of values and types to expose, like (..)" $
200 do leftParen
201 spaces
202 oneOf
203 [ do dot
204 dot
205 spaces
206 rightParen
207 return (Var.Listing [] True)
208 , do value <- parser
209 spaces
210 listingHelp parser [value]
211 ]
214listingHelp :: Parser a -> [a] -> Parser (Var.Listing a)
215listingHelp parser values =
216 oneOf
217 [ do comma
218 spaces
219 value <- parser
220 spaces
221 listingHelp parser (value:values)
222 , do rightParen
223 return (Var.Listing (reverse values) False)
224 ]
227listingValue :: Parser Var.Value
228listingValue =
229 oneOf
230 [ Var.Value <$> lowVar
231 , do leftParen
232 spaces
233 op <- infixOp
234 spaces
235 rightParen
236 return (Var.Value op)
237 , do name <- capVar
238 spaces
239 oneOf
240 [ Var.Union name <$> listing capVar
241 , return (Var.Alias name)
242 ]
243 ]
247-- FRESH LINES
250freshLine :: Parser ()
251freshLine =
252 do space <- whitespace
253 if space == Freshline
254 then return ()
255 else failure (error "TODO freshLine")