git.iko.soy/elk
on fc149d7 help sign in
elk/src/Parse/Module.hs
180 lines 4.6 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2module Parse.Module (moduleDecl, header, getModuleName) where
4import Text.Parsec hiding (newline, spaces)
6import Parse.Helpers
7import qualified AST.Module as Module
8import qualified AST.Module.Name as ModuleName
9import qualified AST.Variable as Var
10import qualified Reporting.Annotation as A
11import qualified Reporting.Region as R
14getModuleName :: String -> Maybe String
15getModuleName source =
16 let
17 minimalParser =
18 do optional freshLine
19 (ModuleDecl _ names _ _) <- moduleDecl
20 return (ModuleName.toString names)
21 in
22 case iParse minimalParser source of
23 Right name ->
24 Just name
26 Left _ ->
27 Nothing
30header :: IParser (Module.Header [Module.UserImport])
31header =
32 do optional freshLine
33 (ModuleDecl tag names exports settings) <-
34 option
35 (ModuleDecl Module.Normal ["Main"] Var.openListing Module.emptySettings)
36 (moduleDecl `followedBy` freshLine)
38 docs <-
39 choice
40 [ addLocation (Just <$> docComment) `followedBy` freshLine
41 , addLocation (return Nothing)
42 ]
44 imports' <- imports
46 return (Module.Header tag names exports settings docs imports')
49data ModuleDecl =
50 ModuleDecl
51 { _tag :: Module.SourceTag
52 , _name :: [String]
53 , _exports :: Var.Listing (A.Located Var.Value)
54 , _settings :: Module.SourceSettings
55 }
58moduleDecl :: IParser ModuleDecl
59moduleDecl =
60 expecting "a module declaration" $
61 do
62 tag <- parseTag
63 whitespace
65 names <- dotSep1 capVar <?> "the name of this module"
66 whitespace
68 settings <-
69 case tag of
70 Module.Effect _ ->
71 parseSetting <* whitespace
73 _ ->
74 return Module.emptySettings
76 reserved "exposing" <?> "something like `exposing (..)` which replaced `where` in 0.17"
77 whitespace
79 exports <- listing (addLocation value)
81 return (ModuleDecl tag names exports settings)
84parseTag :: IParser Module.SourceTag
85parseTag =
86 choice
87 [
88 do try (reserved "module")
89 return Module.Normal
90 ,
91 do start <- getMyPosition
92 try (reserved "effect")
93 whitespace
94 reserved "module"
95 end <- getMyPosition
96 return (Module.Effect (R.Region start end))
97 ,
98 do start <- getMyPosition
99 reserved "foreign"
100 whitespace
101 reserved "effect"
102 whitespace
103 reserved "module"
104 end <- getMyPosition
105 return (Module.Foreign (R.Region start end))
106 ]
109parseSetting :: IParser Module.SourceSettings
110parseSetting =
111 do try (reserved "where")
112 whitespace
113 addLocation $ brackets $ commaSep $
114 do name <- addLocation lowVar
115 padded equals
116 typeName <- addLocation capVar
117 return (name, typeName)
120imports :: IParser [Module.UserImport]
121imports =
122 many (import' `followedBy` freshLine)
125import' :: IParser Module.UserImport
126import' =
127 expecting "an import" $
128 addLocation $
129 do try (reserved "import")
130 whitespace
131 names <- dotSep1 capVar
132 (,) names <$> method (ModuleName.toString names)
133 where
134 method :: String -> IParser Module.ImportMethod
135 method defaultAlias =
136 Module.ImportMethod
137 <$> option (Just defaultAlias) (Just <$> as' defaultAlias)
138 <*> option Var.closedListing exposing
140 as' :: String -> IParser String
141 as' moduleName =
142 do try (whitespace >> reserved "as")
143 whitespace
144 capVar <?> ("an alias for module `" ++ moduleName ++ "`")
146 exposing :: IParser (Var.Listing Var.Value)
147 exposing =
148 do try (whitespace >> reserved "exposing")
149 whitespace
150 listing value
153listing :: IParser a -> IParser (Var.Listing a)
154listing item =
155 expecting "a listing of values and types to expose, like (..)" $
156 do try (whitespace >> char '(')
157 whitespace
158 actualListing <-
159 choice
160 [ const Var.openListing <$> string ".."
161 , Var.Listing <$> commaSep1 item <*> return False
162 ]
163 whitespace
164 char ')'
165 return actualListing
168value :: IParser Var.Value
169value =
170 val <|> tipe <?> "a value or type to expose"
171 where
172 val =
173 Var.Value <$> (lowVar <|> parens symOp)
175 tipe =
176 do name <- capVar
177 maybeCtors <- optionMaybe (listing capVar)
178 case maybeCtors of
179 Nothing -> return (Var.Alias name)
180 Just ctors -> return (Var.Union name ctors)