git.iko.soy/elk
on 455dcb2 help sign in
elk/src/Parse/Module.hs
140 lines 3.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.Helpers
7import qualified AST.Module as Module
8import qualified AST.Module.Name as ModuleName
9import qualified AST.Variable as Var
10import Reporting.Annotation as A
13getModuleName :: String -> Maybe String
14getModuleName source =
15 let
16 minimalParser =
17 do optional freshLine
18 (_, 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 (tag, names, exports) <-
33 option
34 (Module.None, ["Main"], Var.openListing)
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 docs exports imports')
48moduleDecl :: IParser (Module.Tag, [String], Var.Listing (A.Located Var.Value))
49moduleDecl =
50 expecting "a module declaration" $
51 do
52 kind <-
53 choice
54 [ do try (reserved "module")
55 return Module.None
56 , do try (reserved "effect")
57 whitespace
58 reserved "module"
59 return Module.Effect
60 , do reserved "foreign"
61 whitespace
62 reserved "effect"
63 whitespace
64 reserved "module"
65 return Module.Foreign
66 ]
68 whitespace
69 names <- dotSep1 capVar <?> "the name of this module"
71 whitespace
72 exports <- option Var.openListing (listing (addLocation value))
74 whitespace
75 reserved "where"
77 return (kind, names, exports)
80imports :: IParser [Module.UserImport]
81imports =
82 many (import' `followedBy` freshLine)
85import' :: IParser Module.UserImport
86import' =
87 expecting "an import" $
88 addLocation $
89 do try (reserved "import")
90 whitespace
91 names <- dotSep1 capVar
92 (,) names <$> method (ModuleName.toString names)
93 where
94 method :: String -> IParser Module.ImportMethod
95 method defaultAlias =
96 Module.ImportMethod
97 <$> option (Just defaultAlias) (Just <$> as' defaultAlias)
98 <*> option Var.closedListing exposing
100 as' :: String -> IParser String
101 as' moduleName =
102 do try (whitespace >> reserved "as")
103 whitespace
104 capVar <?> ("an alias for module `" ++ moduleName ++ "`")
106 exposing :: IParser (Var.Listing Var.Value)
107 exposing =
108 do try (whitespace >> reserved "exposing")
109 whitespace
110 listing value
113listing :: IParser a -> IParser (Var.Listing a)
114listing item =
115 expecting "a listing of values and types to expose, like (..)" $
116 do try (whitespace >> char '(')
117 whitespace
118 actualListing <-
119 choice
120 [ const Var.openListing <$> string ".."
121 , Var.Listing <$> commaSep1 item <*> return False
122 ]
123 whitespace
124 char ')'
125 return actualListing
128value :: IParser Var.Value
129value =
130 val <|> tipe <?> "a value or type to expose"
131 where
132 val =
133 Var.Value <$> (lowVar <|> parens symOp)
135 tipe =
136 do name <- capVar
137 maybeCtors <- optionMaybe (listing capVar)
138 case maybeCtors of
139 Nothing -> return (Var.Alias name)
140 Just ctors -> return (Var.Union name ctors)