1764f7f · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Use our own `token` instead of Text.Parser.Token

1764f7fJason Felice9 years ago

src/Idris/Package/Parser.hs+4−9

compare with master

unifiedsplit

@@ -13,7 +13,7 @@ import Idris.Imports

13import Idris.Package.Common

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

15 lchar, packageName, parseErrorDoc, reserved,

16− runparser, someSpace')

16+ runparser, someSpace', stringLiteral)

18import Control.Applicative

19import Control.Monad.State.Strict

@@ -21,7 +21,6 @@ import Data.List (union)

21import System.Directory (doesFileExist)

22import System.Exit

23import System.FilePath (isValid, takeExtension, takeFileName)

24−import Text.Parser.Token (TokenParsing(..), stringLiteral)

25import qualified Text.PrettyPrint.ANSI.Leijen as PP

24import qualified Text.PrettyPrint.ANSI.Leijen as PP

26import Text.Megaparsec ((<?>))

25import Text.Megaparsec ((<?>))

27import qualified Text.Megaparsec as P

26import qualified Text.Megaparsec as P

@@ -29,10 +28,6 @@ import qualified Text.Megaparsec.Char as P

30type PParser = StateT PkgDesc IdrisInnerParser

29type PParser = StateT PkgDesc IdrisInnerParser

