on ed48cd2 help sign in
elk/src/Parse/Module.hs
111 lines 3.1 kB history raw
1module Parse.Module (moduleDecl, header, getModuleName) where
3import Control.Applicative ((<$>), (<*>))
4import Text.Parsec hiding (newline, spaces)
6import Parse.Helpers
7import qualified AST.Module as Module
8import qualified AST.Variable as Var
9import Reporting.Annotation as A
12getModuleName :: String -> Maybe String
13getModuleName source =
14 case iParse getModuleName source of
15 Right name -> Just name
16 Left _ -> Nothing
17 where
18 getModuleName =
19 do optional freshLine
20 (names, _) <- moduleDecl
21 return (Module.nameToString names)
24header :: IParser (Module.Header [Module.UserImport])
25header =
26 do optional freshLine
27 (names, exports) <-
28 option (["Main"], Var.openListing) (moduleDecl `followedBy` freshLine)
29 docs <-
30 choice
31 [ addLocation (Just <$> docComment) `followedBy` freshLine
32 , addLocation (return Nothing)
33 ]
34 imports' <- imports
35 return (Module.Header names docs exports imports')
38moduleDecl :: IParser ([String], Var.Listing (A.Located Var.Value))
39moduleDecl =
40 expecting "a module declaration" $
41 do try (reserved "module")
42 whitespace
43 names <- dotSep1 capVar <?> "the name of this module"
44 whitespace
45 exports <- option Var.openListing (listing (addLocation value))
46 whitespace
47 reserved "where"
48 return (names, exports)
51imports :: IParser [Module.UserImport]
52imports =
53 many (import' `followedBy` freshLine)
56import' :: IParser Module.UserImport
57import' =
58 expecting "an import" $
59 addLocation $
60 do try (reserved "import")
61 whitespace
62 names <- dotSep1 capVar
63 (,) names <$> method (Module.nameToString names)
64 where
65 method :: String -> IParser Module.ImportMethod
66 method defaultAlias =
67 Module.ImportMethod
68 <$> option (Just defaultAlias) (Just <$> as' defaultAlias)
69 <*> option Var.closedListing exposing
71 as' :: String -> IParser String
72 as' moduleName =
73 do try (whitespace >> reserved "as")
74 whitespace
75 capVar <?> ("an alias for module `" ++ moduleName ++ "`")
77 exposing :: IParser (Var.Listing Var.Value)
78 exposing =
79 do try (whitespace >> reserved "exposing")
80 whitespace
81 listing value
84listing :: IParser a -> IParser (Var.Listing a)
85listing item =
86 expecting "a listing of values and types to expose, like (..)" $
87 do try (whitespace >> char '(')
88 whitespace
89 listing <-
90 choice
91 [ const Var.openListing <$> string ".."
92 , Var.Listing <$> commaSep1 item <*> return False
93 ]
94 whitespace
95 char ')'
96 return listing
99value :: IParser Var.Value
100value =
101 val <|> tipe <?> "a value or type to expose"
102 where
103 val =
104 Var.Value <$> (lowVar <|> parens symOp)
106 tipe =
107 do name <- capVar
108 maybeCtors <- optionMaybe (listing capVar)
109 case maybeCtors of
110 Nothing -> return (Var.Alias name)
111 Just ctors -> return (Var.Union name ctors)