cfb0cd7 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Merge pull request #4639 from jacereda/megaparsec7

Megaparsec7 again

commitcfb0cd7b21c0e1386ca9444a93ce0fc7547fe116 authorNiklas Larsson <metaniklas@gmail.com> dateMon 14 Jan 2019, 02:31 (8 years ago) parentf445c51 18c98cb

10 files changed+42−30

compare with master

unifiedsplit

idris.cabal+4−3 src/Idris/Output.hs+4−3 src/Idris/Package/Parser.hs+1−2 src/Idris/Parser.hs−1 src/Idris/Parser/Expr.hs+2−2 src/Idris/Parser/Helpers.hs+1−1 src/Idris/Parser/Ops.hs+1−2 src/Idris/Parser/Stack.hs+20−9 src/Idris/REPL/Parser.hs+5−6 stack.yaml+4−1

idris.cabal+4−3

@@ -100,7 +100,7 @@ source-repository head

100100

101101custom-setup

102102 setup-depends:

103− Cabal >= 1.10 && <2.3,

103+ Cabal >= 1.10 && <2.5,

104104 base >= 4 && <5,

105105 directory,

106106 filepath,

@@ -289,10 +289,11 @@ Library

289289 , fingertree >= 0.1.4.1 && < 0.2

290290 , haskeline >= 0.7 && < 0.8

291291 , ieee754 >= 0.7 && < 0.9

292− , megaparsec >= 6.2 && < 7

292+ , megaparsec >= 7.0.4 && < 8

293293 , mtl >= 2.1 && < 2.3

294294 , network >= 2.7 && < 2.9

295295 , optparse-applicative >= 0.13 && < 0.15

296+ , parser-combinators >= 1.0.0

296297 , pretty < 1.2

297298 , process < 1.7

298299 , regex-tdfa >= 1.2

@@ -307,7 +308,7 @@ Library

307308 , utf8-string < 1.1

308309 , vector < 0.13

309310 , vector-binary-instances < 0.3

310− , zip-archive > 0.2.3.5 && < 0.4

311+ , zip-archive > 0.2.3.5 && < 0.5

311312 , fsnotify >= 0.2 && < 2.2

312313 , async < 2.3

313314

src/Idris/Output.hs+4−3

@@ -75,9 +75,10 @@ instance Message SimpleWarning where

7575formatMessage :: Message w => w -> Idris OutputDoc

7676formatMessage w = do

7777 i <- getIState

78− maybeSource <- case messageSource w of

79− Just src -> pure (Just src)

80− Nothing -> readSource fc

78+ rs <- readSource fc

79+ let maybeSource = case rs of

80+ Just src -> Just src

81+ Nothing -> messageSource w

8182 let maybeFormattedSource = maybeSource >>= layoutSource fc (regions (idris_highlightedRegions i))

8283 return $ layoutMessage (layoutFC fc) maybeFormattedSource (messageText w)

8384 where

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

@@ -27,14 +27,13 @@ import System.Exit

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

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

2929import qualified Text.Megaparsec as P

30−import qualified Text.Megaparsec.Char as P

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

3231

3332type PParser = Parser PkgDesc

3433

3534parseDesc :: FilePath -> IO PkgDesc

3635parseDesc fp = do

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

36+ unless (takeExtension fp == ".ipkg") $ do

3837 putStrLn $ unwords ["The presented iPKG file does not have a '.ipkg' extension:", show fp]

3938 exitWith (ExitFailure 1)

4039 res <- doesFileExist fp

src/Idris/Parser.hs−1

