git.iko.soy/elk
on df41ae8 help sign in
elk/src/Parse/Module.hs
169 lines 4.3 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
64 names <- padded (dotSep1 capVar) <?> "the name of this module"
66 settings <- option Module.emptySettings parseSetting
68 exports <- padded (listing (addLocation value))
70 reserved "where"
72 return (ModuleDecl tag names exports settings)
75parseTag :: IParser Module.SourceTag
76parseTag =
77 choice
78 [
79 do try (reserved "module")
80 return Module.Normal
81 ,
82 do start <- getMyPosition
83 try (reserved "effect")
84 whitespace
85 reserved "module"
86 end <- getMyPosition
87 return (Module.Effect (R.Region start end))
88 ,
89 do start <- getMyPosition
90 reserved "foreign"
91 whitespace
92 reserved "effect"
93 whitespace
94 reserved "module"
95 end <- getMyPosition
96 return (Module.Foreign (R.Region start end))
97 ]
100parseSetting :: IParser Module.SourceSettings
101parseSetting =
102 addLocation $ brackets $ commaSep $
103 do name <- addLocation lowVar
104 padded equals
105 typeName <- addLocation capVar
106 return (name, typeName)
109imports :: IParser [Module.UserImport]
110imports =
111 many (import' `followedBy` freshLine)
114import' :: IParser Module.UserImport
115import' =
116 expecting "an import" $
117 addLocation $
118 do try (reserved "import")
119 whitespace
120 names <- dotSep1 capVar
121 (,) names <$> method (ModuleName.toString names)
122 where
123 method :: String -> IParser Module.ImportMethod
124 method defaultAlias =
125 Module.ImportMethod
126 <$> option (Just defaultAlias) (Just <$> as' defaultAlias)
127 <*> option Var.closedListing exposing
129 as' :: String -> IParser String
130 as' moduleName =
131 do try (whitespace >> reserved "as")
132 whitespace
133 capVar <?> ("an alias for module `" ++ moduleName ++ "`")
135 exposing :: IParser (Var.Listing Var.Value)
136 exposing =
137 do try (whitespace >> reserved "exposing")
138 whitespace
139 listing value
142listing :: IParser a -> IParser (Var.Listing a)
143listing item =
144 expecting "a listing of values and types to expose, like (..)" $
145 do try (whitespace >> char '(')
146 whitespace
147 actualListing <-
148 choice
149 [ const Var.openListing <$> string ".."
150 , Var.Listing <$> commaSep1 item <*> return False
151 ]
152 whitespace
153 char ')'
154 return actualListing
157value :: IParser Var.Value
158value =
159 val <|> tipe <?> "a value or type to expose"
160 where
161 val =
162 Var.Value <$> (lowVar <|> parens symOp)
164 tipe =
165 do name <- capVar
166 maybeCtors <- optionMaybe (listing capVar)
167 case maybeCtors of
168 Nothing -> return (Var.Alias name)
169 Just ctors -> return (Var.Union name ctors)