git.iko.soy/elk
on bfb4f2d help sign in
elk/src/Parse/Module.hs
178 lines 4.5 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 try (reserved "port")
100 whitespace
101 reserved "module"
102 end <- getMyPosition
103 return (Module.Port (R.Region start end))
104 ]
107parseSetting :: IParser Module.SourceSettings
108parseSetting =
109 do try (reserved "where")
110 whitespace
111 addLocation $ brackets $ commaSep $
112 do name <- addLocation lowVar
113 padded equals
114 typeName <- addLocation capVar
115 return (name, typeName)
118imports :: IParser [Module.UserImport]
119imports =
120 many (import' `followedBy` freshLine)
123import' :: IParser Module.UserImport
124import' =
125 expecting "an import" $
126 addLocation $
127 do try (reserved "import")
128 whitespace
129 names <- dotSep1 capVar
130 (,) names <$> method (ModuleName.toString names)
131 where
132 method :: String -> IParser Module.ImportMethod
133 method defaultAlias =
134 Module.ImportMethod
135 <$> option (Just defaultAlias) (Just <$> as' defaultAlias)
136 <*> option Var.closedListing exposing
138 as' :: String -> IParser String
139 as' moduleName =
140 do try (whitespace >> reserved "as")
141 whitespace
142 capVar <?> ("an alias for module `" ++ moduleName ++ "`")
144 exposing :: IParser (Var.Listing Var.Value)
145 exposing =
146 do try (whitespace >> reserved "exposing")
147 whitespace
148 listing value
151listing :: IParser a -> IParser (Var.Listing a)
152listing item =
153 expecting "a listing of values and types to expose, like (..)" $
154 do try (whitespace >> char '(')
155 whitespace
156 actualListing <-
157 choice
158 [ const Var.openListing <$> string ".."
159 , Var.Listing <$> commaSep1 item <*> return False
160 ]
161 whitespace
162 char ')'
163 return actualListing
166value :: IParser Var.Value
167value =
168 val <|> tipe <?> "a value or type to expose"
169 where
170 val =
171 Var.Value <$> (lowVar <|> parens symOp)
173 tipe =
174 do name <- capVar
175 maybeCtors <- optionMaybe (listing capVar)
176 case maybeCtors of
177 Nothing -> return (Var.Alias name)
178 Just ctors -> return (Var.Union name ctors)