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

git.iko.soy/Idris-dev

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

commit1764f7fbd4017595944ffe2022b6050813c39f94 authorJason Felice <jason.m.felice@gmail.com> dateTue 31 Oct 2017, 20:58 (9 years ago) parentc112ebc

3 files changed+23−31

compare with master

unifiedsplit

src/Idris/Package/Parser.hs+4−9 src/Idris/Parser/Expr.hs+8−9 src/Idris/Parser/Helpers.hs+11−13

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

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

1313import Idris.Package.Common

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

1515 lchar, packageName, parseErrorDoc, reserved,

16− runparser, someSpace')

16+ runparser, someSpace', stringLiteral)

1717

1818import Control.Applicative

1919import Control.Monad.State.Strict

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

2121import System.Directory (doesFileExist)

2222import System.Exit

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

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

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

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

2726import qualified Text.Megaparsec as P

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

2928

3029type PParser = StateT PkgDesc IdrisInnerParser

3130

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

33− someSpace = someSpace'

34−

35−

3631parseDesc :: FilePath -> IO PkgDesc

3732parseDesc fp = do

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

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

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

7368 -- it will also accept hyphens

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

75− filename <- stringLiteral <* someSpace'

70+ filename <- fst <$> stringLiteral

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

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

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

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

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

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

119114 <|> 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 })

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

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

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

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

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

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

135130 <|> 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 })

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

138133 <|> 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

2525import Data.Function (on)

2626import Data.List

2727import Data.Maybe

28−import qualified Text.Parser.Token as Tok

2928import Text.Parser.Expression

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

3130import qualified Text.Megaparsec as P

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

12851284listExpr :: SyntaxInfo -> IdrisParser PTerm

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

12871286 lchar '['; fc <- getFC;

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

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

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

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

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

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

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

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

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

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

14691468@

14701469 -}

14711470verbatimStringLiteral :: IdrisParser (String, FC)

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

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

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

1475− (FC _ _ end) <- getFC

1476− return (str, FC f start end)

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

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

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

1474+ (FC _ _ end) <- getFC

1475+ return (str, FC f start end)

14771476

14781477{- | Parses a static modifier

14791478

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

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

3434import System.FilePath

3535import qualified Text.Parser.Char

3636import qualified Text.Parser.Combinators

37−import qualified Text.Parser.Token as Tok

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

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

4039import qualified Text.Megaparsec as P

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

5554parseErrorDoc = PP.string . parseErrorPretty

5655

5756-- | 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)

5958

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

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

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

7271 char = P.char

7372 string = P.string

7473

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

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

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

7776 -- See Issue #1594

7877 r <- p

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

8079 whiteSpace

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

8281

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

84− someSpace = someSpace'

85− token p = p <* whiteSpace

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

83+token p = p <* whiteSpace

8684

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

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

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

227225whiteSpace = someSpace' <|> pure ()

228226

229227-- | Parses a string literal

230−stringLiteral :: IdrisParser (String, FC)

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

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

232230

233231-- | Parses a char literal

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

258256 ]

259257

260258identifierOrReserved :: MonadicParsing m => m String

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

259+identifierOrReserved = token $ P.try $ do

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

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

264262 return $ c : cs

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

271269

272270-- | Parses a character as a token

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

274−lchar = Tok.token . P.char

272+lchar = token . P.char

275273

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

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

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

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

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

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

281279

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

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

289287

290288-- | Parses a reserved identifier

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

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

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

293291 P.string name

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

295293

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

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

308306-- | Parses a reserved operator

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

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

308+reservedOp name = token $ P.try $

311309 do string name

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

313311

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

403401

404402-- | Parses an operator

405403symbolicOperator :: MonadicParsing m => m String

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

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

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

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

409407 return op