git.iko.soy/elk
on 267f708 help sign in
elk/src/Parse/Module.hs
179 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.Binop (infixOp)
7import Parse.Helpers
8import qualified AST.Module as Module
9import qualified AST.Module.Name as ModuleName
10import qualified AST.Variable as Var
11import qualified Reporting.Annotation as A
12import qualified Reporting.Region as R
15getModuleName :: String -> Maybe String
16getModuleName source =
17 let
18 minimalParser =
19 do optional freshLine
20 (ModuleDecl _ names _ _) <- moduleDecl
21 return (ModuleName.toString names)
22 in
23 case iParse minimalParser source of
24 Right name ->
25 Just name
27 Left _ ->
28 Nothing
31header :: IParser (Module.Header [Module.UserImport])
32header =
33 do optional freshLine
34 (ModuleDecl tag names exports settings) <-
35 option
36 (ModuleDecl Module.Normal ["Main"] Var.openListing Module.emptySettings)
37 (moduleDecl `followedBy` freshLine)
39 docs <-
40 choice
41 [ addLocation (Just <$> docComment) `followedBy` freshLine
42 , addLocation (return Nothing)
43 ]
45 imports' <- imports
47 return (Module.Header tag names exports settings docs imports')
50data ModuleDecl =
51 ModuleDecl
52 { _tag :: Module.SourceTag
53 , _name :: [String]
54 , _exports :: Var.Listing (A.Located Var.Value)
55 , _settings :: Module.SourceSettings
56 }
59moduleDecl :: IParser ModuleDecl
60moduleDecl =
61 expecting "a module declaration" $
62 do
63 tag <- parseTag
64 whitespace
66 names <- dotSep1 capVar <?> "the name of this module"
67 whitespace
69 settings <-
70 case tag of
71 Module.Effect _ ->
72 parseSetting <* whitespace
74 _ ->
75 return Module.emptySettings
77 reserved "exposing" <?> "something like `exposing (..)` which replaced `where` in 0.17"
78 whitespace
80 exports <- listing (addLocation value)
82 return (ModuleDecl tag names exports settings)
85parseTag :: IParser Module.SourceTag
86parseTag =
87 choice
88 [
89 do try (reserved "module")
90 return Module.Normal
91 ,
92 do start <- getMyPosition
93 try (reserved "effect")
94 whitespace
95 reserved "module"
96 end <- getMyPosition
97 return (Module.Effect (R.Region start end))
98 ,
99 do start <- getMyPosition
100 try (reserved "port")
101 whitespace
102 reserved "module"
103 end <- getMyPosition
104 return (Module.Port (R.Region start end))
105 ]
108parseSetting :: IParser Module.SourceSettings
109parseSetting =
110 do try (reserved "where")
111 whitespace
112 addLocation $ brackets $ commaSep $
113 do name <- addLocation lowVar
114 padded equals
115 typeName <- addLocation capVar
116 return (name, typeName)
119imports :: IParser [Module.UserImport]
120imports =
121 many (import' `followedBy` freshLine)
124import' :: IParser Module.UserImport
125import' =
126 expecting "an import" $
127 addLocation $
128 do try (reserved "import")
129 whitespace
130 names <- dotSep1 capVar
131 (,) names <$> method (ModuleName.toString names)
132 where
133 method :: String -> IParser Module.ImportMethod
134 method defaultAlias =
135 Module.ImportMethod
136 <$> option (Just defaultAlias) (Just <$> as' defaultAlias)
137 <*> option Var.closedListing exposing
139 as' :: String -> IParser String
140 as' moduleName =
141 do try (whitespace >> reserved "as")
142 whitespace
143 capVar <?> ("an alias for module `" ++ moduleName ++ "`")
145 exposing :: IParser (Var.Listing Var.Value)
146 exposing =
147 do try (whitespace >> reserved "exposing")
148 whitespace
149 listing value
152listing :: IParser a -> IParser (Var.Listing a)
153listing item =
154 expecting "a listing of values and types to expose, like (..)" $
155 do try (whitespace >> char '(')
156 whitespace
157 actualListing <-
158 choice
159 [ const Var.openListing <$> string ".."
160 , Var.Listing <$> commaSep1 item <*> return False
161 ]
162 whitespace
163 char ')'
164 return actualListing
167value :: IParser Var.Value
168value =
169 val <|> tipe <?> "a value or type to expose"
170 where
171 val =
172 Var.Value <$> (lowVar <|> parens infixOp)
174 tipe =
175 do name <- capVar
176 maybeCtors <- optionMaybe (listing capVar)
177 case maybeCtors of
178 Nothing -> return (Var.Alias name)
179 Just ctors -> return (Var.Union name ctors)