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