git.iko.soy/elk
on eb7feba help sign in
elk/src/Parse/Module.hs
164 lines 4.1 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
13getModuleName :: String -> Maybe String
14getModuleName source =
15 let
16 minimalParser =
17 do optional freshLine
18 (ModuleDecl _ names _ _) <- moduleDecl
19 return (ModuleName.toString names)
20 in
21 case iParse minimalParser source of
22 Right name ->
23 Just name
25 Left _ ->
26 Nothing
29header :: IParser (Module.Header [Module.UserImport])
30header =
31 do optional freshLine
32 (ModuleDecl tag names exports settings) <-
33 option
34 (ModuleDecl Module.SrcNormal ["Main"] Var.openListing Module.emptySettings)
35 (moduleDecl `followedBy` freshLine)
37 docs <-
38 choice
39 [ addLocation (Just <$> docComment) `followedBy` freshLine
40 , addLocation (return Nothing)
41 ]
43 imports' <- imports
45 return (Module.Header tag names exports settings docs imports')
48data ModuleDecl =
49 ModuleDecl
50 { _tag :: Module.SourceTag
51 , _name :: [String]
52 , _exports :: Var.Listing (A.Located Var.Value)
53 , _settings :: Module.SourceSettings
54 }
57moduleDecl :: IParser ModuleDecl
58moduleDecl =
59 expecting "a module declaration" $
60 do
61 tag <- parseTag
63 names <- padded (dotSep1 capVar) <?> "the name of this module"
65 settings <- option Module.emptySettings parseSetting
67 exports <- padded (listing (addLocation value))
69 reserved "where"
71 return (ModuleDecl tag names exports settings)
74parseTag :: IParser Module.SourceTag
75parseTag =
76 choice
77 [
78 do try (reserved "module")
79 return Module.SrcNormal
80 ,
81 do try (reserved "effect")
82 whitespace
83 reserved "module"
84 return Module.SrcEffect
85 ,
86 do reserved "foreign"
87 whitespace
88 reserved "effect"
89 whitespace
90 reserved "module"
91 return Module.SrcForeign
92 ]
95parseSetting :: IParser Module.SourceSettings
96parseSetting =
97 addLocation $ brackets $ commaSep $
98 do name <- addLocation lowVar
99 padded equals
100 typeName <- addLocation capVar
101 return (name, typeName)
104imports :: IParser [Module.UserImport]
105imports =
106 many (import' `followedBy` freshLine)
109import' :: IParser Module.UserImport
110import' =
111 expecting "an import" $
112 addLocation $
113 do try (reserved "import")
114 whitespace
115 names <- dotSep1 capVar
116 (,) names <$> method (ModuleName.toString names)
117 where
118 method :: String -> IParser Module.ImportMethod
119 method defaultAlias =
120 Module.ImportMethod
121 <$> option (Just defaultAlias) (Just <$> as' defaultAlias)
122 <*> option Var.closedListing exposing
124 as' :: String -> IParser String
125 as' moduleName =
126 do try (whitespace >> reserved "as")
127 whitespace
128 capVar <?> ("an alias for module `" ++ moduleName ++ "`")
130 exposing :: IParser (Var.Listing Var.Value)
131 exposing =
132 do try (whitespace >> reserved "exposing")
133 whitespace
134 listing value
137listing :: IParser a -> IParser (Var.Listing a)
138listing item =
139 expecting "a listing of values and types to expose, like (..)" $
140 do try (whitespace >> char '(')
141 whitespace
142 actualListing <-
143 choice
144 [ const Var.openListing <$> string ".."
145 , Var.Listing <$> commaSep1 item <*> return False
146 ]
147 whitespace
148 char ')'
149 return actualListing
152value :: IParser Var.Value
153value =
154 val <|> tipe <?> "a value or type to expose"
155 where
156 val =
157 Var.Value <$> (lowVar <|> parens symOp)
159 tipe =
160 do name <- capVar
161 maybeCtors <- optionMaybe (listing capVar)
162 case maybeCtors of
163 Nothing -> return (Var.Alias name)
164 Just ctors -> return (Var.Union name ctors)