@@ -1,183 +1,257 @@
11{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2−module Parse.Module (moduleDecl, header, getModuleName) where
2+{-# LANGUAGE OverloadedStrings #-}
3+module Parse.Module where
34
4−import Text.Parsec hiding (newline, parse, spaces)
5+import Control.Monad (guard)
6+import Data.Text (Text)
57
6−import Parse.Binop (infixOp)
7−import Parse.Helpers
8− ( IParser, addLocation, brackets, capVar, commaSep, commaSep1
9− , docComment, dotSep1, equals, expecting, followedBy, freshLine
10− , getMyPosition, lowVar, padded, parens, parse, reserved, whitespace
11− )
128import qualified AST.Module as Module
13−import qualified AST.Module.Name as ModuleName
149import qualified AST.Variable as Var
10+import Parse.Helpers
1511import qualified Reporting.Annotation as A
1612import qualified Reporting.Region as R
1713
1814
19−getModuleName :: String -> Maybe String
20−getModuleName source =
21− let
22− minimalParser =
23− do optional freshLine
24− (ModuleDecl _ names _ _) <- moduleDecl
25− return (ModuleName.toString names)
26− in
27− case parse minimalParser source of
28− Right name ->
29− Just name
3015
31− Left _ ->
32− Nothing
16+-- MODULE HEADER
3317
3418
35−header :: IParser (Module.Header [Module.UserImport])
19+header :: Parser (Module.Header [Module.UserImport])
3620header =
37− do optional freshLine
38− (ModuleDecl tag names exports settings) <-
39− option
40− (ModuleDecl Module.Normal ["Main"] Var.openListing Module.emptySettings)
41− (moduleDecl `followedBy` freshLine)
21+ do space <- whitespace
22+ guard (space == Freshline || space == None)
23+ oneOf
24+ [ fullHeader
25+ , Module.defaultHeader <$> chompImports []
26+ ]
4227
43− docs <-
44− choice
45− [ addLocation (Just <$> docComment) `followedBy` freshLine
46− , addLocation (return Nothing)
47− ]
4828
49− imports' <- imports
5029
51− return (Module.Header tag names exports settings docs imports')
30+-- FULL HEADER
5231
5332
54−data ModuleDecl =
55− ModuleDecl
56− { _tag :: Module.SourceTag
57− , _name :: [String]
58− , _exports :: Var.Listing (A.Located Var.Value)
59− , _settings :: Module.SourceSettings
60− }
33+fullHeader :: Parser (Module.Header [Module.UserImport])
34+fullHeader =
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)
6147
6248
63−moduleDecl :: IParser ModuleDecl
64−moduleDecl =
65− expecting "a module declaration" $
66− do
67− tag <- parseTag
68− whitespace
6949
70− names <- dotSep1 capVar <?> "the name of this module"
71− whitespace
50+-- MODULE TAGS - module, effect module, port module
7251
73− settings <-
74− case tag of
75− Module.Effect _ ->
76− parseSetting <* whitespace
7752
78− _ ->
79− return Module.emptySettings
53+sourceTag :: Parser Module.SourceTag
54+sourceTag =
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+ ]
8074
81− reserved "exposing" <?> "something like `exposing (..)` which replaced `where` in 0.17"
82− whitespace
8375
84− exports <- listing (addLocation value)
8576
86− return (ModuleDecl tag names exports settings)
77+-- EFFECTS - where { command = MyCmd }
8778
8879
89−parseTag :: IParser Module.SourceTag
90−parseTag =
91− choice
92− [
93− do try (reserved "module")
94− return Module.Normal
95− ,
96− do start <- getMyPosition
97− try (reserved "effect")
98− whitespace
99− reserved "module"
100− end <- getMyPosition
101− return (Module.Effect (R.Region start end))
102− ,
103− do start <- getMyPosition
104− try (reserved "port")
105− whitespace
106− reserved "module"
107− end <- getMyPosition
108− return (Module.Port (R.Region start end))
80+effectSettings :: Parser Module.SourceSettings
81+effectSettings =
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+ ]
93+
94+
95+effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings
96+effectSettingsHelp 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+ ]
108+
109+
110+setting :: Parser (A.Located Text, A.Located Text)
111+setting =
112+ do name <- addLocation lowVar
113+ spaces
114+ equals
115+ spaces
116+ tipe <- addLocation capVar
117+ return (name, tipe)
118+
119+
120+
121+-- DOC COMMENTS
122+
123+
124+maybeDocComment :: Parser (Maybe (A.Located Text))
125+maybeDocComment =
126+ oneOf
127+ [ do doc <- addLocation docComment
128+ freshLine
129+ return (Just doc)
130+ , return Nothing
109131 ]
110132
111133
112−parseSetting :: IParser Module.SourceSettings
113−parseSetting =
114− do try (reserved "where")
115− whitespace
116− addLocation $ brackets $ commaSep $
117− do name <- addLocation lowVar
118− padded equals
119− typeName <- addLocation capVar
120− return (name, typeName)
121−
122−
123−imports :: IParser [Module.UserImport]
124−imports =
125− many (import' `followedBy` freshLine)
126−
127−
128−import' :: IParser Module.UserImport
129−import' =
130− expecting "an import" $
131− addLocation $
132− do try (reserved "import")
133− whitespace
134− names <- dotSep1 capVar
135− (,) names <$> method (ModuleName.toString names)
136− where
137− method :: String -> IParser Module.ImportMethod
138− method defaultAlias =
139− Module.ImportMethod
140− <$> option (Just defaultAlias) (Just <$> as' defaultAlias)
141− <*> option Var.closedListing exposing
142−
143− as' :: String -> IParser String
144− as' moduleName =
145− do try (whitespace >> reserved "as")
146− whitespace
147− capVar <?> ("an alias for module `" ++ moduleName ++ "`")
148−
149− exposing :: IParser (Var.Listing Var.Value)
150− exposing =
151− do try (whitespace >> reserved "exposing")
152− whitespace
153− listing value
154−
155−
156−listing :: IParser a -> IParser (Var.Listing a)
157−listing item =
134+
135+-- IMPORTS
136+
137+
138+chompImports :: [Module.UserImport] -> Parser [Module.UserImport]
139+chompImports 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+ ]
159+
160+
161+chompAs :: R.Position -> Text -> [Module.UserImport] -> Parser [Module.UserImport]
162+chompAs 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+ ]
175+
176+
177+chompExposing :: R.Position -> Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]
178+chompExposing 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)
186+
187+
188+method :: R.Position -> R.Position -> Text -> Maybe Text -> Var.Listing Var.Value -> Module.UserImport
189+method start end name maybeAlias exposed =
190+ A.at start end ( name, Module.ImportMethod maybeAlias exposed )
191+
192+
193+
194+-- LISTING
195+
196+
197+listing :: Parser a -> Parser (Var.Listing a)
198+listing parser =
158199 expecting "a listing of values and types to expose, like (..)" $
159− do try (whitespace >> char '(')
160− whitespace
161− actualListing <-
162− choice
163− [ const Var.openListing <$> string ".."
164− , Var.Listing <$> commaSep1 item <*> return False
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+ ]
212+
213+
214+listingHelp :: Parser a -> [a] -> Parser (Var.Listing a)
215+listingHelp 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+ ]
225+
226+
227+listingValue :: Parser Var.Value
228+listingValue =
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)
165242 ]
166− whitespace
167− char ')'
168− return actualListing
169−
170−
171−value :: IParser Var.Value
172−value =
173− val <|> tipe <?> "a value or type to expose"
174− where
175− val =
176− Var.Value <$> (lowVar <|> parens infixOp)
177−
178− tipe =
179− do name <- capVar
180− maybeCtors <- optionMaybe (listing capVar)
181− case maybeCtors of
182− Nothing -> return (Var.Alias name)
183− Just ctors -> return (Var.Union name ctors)
243+ ]
244+
245+
246+
247+-- FRESH LINES
248+
249+
250+freshLine :: Parser ()
251+freshLine =
252+ do space <- whitespace
253+ if space == Freshline
254+ then return ()
255+ else failure (error "TODO freshLine")
256+
257+