fdbcc73 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

[ fix #4304 ] Make the Module Name parser explicit

fdbcc73Guillaume Allais9 years ago

src/Idris/Package/Parser.hs+2−1

compare with master

unifiedsplit

@@ -11,6 +11,7 @@ module Idris.Package.Parser where

11import Idris.CmdOptions

12import Idris.Imports

13import Idris.Package.Common

14+import Idris.Parser (moduleName)

14import Idris.Parser.Helpers (Parser, Parsing, eol, iName, identifier, isEol,

15import Idris.Parser.Helpers (Parser, Parsing, eol, iName, identifier, isEol,

15 lchar, packageName, parseErrorDoc, reserved,

16 lchar, packageName, parseErrorDoc, reserved,

16 runparser, someSpace, stringLiteral)

17 runparser, someSpace, stringLiteral)

@@ -117,7 +118,7 @@ pClause = clause "executable" filename (\st v -> st { execout = Just v })

117 let pkgs = pureArgParser $ concatMap (\x -> ["-p", show x]) ps

118 let pkgs = pureArgParser $ concatMap (\x -> ["-p", show x]) ps

118 in st { pkgdeps = ps `union` pkgdeps st

119 in st { pkgdeps = ps `union` pkgdeps st

119 , idris_opts = pkgs ++ idris_opts st })

120 , idris_opts = pkgs ++ idris_opts st })

120− <|> clause "modules" (commaSep (iName [])) (\st v -> st { modules = modules st ++ v })

121+ <|> clause "modules" (commaSep moduleName) (\st v -> st { modules = modules st ++ v })

121 <|> clause "libs" (commaSep identifier) (\st v -> st { libdeps = libdeps st ++ v })

122 <|> clause "libs" (commaSep identifier) (\st v -> st { libdeps = libdeps st ++ v })

122 <|> clause "objs" (commaSep identifier) (\st v -> st { objs = objs st ++ v })

123 <|> clause "objs" (commaSep identifier) (\st v -> st { objs = objs st ++ v })

123 <|> clause "makefile" (iName []) (\st v -> st { makefile = Just (show v) })

124 <|> clause "makefile" (iName []) (\st v -> st { makefile = Just (show v) })

src/Idris/Parser.hs+21−14

@@ -12,7 +12,7 @@ Maintainer : The Idris Community.

12-- FIXME: {-# OPTIONS_GHC -fwarn-incomplete-patterns #-}

13{-# OPTIONS_GHC -fwarn-unused-imports #-}

15−module Idris.Parser(IdrisParser(..), ImportInfo(..), addReplSyntax, clearParserWarnings,

15+module Idris.Parser(IdrisParser(..), ImportInfo(..), moduleName, addReplSyntax, clearParserWarnings,

16 decl, fixColour, loadFromIFile, loadModule, name, opChars, parseElabShellStep, parseConst, parseExpr, parseImports, parseTactic,

17 runparser, ParseError, parseErrorDoc) where

@@ -81,23 +81,31 @@ import qualified Text.PrettyPrint.ANSI.Leijen as PP

81 ModuleHeader ::= DocComment_t? 'module' Identifier_t ';'?;

82@

83-}

84+

85+

86+moduleName :: Parsing m => m Name

87+moduleName = mkName [] . map T.pack <$> moduleNamePieces where

88+

89+ mkName :: [T.Text] -> [T.Text] -> Name

90+ mkName ts [x] = NS (UN x) ts

91+ mkName ts (x:xs) = mkName (x : ts) xs

92+

93+moduleNamePieces :: Parsing m => m [String]

94+moduleNamePieces = Spl.splitOn "." <$> identifier

95+

84moduleHeader :: IdrisParser (Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])

96moduleHeader :: IdrisParser (Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])

85moduleHeader = P.try (do docs <- optional docComment

97moduleHeader = P.try (do docs <- optional docComment

86 noArgs docs

98 noArgs docs

87 keyword "module"

99 keyword "module"

88− (i, ifc) <- withExtent identifier

100+ (modName, ifc) <- withExtent moduleNamePieces

89 P.option ';' (lchar ';')

101 P.option ';' (lchar ';')

90− let modName = moduleName i

91 return (fmap fst docs,

102 return (fmap fst docs,

92 modName,

103 modName,

93 [(ifc, AnnNamespace (map T.pack modName) Nothing)]))

104 [(ifc, AnnNamespace (map T.pack modName) Nothing)]))

94 <|> P.try (do lchar '%'; reserved "unqualified"

105 <|> P.try (do lchar '%'; reserved "unqualified"

95 return (Nothing, [], []))

106 return (Nothing, [], []))

96− <|> return (Nothing, moduleName "Main", [])

107+ <|> return (Nothing, ["Main"], [])

97− where moduleName x = case span (/='.') x of

98− (x, "") -> [x]

99− (x, '.':y) -> x : moduleName y

100− noArgs (Just (_, args)) | not (null args) = fail "Modules do not take arguments"

108+ where noArgs (Just (_, args)) | not (null args) = fail "Modules do not take arguments"

101 noArgs _ = return ()

109 noArgs _ = return ()

102

110

103data ImportInfo = ImportInfo { import_reexport :: Bool

111data ImportInfo = ImportInfo { import_reexport :: Bool

@@ -117,16 +125,15 @@ data ImportInfo = ImportInfo { import_reexport :: Bool

117import_ :: IdrisParser ImportInfo

125import_ :: IdrisParser ImportInfo

118import_ = do fc <- extent $ keyword "import"

126import_ = do fc <- extent $ keyword "import"

119 reexport <- P.option False (True <$ keyword "public")

127 reexport <- P.option False (True <$ keyword "public")

120− (id, idfc) <- withExtent identifier

128+ (ns, idfc) <- withExtent moduleNamePieces

121 newName <- optional (do keyword "as"

129 newName <- optional (do keyword "as"

122 withExtent identifier)

130 withExtent identifier)

123 P.option ';' (lchar ';')

131 P.option ';' (lchar ';')

124− return $ ImportInfo reexport (toPath id)

132+ return $ ImportInfo reexport (toPath ns)

125− (fmap (\(n, fc) -> (toPath n, fc)) newName)

133+ (fmap (\(n, fc) -> (toPath (Spl.splitOn "." n), fc)) newName)

126− (map T.pack $ ns id) fc idfc

134+ (map T.pack ns) fc idfc

127 <?> "import statement"

135 <?> "import statement"

128− where ns = Spl.splitOn "."

129− toPath = foldl1' (</>) . ns

136+ where toPath = foldl1' (</>)

130

137

131{-| Parses program source

138{-| Parses program source

132

139