git.iko.soy/elk
on fcf5cef help sign in
elk/src/Parse/Module.hs
183 lines 4.8 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2module Parse.Module (moduleDecl, header, getModuleName) where
4import Text.Parsec hiding (newline, parse, spaces)
6import Parse.Binop (infixOp)
7import 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
13import qualified AST.Module.Name as ModuleName
14import qualified AST.Variable as Var
15import qualified Reporting.Annotation as A
16import qualified Reporting.Region as R
19getModuleName :: String -> Maybe String
20getModuleName 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
31 Left _ ->
32 Nothing
35header :: IParser (Module.Header [Module.UserImport])
36header =
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)
43 docs <-
44 choice
45 [ addLocation (Just <$> docComment) `followedBy` freshLine
46 , addLocation (return Nothing)
47 ]
49 imports' <- imports
51 return (Module.Header tag names exports settings docs imports')
54data ModuleDecl =
55 ModuleDecl
56 { _tag :: Module.SourceTag
57 , _name :: [String]
58 , _exports :: Var.Listing (A.Located Var.Value)
59 , _settings :: Module.SourceSettings
60 }
63moduleDecl :: IParser ModuleDecl
64moduleDecl =
65 expecting "a module declaration" $
66 do
67 tag <- parseTag
68 whitespace
70 names <- dotSep1 capVar <?> "the name of this module"
71 whitespace
73 settings <-
74 case tag of
75 Module.Effect _ ->
76 parseSetting <* whitespace
78 _ ->
79 return Module.emptySettings
81 reserved "exposing" <?> "something like `exposing (..)` which replaced `where` in 0.17"
82 whitespace
84 exports <- listing (addLocation value)
86 return (ModuleDecl tag names exports settings)
89parseTag :: IParser Module.SourceTag
90parseTag =
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))
109 ]
112parseSetting :: IParser Module.SourceSettings
113parseSetting =
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)
123imports :: IParser [Module.UserImport]
124imports =
125 many (import' `followedBy` freshLine)
128import' :: IParser Module.UserImport
129import' =
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
143 as' :: String -> IParser String
144 as' moduleName =
145 do try (whitespace >> reserved "as")
146 whitespace
147 capVar <?> ("an alias for module `" ++ moduleName ++ "`")
149 exposing :: IParser (Var.Listing Var.Value)
150 exposing =
151 do try (whitespace >> reserved "exposing")
152 whitespace
153 listing value
156listing :: IParser a -> IParser (Var.Listing a)
157listing item =
158 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
165 ]
166 whitespace
167 char ')'
168 return actualListing
171value :: IParser Var.Value
172value =
173 val <|> tipe <?> "a value or type to expose"
174 where
175 val =
176 Var.Value <$> (lowVar <|> parens infixOp)
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)