cfb0cd7 · Idris-dev · git.iko.soy

idris.cabal+4−3

compare with master

unifiedsplit

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

100

101custom-setup

102 setup-depends:

103− Cabal >= 1.10 && <2.3,

103+ Cabal >= 1.10 && <2.5,

104 base >= 4 && <5,

105 directory,

106 filepath,

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

289 , fingertree >= 0.1.4.1 && < 0.2

290 , haskeline >= 0.7 && < 0.8

291 , ieee754 >= 0.7 && < 0.9

292− , megaparsec >= 6.2 && < 7

292+ , megaparsec >= 7.0.4 && < 8

293 , mtl >= 2.1 && < 2.3

294 , network >= 2.7 && < 2.9

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

296+ , parser-combinators >= 1.0.0

296 , pretty < 1.2

297 , pretty < 1.2

297 , process < 1.7

298 , process < 1.7

298 , regex-tdfa >= 1.2

299 , regex-tdfa >= 1.2

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

307 , utf8-string < 1.1

308 , utf8-string < 1.1

308 , vector < 0.13

309 , vector < 0.13

309 , vector-binary-instances < 0.3

310 , vector-binary-instances < 0.3

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

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

311 , fsnotify >= 0.2 && < 2.2

312 , fsnotify >= 0.2 && < 2.2

312 , async < 2.3

313 , async < 2.3

313

314

src/Idris/Output.hs+4−3

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

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

76formatMessage w = do

77 i <- getIState

78− maybeSource <- case messageSource w of

78+ rs <- readSource fc

79+ let maybeSource = case rs of

79− Just src -> pure (Just src)

80+ Just src -> Just src

80− Nothing -> readSource fc

81+ Nothing -> messageSource w

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

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

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

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

83 where

84 where

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

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

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

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

29import qualified Text.Megaparsec as P

30−import qualified Text.Megaparsec.Char as P

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

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

32

31

33type PParser = Parser PkgDesc

32type PParser = Parser PkgDesc

34

33

35parseDesc :: FilePath -> IO PkgDesc

34parseDesc :: FilePath -> IO PkgDesc

36parseDesc fp = do

35parseDesc fp = do

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

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

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

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

39 exitWith (ExitFailure 1)

38 exitWith (ExitFailure 1)

40 res <- doesFileExist fp

39 res <- doesFileExist fp

src/Idris/Parser.hs−1

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

60import System.FilePath

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

62import qualified Text.Megaparsec as P

63−import qualified Text.Megaparsec.Char as P

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

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

65

64

66{-

65{-

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

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

20import Control.Applicative

21import Control.Arrow (left)

22import Control.Monad

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

23import Control.Monad.State.Strict

24import Control.Monad.State.Strict

24import Data.Function (on)

25import Data.Function (on)

25import Data.List

26import Data.List

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

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

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

28import qualified Text.Megaparsec as P

29import qualified Text.Megaparsec as P

29import qualified Text.Megaparsec.Char as P

30import qualified Text.Megaparsec.Char as P

30−import qualified Text.Megaparsec.Expr as P

31

32-- | Allow implicit type declarations

33allowImp :: SyntaxInfo -> SyntaxInfo

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

1406 -}

1407verbatimStringLiteral :: Parsing m => m String

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

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

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

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

1411 return $ str ++ moreQuotes

1412

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

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

397

398-- | Gets current indentation

399indent :: Parsing m => m Int

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

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

401

402-- | Gets last indentation

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

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

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

17

18import Control.Applicative

19import Control.Monad

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

20import Control.Monad.State.Strict

21import Control.Monad.State.Strict

21import Data.Char (isAlpha)

22import Data.Char (isAlpha)

22import Data.List

23import Data.List

23import Data.List.NonEmpty (fromList)

24import Data.List.NonEmpty (fromList)

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

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

25import qualified Text.Megaparsec as P

26import qualified Text.Megaparsec as P

26−import qualified Text.Megaparsec.Char as P

27−import qualified Text.Megaparsec.Expr as P

28

27

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

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

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

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

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

58runparser p i inputname s =

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

60− Left err -> Left $ ParseError s err

60+ Left err -> Left $ ParseError err

61 Right v -> Right $ fst v

62

63{- * Parse errors -}

64

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

66+

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

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

66

75

67instance Message ParseError where

76instance 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

69 where

82 where

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

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

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

72− messageSource (ParseError src _) = Just src

73

84

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

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

75−prettyError :: ParseError -> String

86+prettyError :: ParseError -> String

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

87+prettyError = P.errorBundlePretty . unParseError

77

88

78{- * Mark and restore -}

89{- * Mark and restore -}

79

90

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

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

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

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

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

106getFC :: Parsing m => m FC

117getFC :: Parsing m => m FC

107−getFC = sourcePositionFC <$> P.getPosition

118+getFC = sourcePositionFC <$> P.getSourcePos

108

119

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

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

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

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

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

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

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

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

35import qualified Text.Megaparsec as P

36−import qualified Text.Megaparsec.Char as P

37

36

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

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

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

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

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

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

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

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

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

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

69 , (["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)

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

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

73 , cmd_apropos)

72 , cmd_apropos)

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

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

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

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

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

199 unrecognized = do

198 unrecognized = do

200 IP.lchar ':'

199 IP.lchar ':'

201− cmd <- P.many P.anyChar

200+ cmd <- P.many P.anySingle

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

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

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

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

204

203

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

260fnNameArg = genArg "functionname" IP.fnName

259fnNameArg = genArg "functionname" IP.fnName

261

260

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

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

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

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

264

263

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

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

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

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

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

342

341

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

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

344cmd_dynamic name = do

343cmd_dynamic name = do

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

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

346 if (l /= "")

345 if (l /= "")

347 then return $ Right (DynamicLink l)

346 then return $ Right (DynamicLink l)

348 else return $ Right ListDynamic

347 else return $ Right ListDynamic

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

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

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

441cmd_loadto name = do

440cmd_loadto name = do

442 toline <- fromInteger <$> IP.natural

441 toline <- fromInteger <$> IP.natural

443− f <- P.many P.anyChar

442+ f <- P.many P.anySingle

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

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

445

444

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

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

stack.yaml+4−1

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

4packages:

5 - location: .

6

7−extra-deps: []

7+extra-deps:

8+ - megaparsec-7.0.4

9+ - parser-combinators-1.0.0

10+

8

11

9flags:

12flags:

10 idris:

13 idris: