fdbcc73 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

[ fix #4304 ] Make the Module Name parser explicit

and share it between Idris.Parser and Idris.Package.Parser

commitfdbcc737a40da6683a04b05b3716235f399263aa authorGuillaume Allais <guillaume.allais@ens-lyon.org> dateThu 25 Jan 2018, 23:17 (9 years ago) parent5205520

2 files changed+23−15

compare with master

unifiedsplit

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

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

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

1111import Idris.CmdOptions

1212import Idris.Imports

1313import Idris.Package.Common

14+import Idris.Parser (moduleName)

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

1516 lchar, packageName, parseErrorDoc, reserved,

1617 runparser, someSpace, stringLiteral)

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

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

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

119120 , 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 })

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

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

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

src/Idris/Parser.hs+21−14

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

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

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

1414

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

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

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

1717 runparser, ParseError, parseErrorDoc) where

1818

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

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

8282@

8383-}

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+

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

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

8698 noArgs docs

8799 keyword "module"

88− (i, ifc) <- withExtent identifier

100+ (modName, ifc) <- withExtent moduleNamePieces

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

90− let modName = moduleName i

91102 return (fmap fst docs,

92103 modName,

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

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

95106 return (Nothing, [], []))

96− <|> return (Nothing, moduleName "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"

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

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

101109 noArgs _ = return ()

102110

103111data ImportInfo = ImportInfo { import_reexport :: Bool

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

117125import_ :: IdrisParser ImportInfo

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

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

120− (id, idfc) <- withExtent identifier

128+ (ns, idfc) <- withExtent moduleNamePieces

121129 newName <- optional (do keyword "as"

122130 withExtent identifier)

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

124− return $ ImportInfo reexport (toPath id)

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

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

132+ return $ ImportInfo reexport (toPath ns)

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

134+ (map T.pack ns) fc idfc

127135 <?> "import statement"

128− where ns = Spl.splitOn "."

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

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

130137

131138{-| Parses program source

132139