git.iko.soy/elk
on b09bb00 help sign in
elk/src/Parse/Module.hs
252 lines 5.8 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.Region as R
15-- MODULE HEADER
18header :: Parser (Module.Header [Module.UserImport])
19header =
20 do freshLine
21 oneOf
22 [ fullHeader
23 , Module.defaultHeader <$> chompImports []
24 ]
28-- FULL HEADER
31fullHeader :: Parser (Module.Header [Module.UserImport])
32fullHeader =
33 do tag <- sourceTag
34 spaces
35 name <- qualifiedCapVar -- TODO <?> "the name of this module"
36 spaces
37 settings <- effectSettings
38 keyword "exposing" -- TODO <?> "something like `exposing (..)` which replaced `where` in 0.17"
39 spaces
40 exports <- listing (addLocation listingValue)
41 freshLine
42 docs <- maybeDocComment
43 imports <- chompImports []
44 return (Module.Header tag name exports settings docs imports)
48-- MODULE TAGS - module, effect module, port module
51sourceTag :: Parser Module.SourceTag
52sourceTag =
53 oneOf
54 [
55 do keyword "module"
56 return Module.Normal
57 ,
58 do start <- getPosition
59 keyword "port"
60 spaces
61 keyword "module"
62 end <- getPosition
63 return (Module.Port (R.Region start end))
64 ,
65 do start <- getPosition
66 keyword "effect"
67 spaces
68 keyword "module"
69 end <- getPosition
70 return (Module.Effect (R.Region start end))
71 ]
75-- EFFECTS - where { command = MyCmd }
78effectSettings :: Parser Module.SourceSettings
79effectSettings =
80 oneOf
81 [ do keyword "where"
82 spaces
83 start <- getPosition
84 leftCurly
85 spaces
86 entry <- setting
87 spaces
88 effectSettingsHelp start [entry]
89 , return Module.emptySettings
90 ]
93effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings
94effectSettingsHelp start entries =
95 oneOf
96 [ do comma
97 spaces
98 entry <- setting
99 spaces
100 effectSettingsHelp start (entry:entries)
101 , do rightCurly
102 end <- getPosition
103 spaces
104 return (A.at start end entries)
105 ]
108setting :: Parser (A.Located Text, A.Located Text)
109setting =
110 do name <- addLocation lowVar
111 spaces
112 equals
113 spaces
114 tipe <- addLocation capVar
115 return (name, tipe)
119-- DOC COMMENTS
122maybeDocComment :: Parser (Maybe (A.Located Text))
123maybeDocComment =
124 oneOf
125 [ do doc <- addLocation docComment
126 freshLine
127 return (Just doc)
128 , return Nothing
129 ]
133-- IMPORTS
136chompImports :: [Module.UserImport] -> Parser [Module.UserImport]
137chompImports imports =
138 oneOf
139 [ do start <- getPosition
140 keyword "import"
141 spaces
142 name <- qualifiedCapVar
143 end <- getPosition
144 pos <- whitespace
145 oneOf
146 [ do checkFreshline pos
147 let userImport = method start end name Nothing Var.closedListing
148 chompImports (userImport:imports)
149 , do checkSpace pos
150 oneOf
151 [ chompAs start name imports
152 , chompExposing start name Nothing imports
153 ]
154 ]
155 , return (reverse imports)
156 ]
159chompAs :: R.Position -> Text -> [Module.UserImport] -> Parser [Module.UserImport]
160chompAs start name imports =
161 do keyword "as"
162 spaces
163 alias <- capVar
164 end <- getPosition
165 pos <- whitespace
166 oneOf
167 [ do checkFreshline pos
168 let userImport = method start end name (Just alias) Var.closedListing
169 chompImports (userImport:imports)
170 , do checkSpace pos
171 chompExposing start name (Just alias) imports
172 ]
175chompExposing :: R.Position -> Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]
176chompExposing start name maybeAlias imports =
177 do keyword "exposing"
178 spaces
179 exposed <- listing listingValue
180 end <- getPosition
181 freshLine
182 let userImport = method start end name maybeAlias exposed
183 chompImports (userImport:imports)
186method :: R.Position -> R.Position -> Text -> Maybe Text -> Var.Listing Var.Value -> Module.UserImport
187method start end name maybeAlias exposed =
188 A.at start end ( name, Module.ImportMethod maybeAlias exposed )
192-- LISTING
195listing :: Parser a -> Parser (Var.Listing a)
196listing parser =
197 expecting "a listing of values and types to expose, like (..)" $
198 do leftParen
199 spaces
200 oneOf
201 [ do dot
202 dot
203 spaces
204 rightParen
205 return (Var.Listing [] True)
206 , do value <- parser
207 spaces
208 listingHelp parser [value]
209 ]
212listingHelp :: Parser a -> [a] -> Parser (Var.Listing a)
213listingHelp parser values =
214 oneOf
215 [ do comma
216 spaces
217 value <- parser
218 spaces
219 listingHelp parser (value:values)
220 , do rightParen
221 return (Var.Listing (reverse values) False)
222 ]
225listingValue :: Parser Var.Value
226listingValue =
227 oneOf
228 [ Var.Value <$> lowVar
229 , do leftParen
230 spaces
231 op <- infixOp
232 spaces
233 rightParen
234 return (Var.Value op)
235 , do name <- capVar
236 spaces
237 oneOf
238 [ Var.Union name <$> listing capVar
239 , return (Var.Alias name)
240 ]
241 ]
245-- FRESH LINES
248freshLine :: Parser ()
249freshLine =
250 do pos <- whitespace
251 checkFreshline pos