32−instance {-# OVERLAPPING #-} TokenParsing PParser where

33− someSpace = someSpace'

34−

35−

36parseDesc :: FilePath -> IO PkgDesc

31parseDesc :: FilePath -> IO PkgDesc

37parseDesc fp = do

32parseDesc fp = do

38 when (not $ takeExtension fp == ".ipkg") $ do

33 when (not $ takeExtension fp == ".ipkg") $ do

@@ -72,7 +67,7 @@ filename = (do

72 -- This also moves away from tying filenames to identifiers, so

67 -- This also moves away from tying filenames to identifiers, so

73 -- it will also accept hyphens

68 -- it will also accept hyphens

74 -- (https://github.com/idris-lang/Idris-dev/issues/2721)

69 -- (https://github.com/idris-lang/Idris-dev/issues/2721)

75− filename <- stringLiteral <* someSpace'

70+ filename <- fst <$> stringLiteral

76 -- Through at least version 0.9.19.1, IPKG executable values were

71 -- Through at least version 0.9.19.1, IPKG executable values were

77 -- possibly namespaced identifiers, like foo.bar.baz.

72 -- possibly namespaced identifiers, like foo.bar.baz.

78 <|> show . fst <$> iName []

73 <|> show . fst <$> iName []

@@ -117,7 +112,7 @@ pClause :: PParser ()

117pClause = clause "executable" filename (\st v -> st { execout = Just v })

112pClause = clause "executable" filename (\st v -> st { execout = Just v })

118 <|> clause "main" (fst <$> iName []) (\st v -> st { idris_main = Just v })

113 <|> clause "main" (fst <$> iName []) (\st v -> st { idris_main = Just v })

119 <|> clause "sourcedir" (fst <$> identifier) (\st v -> st { sourcedir = v })

114 <|> clause "sourcedir" (fst <$> identifier) (\st v -> st { sourcedir = v })

120− <|> clause "opts" (pureArgParser . words <$> stringLiteral) (\st v -> st { idris_opts = v ++ idris_opts st })

115+ <|> clause "opts" (pureArgParser . words . fst <$> stringLiteral) (\st v -> st { idris_opts = v ++ idris_opts st })

121 <|> clause "pkgs" (commaSep (pPkgName <* someSpace')) (\st ps ->

116 <|> clause "pkgs" (commaSep (pPkgName <* someSpace')) (\st ps ->

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

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

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

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

@@ -133,6 +128,6 @@ pClause = clause "executable" filename (\st v -> st { execout = Just v })

133 <|> clause "homepage" textUntilEol (\st v -> st { pkghomepage = Just v })

128 <|> clause "homepage" textUntilEol (\st v -> st { pkghomepage = Just v })

134 <|> clause "sourceloc" textUntilEol (\st v -> st { pkgsourceloc = Just v })

129 <|> clause "sourceloc" textUntilEol (\st v -> st { pkgsourceloc = Just v })

135 <|> clause "bugtracker" textUntilEol (\st v -> st { pkgbugtracker = Just v })

130 <|> clause "bugtracker" textUntilEol (\st v -> st { pkgbugtracker = Just v })

136− <|> clause "brief" stringLiteral (\st v -> st { pkgbrief = Just v })

131+ <|> clause "brief" (fst <$> stringLiteral) (\st v -> st { pkgbrief = Just v })

137 <|> clause "author" textUntilEol (\st v -> st { pkgauthor = Just v })

132 <|> clause "author" textUntilEol (\st v -> st { pkgauthor = Just v })

138 <|> clause "maintainer" textUntilEol (\st v -> st { pkgmaintainer = Just v })

133 <|> clause "maintainer" textUntilEol (\st v -> st { pkgmaintainer = Just v })

src/Idris/Parser/Expr.hs+8−9

@@ -25,7 +25,6 @@ import Control.Monad.State.Strict

25import Data.Function (on)

26import Data.List

27import Data.Maybe

28−import qualified Text.Parser.Token as Tok

29import Text.Parser.Expression

28import Text.Parser.Expression

30import Text.Megaparsec ((<?>))

29import Text.Megaparsec ((<?>))

31import qualified Text.Megaparsec as P

30import qualified Text.Megaparsec as P

@@ -1285,9 +1284,9 @@ ExprList ::=

1285listExpr :: SyntaxInfo -> IdrisParser PTerm

1284listExpr :: SyntaxInfo -> IdrisParser PTerm

1286listExpr syn = do (FC f (l, c) _) <- getFC

1285listExpr syn = do (FC f (l, c) _) <- getFC

1287 lchar '['; fc <- getFC;

1286 lchar '['; fc <- getFC;

1288− (P.try . Tok.token $ do (char ']' <?> "end of list expression")

1287+ (P.try . token $ do (char ']' <?> "end of list expression")

1289− (FC _ _ (l', c')) <- getFC

1288+ (FC _ _ (l', c')) <- getFC

1290− return (mkNil (FC f (l, c) (l', c'))))

1289+ return (mkNil (FC f (l, c) (l', c'))))

1291 <|> (do x <- expr (syn { withAppAllowed = False }) <?> "expression"

1290 <|> (do x <- expr (syn { withAppAllowed = False }) <?> "expression"

1292 (do P.try (lchar '|') <?> "list comprehension"

1291 (do P.try (lchar '|') <?> "list comprehension"

1293 qs <- P.sepBy1 (do_ syn) (lchar ',')

1292 qs <- P.sepBy1 (do_ syn) (lchar ',')

@@ -1469,11 +1468,11 @@ VerbatimString_t ::=

1469@

1468@

1470 -}

1469 -}

1471verbatimStringLiteral :: IdrisParser (String, FC)

1470verbatimStringLiteral :: IdrisParser (String, FC)

1472−verbatimStringLiteral = Tok.token $ do (FC f start _) <- getFC

1471+verbatimStringLiteral = token $ do (FC f start _) <- getFC

1473− P.try $ string "\"\"\""

1472+ P.try $ string "\"\"\""

1474− str <- P.manyTill P.anyChar $ P.try (string "\"\"\"")

1473+ str <- P.manyTill P.anyChar $ P.try (string "\"\"\"")

1475− (FC _ _ end) <- getFC

1474+ (FC _ _ end) <- getFC

1476− return (str, FC f start end)

1475+ return (str, FC f start end)

1477

1476

1478{- | Parses a static modifier

1477{- | Parses a static modifier

1479

1478

src/Idris/Parser/Helpers.hs+11−13

@@ -34,7 +34,6 @@ import Data.Void (Void(..))

34import System.FilePath

35import qualified Text.Parser.Char

36import qualified Text.Parser.Combinators

37−import qualified Text.Parser.Token as Tok

38import qualified Text.PrettyPrint.ANSI.Leijen as PP

37import qualified Text.PrettyPrint.ANSI.Leijen as PP

39import Text.Megaparsec ((<?>))

38import Text.Megaparsec ((<?>))

40import qualified Text.Megaparsec as P

39import qualified Text.Megaparsec as P

@@ -55,7 +54,7 @@ parseErrorDoc :: ParseError -> PP.Doc

55parseErrorDoc = PP.string . parseErrorPretty

54parseErrorDoc = PP.string . parseErrorPretty

57-- | Generalized monadic parsing constraint type

56-- | Generalized monadic parsing constraint type

58−type MonadicParsing m = (P.MonadParsec Void String m, Tok.TokenParsing m)

57+type MonadicParsing m = (P.MonadParsec Void String m)

60someSpace' :: MonadicParsing m => m ()

59someSpace' :: MonadicParsing m => m ()

61someSpace' = many (simpleWhiteSpace <|> singleLineComment <|> multiLineComment) *> pure ()

60someSpace' = many (simpleWhiteSpace <|> singleLineComment <|> multiLineComment) *> pure ()

@@ -72,7 +71,7 @@ instance Text.Parser.Char.CharParsing IdrisInnerParser where

72 char = P.char

71 char = P.char

73 string = P.string

72 string = P.string

75−tokenFC :: IdrisParser a -> IdrisParser (a, FC)

74+tokenFC :: MonadicParsing m => m a -> m (a, FC)

76tokenFC p = do (FC fn (sl, sc) _) <- getFC --TODO: Update after fixing getFC

75tokenFC p = do (FC fn (sl, sc) _) <- getFC --TODO: Update after fixing getFC

77 -- See Issue #1594

76 -- See Issue #1594

78 r <- p

77 r <- p

@@ -80,9 +79,8 @@ tokenFC p = do (FC fn (sl, sc) _) <- getFC --TODO: Update after fixing getFC

80 whiteSpace

79 whiteSpace

81 return (r, FC fn (sl, sc) (el, ec))

80 return (r, FC fn (sl, sc) (el, ec))

83−instance {-# OVERLAPPING #-} Tok.TokenParsing IdrisParser where

82+token :: MonadicParsing m => m a -> m a

84− someSpace = someSpace'

85− token p = p <* whiteSpace

83+token p = p <* whiteSpace

87-- | Helper to run Idris inner parser based stateT parsers

85-- | Helper to run Idris inner parser based stateT parsers

88runparser :: StateT st IdrisInnerParser res -> st -> String -> String -> Either ParseError res

86runparser :: StateT st IdrisInnerParser res -> st -> String -> String -> Either ParseError res

@@ -227,7 +225,7 @@ whiteSpace :: MonadicParsing m => m ()

227whiteSpace = someSpace' <|> pure ()

225whiteSpace = someSpace' <|> pure ()

228

226

229-- | Parses a string literal

227-- | Parses a string literal

230−stringLiteral :: IdrisParser (String, FC)

228+stringLiteral :: MonadicParsing m => m (String, FC)

231stringLiteral = tokenFC . P.try $ P.char '"' *> P.manyTill P.charLiteral (P.char '"')

229stringLiteral = tokenFC . P.try $ P.char '"' *> P.manyTill P.charLiteral (P.char '"')

232

230

233-- | Parses a char literal

231-- | Parses a char literal

@@ -258,7 +256,7 @@ reservedIdentifiers = HS.fromList

258 ]

256 ]

259

257

260identifierOrReserved :: MonadicParsing m => m String

258identifierOrReserved :: MonadicParsing m => m String

261−identifierOrReserved = Tok.token $ P.try $ do

259+identifierOrReserved = token $ P.try $ do

262 c <- P.satisfy isAlpha <|> P.oneOf "_"

260 c <- P.satisfy isAlpha <|> P.oneOf "_"

263 cs <- P.many (P.satisfy isAlphaNum <|> P.oneOf "_'.")

261 cs <- P.many (P.satisfy isAlphaNum <|> P.oneOf "_'.")

264 return $ c : cs

262 return $ c : cs

@@ -271,12 +269,12 @@ string = P.string

271

269

272-- | Parses a character as a token

270-- | Parses a character as a token

273lchar :: MonadicParsing m => Char -> m Char

271lchar :: MonadicParsing m => Char -> m Char

274−lchar = Tok.token . P.char

272+lchar = token . P.char

275

273

276-- | Parses a character as a token, returning the source span of the character

274-- | Parses a character as a token, returning the source span of the character

277lcharFC :: MonadicParsing m => Char -> m FC

275lcharFC :: MonadicParsing m => Char -> m FC

278lcharFC ch = do (FC file (l, c) _) <- getFC

276lcharFC ch = do (FC file (l, c) _) <- getFC

279− _ <- Tok.token (P.char ch)

277+ _ <- token (P.char ch)

280 return $ FC file (l, c) (l, c+1)

278 return $ FC file (l, c) (l, c+1)

281

279

282symbol :: MonadicParsing m => String -> m ()

280symbol :: MonadicParsing m => String -> m ()

@@ -289,7 +287,7 @@ symbolFC str = do (FC file (l, c) _) <- getFC

289

287

290-- | Parses a reserved identifier

288-- | Parses a reserved identifier

291reserved :: MonadicParsing m => String -> m ()

289reserved :: MonadicParsing m => String -> m ()

292−reserved name = Tok.token $ P.try $ do

290+reserved name = token $ P.try $ do

293 P.string name

291 P.string name

294 P.notFollowedBy (P.satisfy isAlphaNum <|> P.oneOf "_'.") <?> "end of " ++ name

292 P.notFollowedBy (P.satisfy isAlphaNum <|> P.oneOf "_'.") <?> "end of " ++ name

295

293

@@ -307,7 +305,7 @@ reservedHL str = reservedFC str >>= flip highlightP AnnKeyword

307-- Taken from Parsec (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007

305-- Taken from Parsec (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007

308-- | Parses a reserved operator

306-- | Parses a reserved operator

309reservedOp :: MonadicParsing m => String -> m ()

307reservedOp :: MonadicParsing m => String -> m ()

310−reservedOp name = Tok.token $ P.try $

308+reservedOp name = token $ P.try $

311 do string name

309 do string name

312 P.notFollowedBy operatorLetter <?> ("end of " ++ show name)

310 P.notFollowedBy operatorLetter <?> ("end of " ++ show name)

313

311

@@ -403,7 +401,7 @@ invalidOperators = [":", "=>", "->", "<-", "=", "?=", "|", "**", "==>", "\\", "%

403

401

404-- | Parses an operator

402-- | Parses an operator

405symbolicOperator :: MonadicParsing m => m String

403symbolicOperator :: MonadicParsing m => m String

406−symbolicOperator = do op <- Tok.token . some $ operatorLetter

404+symbolicOperator = do op <- token . some $ operatorLetter

407 when (op `elem` (invalidOperators ++ commentMarkers)) $

405 when (op `elem` (invalidOperators ++ commentMarkers)) $

408 fail $ op ++ " is not a valid operator"

406 fail $ op ++ " is not a valid operator"

409 return op

407 return op