git.iko.soy/elk
on master help sign in
Convert module parser to new parsing system
ff0b05bEvan Czaplicki
src/Parse/Module.hs+224−150
compare with master
unifiedsplit
@@ -1,183 +1,257 @@
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2+{-# LANGUAGE OverloadedStrings #-}
2−module Parse.Module (moduleDecl, header, getModuleName) where
3+module Parse.Module where
3
4
4−import Text.Parsec hiding (newline, parse, spaces)
5+import Control.Monad (guard)
6+import Data.Text (Text)
5
7
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− )
12import qualified AST.Module as Module
8import qualified AST.Module as Module
13−import qualified AST.Module.Name as ModuleName
14import qualified AST.Variable as Var
9import qualified AST.Variable as Var
10+import Parse.Helpers
15import qualified Reporting.Annotation as A
11import qualified Reporting.Annotation as A
16import qualified Reporting.Region as R
12import qualified Reporting.Region as R
17
13
18
14
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
30
15
31− Left _ ->
16+-- MODULE HEADER
32− Nothing
33
17
34
18
35−header :: IParser (Module.Header [Module.UserImport])
19+header :: Parser (Module.Header [Module.UserImport])
36header =
20header =
37− do optional freshLine
21+ do space <- whitespace
38− (ModuleDecl tag names exports settings) <-
22+ guard (space == Freshline || space == None)
39− option
23+ oneOf
40− (ModuleDecl Module.Normal ["Main"] Var.openListing Module.emptySettings)
24+ [ fullHeader
41− (moduleDecl `followedBy` freshLine)
25+ , Module.defaultHeader <$> chompImports []
26+ ]
42
27
43− docs <-
44− choice
45− [ addLocation (Just <$> docComment) `followedBy` freshLine
46− , addLocation (return Nothing)
47− ]
48
28
49− imports' <- imports
50
29
51− return (Module.Header tag names exports settings docs imports')
30+-- FULL HEADER
52
31
53
32
54−data ModuleDecl =
33+fullHeader :: Parser (Module.Header [Module.UserImport])
55− ModuleDecl
34+fullHeader =
56− { _tag :: Module.SourceTag
35+ do tag <- sourceTag
57− , _name :: [String]
36+ spaces
58− , _exports :: Var.Listing (A.Located Var.Value)
37+ name <- qualifiedCapVar -- TODO <?> "the name of this module"
59− , _settings :: Module.SourceSettings
38+ spaces
60− }
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)
61
47
62
48
63−moduleDecl :: IParser ModuleDecl
64−moduleDecl =
65− expecting "a module declaration" $
66− do
67− tag <- parseTag
68− whitespace
69
49
70− names <- dotSep1 capVar <?> "the name of this module"
50+-- MODULE TAGS - module, effect module, port module
71− whitespace
72
51
73− settings <-
74− case tag of
75− Module.Effect _ ->
76− parseSetting <* whitespace
77
52
78− _ ->
53+sourceTag :: Parser Module.SourceTag
79− return Module.emptySettings
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+ ]
80
74
81− reserved "exposing" <?> "something like `exposing (..)` which replaced `where` in 0.17"
82− whitespace
83
75
84− exports <- listing (addLocation value)
85
76
86− return (ModuleDecl tag names exports settings)
77+-- EFFECTS - where { command = MyCmd }
87
78
88
79
89−parseTag :: IParser Module.SourceTag
80+effectSettings :: Parser Module.SourceSettings
90−parseTag =
81+effectSettings =
91− choice
82+ oneOf
92− [
83+ [ do keyword "where"
93− do try (reserved "module")
84+ spaces
85+ start <- getPosition
86+ leftCurly
87+ spaces
88+ entry <- setting
89+ spaces
90+ effectSettingsHelp start [entry]
94− return Module.Normal
91+ , return Module.emptySettings
95− ,
92+ ]
96− do start <- getMyPosition
93+
97− try (reserved "effect")
94+
98− whitespace
95+effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings
99− reserved "module"
96+effectSettingsHelp start entries =
100− end <- getMyPosition
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
101− return (Module.Effect (R.Region start end))
106+ return (A.at start end entries)
102− ,
107+ ]
103− do start <- getMyPosition
108+
104− try (reserved "port")
109+
105− whitespace
110+setting :: Parser (A.Located Text, A.Located Text)
106− reserved "module"
111+setting =
107− end <- getMyPosition
112+ do name <- addLocation lowVar
108− return (Module.Port (R.Region start end))
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
109 ]
131 ]
110
132
111
133
112−parseSetting :: IParser Module.SourceSettings
134+
113−parseSetting =
135+-- IMPORTS
114− do try (reserved "where")
136+
115− whitespace
137+
116− addLocation $ brackets $ commaSep $
138+chompImports :: [Module.UserImport] -> Parser [Module.UserImport]
117− do name <- addLocation lowVar
139+chompImports imports =
118− padded equals
140+ oneOf
119− typeName <- addLocation capVar
141+ [ do start <- getPosition
120− return (name, typeName)
142+ keyword "import"
121−
143+ spaces
122−
144+ name <- qualifiedCapVar
123−imports :: IParser [Module.UserImport]
145+ end <- getPosition
124−imports =
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
125− many (import' `followedBy` freshLine)
183+ freshLine
126−
184+ let userImport = method start end name maybeAlias exposed
127−
185+ chompImports (userImport:imports)
128−import' :: IParser Module.UserImport
186+
129−import' =
187+
130− expecting "an import" $
188+method :: R.Position -> R.Position -> Text -> Maybe Text -> Var.Listing Var.Value -> Module.UserImport
131− addLocation $
189+method start end name maybeAlias exposed =
132− do try (reserved "import")
190+ A.at start end ( name, Module.ImportMethod maybeAlias exposed )
133− whitespace
191+
134− names <- dotSep1 capVar
192+
135− (,) names <$> method (ModuleName.toString names)
193+
136− where
194+-- LISTING
137− method :: String -> IParser Module.ImportMethod
195+
138− method defaultAlias =
196+
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)
197+listing :: Parser a -> Parser (Var.Listing a)
157−listing item =
198+listing parser =
158 expecting "a listing of values and types to expose, like (..)" $
199 expecting "a listing of values and types to expose, like (..)" $
159− do try (whitespace >> char '(')
200+ do leftParen
160− whitespace
201+ spaces
161− actualListing <-
202+ oneOf
162− choice
203+ [ do dot
163− [ const Var.openListing <$> string ".."
204+ dot
164− , Var.Listing <$> commaSep1 item <*> return False
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)
165 ]
242 ]
166− whitespace
243+ ]
167− char ')'
244+
168− return actualListing
245+
169−
246+
170−
247+-- FRESH LINES
171−value :: IParser Var.Value
248+
172−value =
249+
173− val <|> tipe <?> "a value or type to expose"
250+freshLine :: Parser ()
174− where
251+freshLine =
175− val =
252+ do space <- whitespace
176− Var.Value <$> (lowVar <|> parens infixOp)
253+ if space == Freshline
177−
254+ then return ()
178− tipe =
255+ else failure (error "TODO freshLine")
179− do name <- capVar
256+
180− maybeCtors <- optionMaybe (listing capVar)
257+
181− case maybeCtors of
182− Nothing -> return (Var.Alias name)
183− Just ctors -> return (Var.Union name ctors)