@@ -60,7 +60,6 @@ import qualified System.Directory as Dir (doesFileExist, getModificationTime,

6060import System.FilePath

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

6262import qualified Text.Megaparsec as P

63−import qualified Text.Megaparsec.Char as P

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

6564

6665{-

src/Idris/Parser/Expr.hs+2−2

@@ -20,6 +20,7 @@ import Prelude hiding (pi)

2020import Control.Applicative

2121import Control.Arrow (left)

2222import Control.Monad

23+import qualified Control.Monad.Combinators.Expr as P

2324import Control.Monad.State.Strict

2425import Data.Function (on)

2526import Data.List

@@ -27,7 +28,6 @@ import Data.Maybe

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

2829import qualified Text.Megaparsec as P

2930import qualified Text.Megaparsec.Char as P

30−import qualified Text.Megaparsec.Expr as P

3131

3232-- | Allow implicit type declarations

3333allowImp :: SyntaxInfo -> SyntaxInfo

@@ -1406,7 +1406,7 @@ VerbatimString_t ::=

14061406 -}

14071407verbatimStringLiteral :: Parsing m => m String

14081408verbatimStringLiteral = token $ do P.try $ string "\"\"\""

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

1409+ str <- P.manyTill P.anySingle $ P.try (string "\"\"\"")

14101410 moreQuotes <- P.many $ P.char '"'

14111411 return $ str ++ moreQuotes

14121412

src/Idris/Parser/Helpers.hs+1−1

@@ -397,7 +397,7 @@ popIndent = do ist <- get

397397

398398-- | Gets current indentation

399399indent :: Parsing m => m Int

400−indent = P.unPos . P.sourceColumn <$> P.getPosition

400+indent = P.unPos . P.sourceColumn <$> P.getSourcePos

401401

402402-- | Gets last indentation

403403lastIndent :: (MonadState IState m) => m Int

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

@@ -17,14 +17,13 @@ import Prelude hiding (pi)

1717

1818import Control.Applicative

1919import Control.Monad

20+import qualified Control.Monad.Combinators.Expr as P

2021import Control.Monad.State.Strict

2122import Data.Char (isAlpha)

2223import Data.List

2324import Data.List.NonEmpty (fromList)

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

2526import qualified Text.Megaparsec as P

26−import qualified Text.Megaparsec.Char as P

27−import qualified Text.Megaparsec.Expr as P

2827

2928-- | Creates table for fixity declarations to build expression parser

3029-- using pre-build and user-defined operator/fixity declarations

src/Idris/Parser/Stack.hs+20−9

@@ -57,23 +57,34 @@ type Parsing m = (P.MonadParsec Void String m, MonadWriter FC m)

5757runparser :: Parser st res -> st -> String -> String -> Either ParseError res

5858runparser p i inputname s =

5959 case P.parse (runWriterT (evalStateT p i)) inputname s of

60− Left err -> Left $ ParseError s err

60+ Left err -> Left $ ParseError err

6161 Right v -> Right $ fst v

6262

6363{- * Parse errors -}

6464

65−data ParseError = ParseError String (P.ParseError (P.Token String) Void)

65+newtype ParseError = ParseError { unParseError :: P.ParseErrorBundle String Void }

66+

67+parseError :: ParseError -> P.ParseError String Void

68+parseError = NonEmpty.head . P.bundleErrors . unParseError

69+

70+parseErrorPosState :: ParseError -> P.PosState String

71+parseErrorPosState = P.bundlePosState . unParseError

72+

73+parseErrorOffset :: ParseError -> Int

74+parseErrorOffset = P.errorOffset . parseError

6675

6776instance Message ParseError where

68− messageExtent (ParseError _ err) = sourcePositionFC pos

77+ messageExtent err = sourcePositionFC pos

78+ where

79+ (pos, _) = P.reachOffsetNoLine (parseErrorOffset err) (parseErrorPosState err)

80+ messageText = PP.text . init . P.parseErrorTextPretty . parseError

81+ messageSource err = Just sline

6982 where

70− (pos NonEmpty.:| _) = P.errorPos err

71− messageText (ParseError _ err) = PP.text . init . P.parseErrorTextPretty $ err

72− messageSource (ParseError src _) = Just src

83+ (_, sline, _) = P.reachOffset (parseErrorOffset err) (parseErrorPosState err)

7384

7485-- | A fully formatted parse error, with caret and bar, etc.

75−prettyError :: ParseError -> String

76−prettyError (ParseError s err) = P.parseErrorPretty' s err

86+prettyError :: ParseError -> String

87+prettyError = P.errorBundlePretty . unParseError

7788

7889{- * Mark and restore -}

7990

@@ -104,7 +115,7 @@ sourcePositionFC (P.SourcePos name line column) =

104115-- This is useful when the position is needed in a way unrelated to the

105116-- heirarchy of parsers. Prefer using @withExtent@ and friends.

106117getFC :: Parsing m => m FC

107−getFC = sourcePositionFC <$> P.getPosition

118+getFC = sourcePositionFC <$> P.getSourcePos

108119

109120-- | Add an extent (widen) our current parsing context.

110121addExtent :: MonadWriter FC m => FC -> m ()

src/Idris/REPL/Parser.hs+5−6

@@ -33,7 +33,6 @@ import Data.List.Split (splitOn)

3333import System.Console.ANSI (Color(..))

3434import System.FilePath ((</>))

3535import qualified Text.Megaparsec as P

36−import qualified Text.Megaparsec.Char as P

3736

3837parseCmd :: IState -> String -> String -> Either IP.ParseError (Either String Command)

3938parseCmd i inputname = IP.runparser pCmd i inputname . trim

@@ -68,7 +67,7 @@ parserCommandsForHelp =

6867 , nameArgCmd ["miss", "missing"] Missing "Show missing clauses"

6968 , (["doc"], NameArg, "Show internal documentation", cmd_doc)

7069 , (["mkdoc"], NamespaceArg, "Generate IdrisDoc for namespace(s) and dependencies"

71− , genArg "namespace" (P.many P.anyChar) MakeDoc)

70+ , genArg "namespace" (P.many P.anySingle) MakeDoc)

7271 , (["apropos"], SeqArgs (OptionalArg PkgArgs) NameArg, " Search names, types, and documentation"

7372 , cmd_apropos)

7473 , (["s", "search"], SeqArgs (OptionalArg PkgArgs) ExprArg

@@ -198,7 +197,7 @@ pCmd = P.choice [ do c <- cmd names; parser c

198197 where nop = do P.eof; return (Right NOP)

199198 unrecognized = do

200199 IP.lchar ':'

201− cmd <- P.many P.anyChar

200+ cmd <- P.many P.anySingle

202201 let cmd' = takeWhile (/=' ') cmd

203202 return (Left $ "Unrecognized command: " ++ cmd')

204203

@@ -260,7 +259,7 @@ nameArg = genArg "name" IP.name

260259fnNameArg = genArg "functionname" IP.fnName

261260

262261strArg :: (String -> Command) -> String -> IP.IdrisParser (Either String Command)

263−strArg = genArg "string" (P.many P.anyChar)

262+strArg = genArg "string" (P.many P.anySingle)

264263

265264moduleArg :: (FilePath -> Command) -> String -> IP.IdrisParser (Either String Command)

266265moduleArg = genArg "module" (fmap toPath IP.identifier)

@@ -342,7 +341,7 @@ cmd_execute name = do

342341

343342cmd_dynamic :: String -> IP.IdrisParser (Either String Command)

344343cmd_dynamic name = do

345− let optArg = do l <- P.many P.anyChar

344+ let optArg = do l <- P.many P.anySingle

346345 if (l /= "")

347346 then return $ Right (DynamicLink l)

348347 else return $ Right ListDynamic

@@ -440,7 +439,7 @@ cmd_unlet name = Right . Undefine <$> P.many IP.name

440439cmd_loadto :: String -> IP.IdrisParser (Either String Command)

441440cmd_loadto name = do

442441 toline <- fromInteger <$> IP.natural

443− f <- P.many P.anyChar

442+ f <- P.many P.anySingle

444443 return (Right (Load f (Just toline)))

445444

446445cmd_colour :: String -> IP.IdrisParser (Either String Command)

stack.yaml+4−1

@@ -4,7 +4,10 @@ resolver: lts-12.21

44packages:

55 - location: .

7−extra-deps: []

7+extra-deps:

8+ - megaparsec-7.0.4

9+ - parser-combinators-1.0.0

10+

811

912flags:

1013 idris: