Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • ghc/head.hackage
  • RyanGlScott/head.hackage
  • vaibhavsagar/head.hackage
  • phadej/head.hackage
  • jessoune29/head.hackage
  • alanz/head.hackage
  • clint/head.hackage
  • osa1/head.hackage
  • supersven/head.hackage
  • fendor/head.hackage
  • hsyl20/head.hackage
  • adinapoli/head.hackage
  • alexbiehl/head.hackage
  • mimi.vx/head.hackage
  • Kleidukos/head.hackage
  • wz1000/head.hackage
  • alinab/head.hackage
  • teo/head.hackage
  • duog/head.hackage
  • sheaf/head.hackage
  • expipiplus1/head.hackage
  • drsooch/head.hackage
  • tobias/head.hackage
  • brandonchinn178/head.hackage
  • mpickering/hooks-setup-testing
  • Mikolaj/head.hackage
  • RandomMoonwalker/head.hackage
  • facundominguez/head.hackage
  • trac-fizzixnerd/head.hackage
  • neil.mayhew/head.hackage
  • jappeace/head.hackage
31 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 858 additions and 1652 deletions
patches/Agda-2.7.0.1.patch 0 → 100644
View file @ 4847b274
diff --git a/Agda.cabal b/Agda.cabal
index 9a0863c..cc2f024 100644
--- a/Agda.cabal
+++ b/Agda.cabal
@@ -1,7 +1,7 @@
cabal-version: 2.4
name: Agda
version: 2.7.0.1
-build-type: Custom
+build-type: Simple
license: MIT
license-file: LICENSE
copyright: (c) 2005-2024 The Agda Team.
diff --git a/Setup.hs b/Setup.hs
deleted file mode 100644
index 7064a95..0000000
--- a/Setup.hs
+++ /dev/null
@@ -1,235 +0,0 @@
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-import Data.Functor ( (<&>) )
-import Data.List ( intercalate )
-import Data.Maybe ( catMaybes )
-
-import Distribution.Simple
-import Distribution.Simple.LocalBuildInfo
-import Distribution.Simple.Setup
-import Distribution.Simple.BuildPaths (exeExtension)
-import Distribution.PackageDescription
-import Distribution.System ( buildPlatform )
-
-import System.FilePath
-import System.Directory (doesFileExist, makeAbsolute, removeFile)
-import System.Environment (getEnvironment)
-import System.Process
-import System.Exit
-import System.IO
-import System.IO.Error (isDoesNotExistError)
-
-import Control.Monad
-import Control.Exception
-
-main :: IO ()
-main = defaultMainWithHooks userhooks
-
-userhooks :: UserHooks
-userhooks = simpleUserHooks
- { copyHook = copyHook'
- , instHook = instHook'
- }
-
--- Install and copy hooks are default, but amended with .agdai files in data-files.
-instHook' :: PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO ()
-instHook' pd lbi hooks flags = instHook simpleUserHooks pd' lbi hooks flags where
- pd' = pd { dataFiles = concatMap (expandAgdaExt pd) $ dataFiles pd }
-
--- Andreas, 2020-04-25, issue #4569: defer 'generateInterface' until after
--- the library has been copied to a destination where it can be found.
--- @cabal build@ will likely no longer produce the .agdai files, but @cabal install@ does.
-copyHook' :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ()
-copyHook' pd lbi hooks flags = do
- -- Copy library and executable etc.
- copyHook simpleUserHooks pd lbi hooks flags
- if wantInterfaces flags && not (skipInterfaces lbi) then do
- -- Generate .agdai files.
- success <- generateInterfaces pd lbi
- -- Copy again, now including the .agdai files.
- when success $ copyHook simpleUserHooks pd' lbi hooks flags
- else
- putStrLn "Skipping generation of Agda core library interface files"
- where
- pd' = pd
- { dataFiles = concatMap (expandAgdaExt pd) $ dataFiles pd
- -- Andreas, 2020-04-25, issue #4569:
- -- I tried clearing some fields to avoid copying again.
- -- However, cabal does not like me messing with the PackageDescription.
- -- Clearing @library@ or @executables@ leads to internal errors.
- -- Thus, we just copy things again. Not a terrible problem.
- -- , library = Nothing
- -- , executables = []
- -- , subLibraries = []
- -- , foreignLibs = []
- -- , testSuites = []
- -- , benchmarks = []
- -- , extraSrcFiles = []
- -- , extraTmpFiles = []
- -- , extraDocFiles = []
- }
-
--- We only want to write interfaces if installing the executable.
--- If we're installing *just* the library, the interface files are not needed
--- and, most importantly, the executable will not be available to be run (cabal#10235)
-wantInterfaces :: CopyFlags -> Bool
-wantInterfaces _flags = do
-#if MIN_VERSION_Cabal(3,11,0)
- any isAgdaExe (copyArgs _flags)
- where
- isAgdaExe "exe:agda" = True
- isAgdaExe _ = False
-#else
- True
-#endif
-
--- Used to add .agdai files to data-files
-expandAgdaExt :: PackageDescription -> FilePath -> [FilePath]
-expandAgdaExt pd = \ fp ->
- -- N.B. using lambda here so that @expandAgdaExt pd@ can be partially evaluated.
- if takeExtension fp == ".agda" then [ fp, iFile fp ] else [ fp ]
- where
- iFile = toIFile pd
-
-version :: PackageDescription -> String
-version = intercalate "." . map show . versionNumbers . pkgVersion . package
-
--- | This returns @lib/prim@.
---
-projectRoot :: PackageDescription -> FilePath
-projectRoot pd = takeDirectory agdaLibFile
- where
- [agdaLibFile] = filter ((".agda-lib" ==) . takeExtension) $ dataFiles pd
-
--- | Turns e.g. @lib/prim/Agda/Primitive.agda@
--- into @lib/prim/_build/2.7.0/agda/Agda/Primitive.agdai@.
---
--- An absolute path will be returned unchanged.
-toIFile ::
- PackageDescription
- -> FilePath -- ^ Should be a relative path.
- -> FilePath -- ^ Then this is also a relative path.
-toIFile pd = (buildDir </>) . fileName
- where
- root = projectRoot pd
- -- e.g. root = "lib/prim"
- buildDir = root </> "_build" </> version pd </> "agda"
- -- e.g. buildDir = "lib/prim/_build/2.7.0/agda"
- fileName file = makeRelative root $ replaceExtension file ".agdai"
- -- e.g. fileName "lib/prim/Agda/Primitive.agda" = "Agda/Primitive.agdai"
-
--- Andreas, 2019-10-21, issue #4151:
--- skip the generation of interface files with program suffix "-quicker"
-skipInterfaces :: LocalBuildInfo -> Bool
-skipInterfaces lbi = fromPathTemplate (progSuffix lbi) == "-quicker"
-
--- | Returns 'True' if call to Agda executes without error.
---
-generateInterfaces :: PackageDescription -> LocalBuildInfo -> IO Bool
-generateInterfaces pd lbi = do
-
- putStrLn "Generating Agda core library interface files..."
-
- -- for debugging, these are examples how you can inspect the flags...
- -- print $ flagAssignment lbi
- -- print $ fromPathTemplate $ progSuffix lbi
-
- -- then...
- let bdir = buildDir lbi
- agda = bdir </> "agda" </> "agda" <.> agdaExeExtension
-
- -- We should be in the current directory root of the cabal package
- -- and data-files reside in src/data relative to this.
- --
- ddir <- makeAbsolute $ "src" </> "data"
-
- -- The Agda.Primitive* and Agda.Builtin* modules.
- let builtins = filter ((== ".agda") . takeExtension) (dataFiles pd)
-
- -- The absolute filenames of their interfaces.
- let interfaces = map ((ddir </>) . toIFile pd) builtins
-
- -- Remove all existing .agdai files.
- forM_ interfaces $ \ fp -> removeFile fp `catch` \ e ->
- unless (isDoesNotExistError e) $ throwIO e
-
- -- Type-check all builtin modules (in a single Agda session to take
- -- advantage of caching).
- let agdaDirEnvVar = "Agda_datadir"
- let agdaArgs =
- [ "--interaction"
- , "--interaction-exit-on-error"
- , "-Werror"
- , "-v0"
- ]
- let loadBuiltinCmds = concat
- [ [ cmd ("Cmd_load " ++ f ++ " []")
- , cmd "Cmd_no_metas"
- -- Fail if any meta-variable is unsolved.
- ]
- | b <- builtins
- , let f = show (ddir </> b)
- cmd c = "IOTCM " ++ f ++ " None Indirect (" ++ c ++ ")"
- ]
- let callLines = concat
- [ [ unwords $ concat
- [ [ concat [ agdaDirEnvVar, "=", ddir ] ]
- , [ agda ]
- , agdaArgs
- , [ "<<EOF" ]
- ]
- ]
- , loadBuiltinCmds
- , [ "EOF" ]
- ]
- let onIOError (e :: IOException) = False <$ do
- warn $ concat
- [ [ "*** Could not generate Agda library interface files."
- , "*** Reason:"
- , show e
- , "*** The attempted call to Agda was:"
- ]
- , callLines
- ]
- env <- getEnvironment
- handle onIOError $ do
-
- -- Generate interface files via a call to Agda.
- readCreateProcess
- (proc agda agdaArgs)
- { delegate_ctlc = True
- -- Make Agda look for data files in a
- -- certain place.
- , env = Just ((agdaDirEnvVar, ddir) : env)
- }
- (unlines loadBuiltinCmds)
-
- -- Check whether all interface files have been generated.
- missing <- catMaybes <$> forM interfaces \ f ->
- doesFileExist f <&> \case
- True -> Nothing
- False -> Just f
-
- -- Warn if not all interface files have been generated, but don't crash.
- -- This might help with issue #7455.
- let success = null missing
- unless success $ warn $ concat
- [ [ "*** Agda failed to generate the following library interface files:" ]
- , missing
- ]
- return success
-
-warn :: [String] -> IO ()
-warn msgs = putStr $ unlines $ concat
- [ [ "*** Warning!" ]
- , msgs
- , [ "*** Ignoring error, continuing installation..." ]
- ]
-
-
-
-agdaExeExtension :: String
-agdaExeExtension = exeExtension buildPlatform
patches/Cabal-2.4.1.0.patch
View file @ 4847b274
diff --git a/Distribution/Simple/PreProcess.hs b/Distribution/Simple/PreProcess.hs
index 4933028..2af2316 100644
--- a/Distribution/Simple/PreProcess.hs
+++ b/Distribution/Simple/PreProcess.hs
@@ -122,6 +122,12 @@ data PreProcessor = PreProcessor {
-- preprocessor's output name format.
type PreProcessorExtras = FilePath -> IO [FilePath]
+-- | A newtype around 'PreProcessorExtras', useful for storing
+-- 'PreProcessorExtras' inside of another type constructor (e.g., a list)
+-- without impredicativity (recall that the 'IO' type, which is contained in
+-- 'PreProcessorExtras', is a synonym for @'HasCallStack' => Prelude.IO@, which
+-- is a polymorphic type).
+newtype WrappedPreProcessorExtras = WrapPPE { unWrapPPE :: PreProcessorExtras }
mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
@@ -694,8 +700,8 @@ knownSuffixHandlers =
]
-- |Standard preprocessors with possible extra C sources: c2hs, hsc2hs.
-knownExtrasHandlers :: [ PreProcessorExtras ]
-knownExtrasHandlers = [ ppC2hsExtras, ppHsc2hsExtras ]
+knownExtrasHandlers :: [ WrappedPreProcessorExtras ]
+knownExtrasHandlers = [ WrapPPE ppC2hsExtras, WrapPPE ppHsc2hsExtras ]
-- | Find any extra C sources generated by preprocessing that need to
-- be added to the component (addresses issue #238).
@@ -732,7 +738,7 @@ preprocessExtras verbosity comp lbi = case comp of
pp :: FilePath -> IO [FilePath]
pp dir = (map (dir </>) . filter not_sub . concat)
<$> for knownExtrasHandlers
- (withLexicalCallStack (\f -> f dir))
+ (withLexicalCallStack (\f -> f dir) . unWrapPPE)
-- TODO: This is a terrible hack to work around #3545 while we don't
-- reorganize the directory layout. Basically, for the main
-- library, we might accidentally pick up autogenerated sources for
diff --git a/Distribution/Compat/Prelude.hs b/Distribution/Compat/Prelude.hs
index d032825..ecffbbc 100644
--- a/Distribution/Compat/Prelude.hs
+++ b/Distribution/Compat/Prelude.hs
@@ -140,7 +140,7 @@ import qualified Text.PrettyPrint as Disp
import qualified Prelude as OrigPrelude
import Distribution.Compat.Stack
-type IO a = WithCallStack (OrigPrelude.IO a)
+type IO a = OrigPrelude.IO a
type NoCallStackIO a = OrigPrelude.IO a
-- | New name for 'Text.PrettyPrint.<>'
diff --git a/Distribution/Compat/ReadP.hs b/Distribution/Compat/ReadP.hs
index 1f5a989..e314592 100644
--- a/Distribution/Compat/ReadP.hs
+++ b/Distribution/Compat/ReadP.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
-----------------------------------------------------------------------------
-- |
@@ -113,7 +114,9 @@ instance Monad (P s) where
(Result x p) >>= k = k x `mplus` (p >>= k)
(Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
+#endif
instance Fail.MonadFail (P s) where
fail _ = Fail
@@ -172,7 +175,9 @@ instance s ~ Char => Alternative (Parser r s) where
instance Monad (Parser r s) where
return = pure
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
+#endif
R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
instance Fail.MonadFail (Parser r s) where
diff --git a/Distribution/FieldGrammar/FieldDescrs.hs b/Distribution/FieldGrammar/FieldDescrs.hs
index 4bd50d4..ce85fc0 100644
--- a/Distribution/FieldGrammar/FieldDescrs.hs
+++ b/Distribution/FieldGrammar/FieldDescrs.hs
@@ -44,7 +44,7 @@ fieldDescrPretty (F m) fn = pPretty <$> Map.lookup fn m
-- | Lookup a field value parser.
fieldDescrParse :: P.CabalParsing m => FieldDescrs s a -> String -> Maybe (s -> m s)
-fieldDescrParse (F m) fn = pParse <$> Map.lookup fn m
+fieldDescrParse (F m) fn = (\f -> pParse f) <$> Map.lookup fn m
fieldDescrsToList
:: P.CabalParsing m
diff --git a/Distribution/ParseUtils.hs b/Distribution/ParseUtils.hs
index 0e79049..f4b805c 100644
--- a/Distribution/ParseUtils.hs
+++ b/Distribution/ParseUtils.hs
@@ -19,6 +19,7 @@
-- This module is meant to be local-only to Distribution...
{-# OPTIONS_HADDOCK hide #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
module Distribution.ParseUtils (
LineNo, PError(..), PWarning(..), locatedErrorMsg, syntaxError, warning,
@@ -107,7 +108,9 @@ instance Monad ParseResult where
ParseOk ws x >>= f = case f x of
ParseFailed err -> ParseFailed err
ParseOk ws' x' -> ParseOk (ws'++ws) x'
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
+#endif
instance Fail.MonadFail ParseResult where
fail s = ParseFailed (FromString s Nothing)
diff --git a/Distribution/Parsec/Class.hs b/Distribution/Parsec/Class.hs
index d65ea54..d182360 100644
--- a/Distribution/Parsec/Class.hs
+++ b/Distribution/Parsec/Class.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -55,7 +56,7 @@ class Parsec a where
--
-- * knows @cabal-version@ we work with
--
-class (P.CharParsing m, MonadPlus m) => CabalParsing m where
+class (P.CharParsing m, MonadPlus m, Fail.MonadFail m) => CabalParsing m where
parsecWarning :: PWarnType -> String -> m ()
parsecHaskellString :: m String
@@ -116,7 +117,9 @@ instance Monad ParsecParser where
(>>) = (*>)
{-# INLINE (>>) #-}
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
+#endif
instance MonadPlus ParsecParser where
mzero = empty
diff --git a/Distribution/Parsec/Lexer.hs b/Distribution/Parsec/Lexer.hs
index 64f5222..20781a4 100644
--- a/Distribution/Parsec/Lexer.hs
+++ b/Distribution/Parsec/Lexer.hs
@@ -230,35 +230,35 @@ alex_action_0 = \_ len _ -> do
when (len /= 0) $ addWarning LexWarningBOM
setStartCode bol_section
lexToken
-
-alex_action_1 = \_pos len inp -> checkWhitespace len inp >> adjustPos retPos >> lexToken
+
+alex_action_1 = \_pos len inp -> checkWhitespace len inp >> adjustPos retPos >> lexToken
alex_action_3 = \pos len inp -> checkLeadingWhitespace len inp >>
if B.length inp == len
then return (L pos EOF)
else setStartCode in_section
- >> return (L pos (Indent len))
-alex_action_4 = tok OpenBrace
-alex_action_5 = tok CloseBrace
-alex_action_8 = toki TokSym
-alex_action_9 = \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp)))
-alex_action_10 = toki TokOther
-alex_action_11 = toki TokOther
-alex_action_12 = tok Colon
-alex_action_13 = tok OpenBrace
-alex_action_14 = tok CloseBrace
-alex_action_15 = \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken
+ >> return (L pos (Indent len))
+alex_action_4 = tok OpenBrace
+alex_action_5 = tok CloseBrace
+alex_action_8 = toki TokSym
+alex_action_9 = \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp)))
+alex_action_10 = toki TokOther
+alex_action_11 = toki TokOther
+alex_action_12 = tok Colon
+alex_action_13 = tok OpenBrace
+alex_action_14 = tok CloseBrace
+alex_action_15 = \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken
alex_action_16 = \pos len inp -> checkLeadingWhitespace len inp >>= \len' ->
if B.length inp == len
then return (L pos EOF)
else setStartCode in_field_layout
- >> return (L pos (Indent len'))
-alex_action_18 = toki TokFieldLine
-alex_action_19 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken
-alex_action_20 = \_ _ _ -> setStartCode in_field_braces >> lexToken
-alex_action_22 = toki TokFieldLine
-alex_action_23 = tok OpenBrace
-alex_action_24 = tok CloseBrace
-alex_action_25 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken
+ >> return (L pos (Indent len'))
+alex_action_18 = toki TokFieldLine
+alex_action_19 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken
+alex_action_20 = \_ _ _ -> setStartCode in_field_braces >> lexToken
+alex_action_22 = toki TokFieldLine
+alex_action_23 = tok OpenBrace
+alex_action_24 = tok CloseBrace
+alex_action_25 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "<built-in>" #-}
@@ -310,11 +310,14 @@ alexIndexInt16OffAddr (AlexA# arr) off =
low = int2Word# (ord# (indexCharOffAddr# arr off'))
off' = off *# 2#
#else
- indexInt16OffAddr# arr off
+#if __GLASGOW_HASKELL__ >= 901
+ int16ToInt#
+#endif
+ (indexInt16OffAddr# arr off)
#endif
{-# INLINE alexIndexInt32OffAddr #-}
-alexIndexInt32OffAddr (AlexA# arr) off =
+alexIndexInt32OffAddr (AlexA# arr) off =
#ifdef WORDS_BIGENDIAN
narrow32Int# i
where
@@ -327,7 +330,10 @@ alexIndexInt32OffAddr (AlexA# arr) off =
b0 = int2Word# (ord# (indexCharOffAddr# arr off'))
off' = off *# 4#
#else
- indexInt32OffAddr# arr off
+#if __GLASGOW_HASKELL__ >= 901
+ int32ToInt#
+#endif
+ (indexInt32OffAddr# arr off)
#endif
#if __GLASGOW_HASKELL__ < 503
@@ -354,7 +360,7 @@ alexScanUser user input (I# (sc))
= case alex_scan_tkn user input 0# input sc AlexNone of
(AlexNone, input') ->
case alexGetByte input of
- Nothing ->
+ Nothing ->
AlexEOF
Just _ ->
@@ -374,20 +380,20 @@ alexScanUser user input (I# (sc))
alex_scan_tkn user orig_input len input s last_acc =
input `seq` -- strict in the input
- let
+ let
new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))
in
new_acc `seq`
case alexGetByte input of
Nothing -> (new_acc, input)
- Just (c, new_input) ->
+ Just (c, new_input) ->
case fromIntegral c of { (I# (ord_c)) ->
let
base = alexIndexInt32OffAddr alex_base s
offset = (base +# ord_c)
check = alexIndexInt16OffAddr alex_check offset
-
+
new_s = if GTE(offset,0#) && EQ(check,ord_c)
then alexIndexInt16OffAddr alex_table offset
else alexIndexInt16OffAddr alex_deflt s
diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs
index 871a3e9..d2f45d8 100644
--- a/Distribution/Simple/Utils.hs
+++ b/Distribution/Simple/Utils.hs
@@ -1360,7 +1360,7 @@ withTempFileEx opts tmpDir template action =
(\(name, handle) -> do hClose handle
unless (optKeepTempFiles opts) $
handleDoesNotExist () . removeFile $ name)
- (withLexicalCallStack (uncurry action))
+ (withLexicalCallStack (\x -> uncurry action x))
-- | Create and use a temporary directory.
--
@@ -1375,7 +1375,7 @@ withTempFileEx opts tmpDir template action =
withTempDirectory :: Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO a
withTempDirectory verbosity targetDir template f = withFrozenCallStack $
withTempDirectoryEx verbosity defaultTempFileOptions targetDir template
- (withLexicalCallStack f)
+ (withLexicalCallStack (\x -> f x))
-- | A version of 'withTempDirectory' that additionally takes a
-- 'TempFileOptions' argument.
@@ -1386,7 +1386,7 @@ withTempDirectoryEx _verbosity opts targetDir template f = withFrozenCallStack $
(createTempDirectory targetDir template)
(unless (optKeepTempFiles opts)
. handleDoesNotExist () . removeDirectoryRecursive)
- (withLexicalCallStack f)
+ (withLexicalCallStack (\x -> f x))
-----------------------------------
-- Safely reading and writing files
patches/Cabal-3.0.2.0.patch 0 → 100644
View file @ 4847b274
diff --git a/Distribution/Compat/Prelude.hs b/Distribution/Compat/Prelude.hs
index c3bc040..166e58d 100644
--- a/Distribution/Compat/Prelude.hs
+++ b/Distribution/Compat/Prelude.hs
@@ -158,7 +158,7 @@ import qualified Text.PrettyPrint as Disp
import qualified Prelude as OrigPrelude
import Distribution.Compat.Stack
-type IO a = WithCallStack (OrigPrelude.IO a)
+type IO a = OrigPrelude.IO a
type NoCallStackIO a = OrigPrelude.IO a
-- | New name for 'Text.PrettyPrint.<>'
diff --git a/Distribution/FieldGrammar/FieldDescrs.hs b/Distribution/FieldGrammar/FieldDescrs.hs
index b1d23db..82e58e6 100644
--- a/Distribution/FieldGrammar/FieldDescrs.hs
+++ b/Distribution/FieldGrammar/FieldDescrs.hs
@@ -45,7 +45,7 @@ fieldDescrPretty (F m) fn = pPretty <$> Map.lookup fn m
-- | Lookup a field value parser.
fieldDescrParse :: P.CabalParsing m => FieldDescrs s a -> P.FieldName -> Maybe (s -> m s)
-fieldDescrParse (F m) fn = pParse <$> Map.lookup fn m
+fieldDescrParse (F m) fn = (\f -> pParse f) <$> Map.lookup fn m
fieldDescrsToList
:: P.CabalParsing m
diff --git a/Distribution/Fields/Lexer.hs b/Distribution/Fields/Lexer.hs
index 9116ce3..169c676 100644
--- a/Distribution/Fields/Lexer.hs
+++ b/Distribution/Fields/Lexer.hs
@@ -317,35 +317,35 @@ alex_action_0 = \_ len _ -> do
when (len /= 0) $ addWarning LexWarningBOM
setStartCode bol_section
lexToken
-
-alex_action_1 = \_pos len inp -> checkWhitespace len inp >> adjustPos retPos >> lexToken
+
+alex_action_1 = \_pos len inp -> checkWhitespace len inp >> adjustPos retPos >> lexToken
alex_action_3 = \pos len inp -> checkLeadingWhitespace len inp >>
if B.length inp == len
then return (L pos EOF)
else setStartCode in_section
- >> return (L pos (Indent len))
-alex_action_4 = tok OpenBrace
-alex_action_5 = tok CloseBrace
-alex_action_8 = toki TokSym
-alex_action_9 = \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp)))
-alex_action_10 = toki TokOther
-alex_action_11 = toki TokOther
-alex_action_12 = tok Colon
-alex_action_13 = tok OpenBrace
-alex_action_14 = tok CloseBrace
-alex_action_15 = \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken
+ >> return (L pos (Indent len))
+alex_action_4 = tok OpenBrace
+alex_action_5 = tok CloseBrace
+alex_action_8 = toki TokSym
+alex_action_9 = \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp)))
+alex_action_10 = toki TokOther
+alex_action_11 = toki TokOther
+alex_action_12 = tok Colon
+alex_action_13 = tok OpenBrace
+alex_action_14 = tok CloseBrace
+alex_action_15 = \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken
alex_action_16 = \pos len inp -> checkLeadingWhitespace len inp >>= \len' ->
if B.length inp == len
then return (L pos EOF)
else setStartCode in_field_layout
- >> return (L pos (Indent len'))
-alex_action_18 = toki TokFieldLine
-alex_action_19 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken
-alex_action_20 = \_ _ _ -> setStartCode in_field_braces >> lexToken
-alex_action_22 = toki TokFieldLine
-alex_action_23 = tok OpenBrace
-alex_action_24 = tok CloseBrace
-alex_action_25 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken
+ >> return (L pos (Indent len'))
+alex_action_18 = toki TokFieldLine
+alex_action_19 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken
+alex_action_20 = \_ _ _ -> setStartCode in_field_braces >> lexToken
+alex_action_22 = toki TokFieldLine
+alex_action_23 = tok OpenBrace
+alex_action_24 = tok CloseBrace
+alex_action_25 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken
{-# LINE 1 "templates/GenericTemplate.hs" #-}
-- -----------------------------------------------------------------------------
-- ALEX TEMPLATE
@@ -381,7 +381,10 @@ alexIndexInt16OffAddr (AlexA# arr) off =
low = int2Word# (ord# (indexCharOffAddr# arr off'))
off' = off *# 2#
#else
- indexInt16OffAddr# arr off
+#if __GLASGOW_HASKELL__ >= 901
+ int16ToInt#
+#endif
+ (indexInt16OffAddr# arr off)
#endif
{-# INLINE alexIndexInt32OffAddr #-}
@@ -398,7 +401,10 @@ alexIndexInt32OffAddr (AlexA# arr) off =
b0 = int2Word# (ord# (indexCharOffAddr# arr off'))
off' = off *# 4#
#else
- indexInt32OffAddr# arr off
+#if __GLASGOW_HASKELL__ >= 901
+ int32ToInt#
+#endif
+ (indexInt32OffAddr# arr off)
#endif
#if __GLASGOW_HASKELL__ < 503
diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs
index 12eb4ad..8efd8a7 100644
--- a/Distribution/Simple/Utils.hs
+++ b/Distribution/Simple/Utils.hs
@@ -1338,7 +1338,7 @@ withTempFileEx opts tmpDir template action =
(\(name, handle) -> do hClose handle
unless (optKeepTempFiles opts) $
handleDoesNotExist () . removeFile $ name)
- (withLexicalCallStack (uncurry action))
+ (withLexicalCallStack (\x -> uncurry action x))
-- | Create and use a temporary directory.
--
@@ -1353,7 +1353,7 @@ withTempFileEx opts tmpDir template action =
withTempDirectory :: Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO a
withTempDirectory verbosity targetDir template f = withFrozenCallStack $
withTempDirectoryEx verbosity defaultTempFileOptions targetDir template
- (withLexicalCallStack f)
+ (withLexicalCallStack (\x -> f x))
-- | A version of 'withTempDirectory' that additionally takes a
-- 'TempFileOptions' argument.
@@ -1364,7 +1364,7 @@ withTempDirectoryEx _verbosity opts targetDir template f = withFrozenCallStack $
(createTempDirectory targetDir template)
(unless (optKeepTempFiles opts)
. handleDoesNotExist () . removeDirectoryRecursive)
- (withLexicalCallStack f)
+ (withLexicalCallStack (\x -> f x))
-----------------------------------
-- Safely reading and writing files
patches/Cabal-3.2.1.0.patch 0 → 100644
View file @ 4847b274
diff --git a/Distribution/Compat/Prelude.hs b/Distribution/Compat/Prelude.hs
index 0cca7db..ffa7e84 100644
--- a/Distribution/Compat/Prelude.hs
+++ b/Distribution/Compat/Prelude.hs
@@ -141,7 +141,7 @@ import Data.Data (Data)
import Distribution.Compat.Typeable (Typeable, TypeRep, typeRep)
import Distribution.Compat.Binary (Binary (..))
import Distribution.Compat.Semigroup (Semigroup (..), gmappend, gmempty)
-import GHC.Generics (Generic, Rep(..),
+import GHC.Generics (Generic(..), Rep,
V1, U1(U1), K1(unK1), M1(unM1),
(:*:)((:*:)), (:+:)(L1,R1))
@@ -170,7 +170,7 @@ import Distribution.Compat.Stack
import Distribution.Utils.Structured (Structured)
-type IO a = WithCallStack (OrigPrelude.IO a)
+type IO a = OrigPrelude.IO a
type NoCallStackIO a = OrigPrelude.IO a
-- | New name for 'Text.PrettyPrint.<>'
diff --git a/Distribution/FieldGrammar/FieldDescrs.hs b/Distribution/FieldGrammar/FieldDescrs.hs
index 803ce60..f58a918 100644
--- a/Distribution/FieldGrammar/FieldDescrs.hs
+++ b/Distribution/FieldGrammar/FieldDescrs.hs
@@ -45,7 +45,7 @@ fieldDescrPretty (F m) fn = pPretty <$> Map.lookup fn m
-- | Lookup a field value parser.
fieldDescrParse :: P.CabalParsing m => FieldDescrs s a -> P.FieldName -> Maybe (s -> m s)
-fieldDescrParse (F m) fn = pParse <$> Map.lookup fn m
+fieldDescrParse (F m) fn = (\f -> pParse f) <$> Map.lookup fn m
fieldDescrsToList
:: P.CabalParsing m
diff --git a/Distribution/Fields/Lexer.hs b/Distribution/Fields/Lexer.hs
index 9116ce3..169c676 100644
--- a/Distribution/Fields/Lexer.hs
+++ b/Distribution/Fields/Lexer.hs
@@ -317,35 +317,35 @@ alex_action_0 = \_ len _ -> do
when (len /= 0) $ addWarning LexWarningBOM
setStartCode bol_section
lexToken
-
-alex_action_1 = \_pos len inp -> checkWhitespace len inp >> adjustPos retPos >> lexToken
+
+alex_action_1 = \_pos len inp -> checkWhitespace len inp >> adjustPos retPos >> lexToken
alex_action_3 = \pos len inp -> checkLeadingWhitespace len inp >>
if B.length inp == len
then return (L pos EOF)
else setStartCode in_section
- >> return (L pos (Indent len))
-alex_action_4 = tok OpenBrace
-alex_action_5 = tok CloseBrace
-alex_action_8 = toki TokSym
-alex_action_9 = \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp)))
-alex_action_10 = toki TokOther
-alex_action_11 = toki TokOther
-alex_action_12 = tok Colon
-alex_action_13 = tok OpenBrace
-alex_action_14 = tok CloseBrace
-alex_action_15 = \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken
+ >> return (L pos (Indent len))
+alex_action_4 = tok OpenBrace
+alex_action_5 = tok CloseBrace
+alex_action_8 = toki TokSym
+alex_action_9 = \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp)))
+alex_action_10 = toki TokOther
+alex_action_11 = toki TokOther
+alex_action_12 = tok Colon
+alex_action_13 = tok OpenBrace
+alex_action_14 = tok CloseBrace
+alex_action_15 = \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken
alex_action_16 = \pos len inp -> checkLeadingWhitespace len inp >>= \len' ->
if B.length inp == len
then return (L pos EOF)
else setStartCode in_field_layout
- >> return (L pos (Indent len'))
-alex_action_18 = toki TokFieldLine
-alex_action_19 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken
-alex_action_20 = \_ _ _ -> setStartCode in_field_braces >> lexToken
-alex_action_22 = toki TokFieldLine
-alex_action_23 = tok OpenBrace
-alex_action_24 = tok CloseBrace
-alex_action_25 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken
+ >> return (L pos (Indent len'))
+alex_action_18 = toki TokFieldLine
+alex_action_19 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken
+alex_action_20 = \_ _ _ -> setStartCode in_field_braces >> lexToken
+alex_action_22 = toki TokFieldLine
+alex_action_23 = tok OpenBrace
+alex_action_24 = tok CloseBrace
+alex_action_25 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken
{-# LINE 1 "templates/GenericTemplate.hs" #-}
-- -----------------------------------------------------------------------------
-- ALEX TEMPLATE
@@ -381,7 +381,10 @@ alexIndexInt16OffAddr (AlexA# arr) off =
low = int2Word# (ord# (indexCharOffAddr# arr off'))
off' = off *# 2#
#else
- indexInt16OffAddr# arr off
+#if __GLASGOW_HASKELL__ >= 901
+ int16ToInt#
+#endif
+ (indexInt16OffAddr# arr off)
#endif
{-# INLINE alexIndexInt32OffAddr #-}
@@ -398,7 +401,10 @@ alexIndexInt32OffAddr (AlexA# arr) off =
b0 = int2Word# (ord# (indexCharOffAddr# arr off'))
off' = off *# 4#
#else
- indexInt32OffAddr# arr off
+#if __GLASGOW_HASKELL__ >= 901
+ int32ToInt#
+#endif
+ (indexInt32OffAddr# arr off)
#endif
#if __GLASGOW_HASKELL__ < 503
diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs
index ccc35f5..aea1c5a 100644
--- a/Distribution/Simple/Utils.hs
+++ b/Distribution/Simple/Utils.hs
@@ -799,7 +799,7 @@ createProcessWithEnv verbosity path args mcwd menv inp out err = withFrozenCallS
--
-- The output is assumed to be text in the locale encoding.
--
-rawSystemStdout :: forall mode. KnownIODataMode mode => Verbosity -> FilePath -> [String] -> IO mode
+rawSystemStdout :: forall mode. KnownIODataMode mode => Verbosity -> FilePath -> [String] -> IO mode
rawSystemStdout verbosity path args = withFrozenCallStack $ do
(output, errors, exitCode) <- rawSystemStdInOut verbosity path args
Nothing Nothing Nothing (IOData.iodataMode :: IODataMode mode)
@@ -1341,7 +1341,7 @@ withTempFileEx opts tmpDir template action =
(\(name, handle) -> do hClose handle
unless (optKeepTempFiles opts) $
handleDoesNotExist () . removeFile $ name)
- (withLexicalCallStack (uncurry action))
+ (withLexicalCallStack (\x -> uncurry action x))
-- | Create and use a temporary directory.
--
@@ -1356,7 +1356,7 @@ withTempFileEx opts tmpDir template action =
withTempDirectory :: Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO a
withTempDirectory verbosity targetDir template f = withFrozenCallStack $
withTempDirectoryEx verbosity defaultTempFileOptions targetDir template
- (withLexicalCallStack f)
+ (withLexicalCallStack (\x -> f x))
-- | A version of 'withTempDirectory' that additionally takes a
-- 'TempFileOptions' argument.
@@ -1367,7 +1367,7 @@ withTempDirectoryEx _verbosity opts targetDir template f = withFrozenCallStack $
(createTempDirectory targetDir template)
(unless (optKeepTempFiles opts)
. handleDoesNotExist () . removeDirectoryRecursive)
- (withLexicalCallStack f)
+ (withLexicalCallStack (\x -> f x))
-----------------------------------
-- Safely reading and writing files
diff --git a/Distribution/Utils/Structured.hs b/Distribution/Utils/Structured.hs
index 37f7d2e..480b8e4 100644
--- a/Distribution/Utils/Structured.hs
+++ b/Distribution/Utils/Structured.hs
@@ -87,7 +87,7 @@ import GHC.Generics
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
-import qualified Data.ByteString.Lazy.Builder as Builder
+import qualified Data.ByteString.Builder as Builder
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map as Map
patches/Cabal-syntax-3.8.1.0.patch 0 → 100644
View file @ 4847b274
diff --git a/src/Distribution/Compat/Prelude.hs b/src/Distribution/Compat/Prelude.hs
index 954714d..f148471 100644
--- a/src/Distribution/Compat/Prelude.hs
+++ b/src/Distribution/Compat/Prelude.hs
@@ -186,7 +186,7 @@ import Data.Word (Word, Word16, Word32, Word64, Word8)
import Distribution.Compat.Binary (Binary (..))
import Distribution.Compat.Semigroup (Semigroup (..), gmappend, gmempty)
import Distribution.Compat.Typeable (TypeRep, Typeable, typeRep)
-import GHC.Generics ((:*:) ((:*:)), (:+:) (L1, R1), Generic, K1 (unK1), M1 (unM1), Rep (..), U1 (U1), V1)
+import GHC.Generics ((:*:) ((:*:)), (:+:) (L1, R1), Generic (..), K1 (unK1), M1 (unM1), Rep, U1 (U1), V1)
import System.Exit (ExitCode (..), exitFailure, exitSuccess, exitWith)
import Text.Read (readMaybe)
patches/EdisonAPI-1.3.1.patch deleted 100644 → 0
View file @ 76f9ba89
diff -ru EdisonAPI-1.3.1.orig/src/Data/Edison/Seq/ListSeq.hs EdisonAPI-1.3.1/src/Data/Edison/Seq/ListSeq.hs
--- EdisonAPI-1.3.1.orig/src/Data/Edison/Seq/ListSeq.hs 2016-06-03 00:49:51.000000000 -0400
+++ EdisonAPI-1.3.1/src/Data/Edison/Seq/ListSeq.hs 2019-04-19 13:54:07.461113622 -0400
@@ -131,25 +131,25 @@
rcons x s = s ++ [x]
append = (++)
-lview [] = fail "ListSeq.lview: empty sequence"
+lview [] = error "ListSeq.lview: empty sequence"
lview (x:xs) = return (x, xs)
-lheadM [] = fail "ListSeq.lheadM: empty sequence"
+lheadM [] = error "ListSeq.lheadM: empty sequence"
lheadM (x:xs) = return x
lhead [] = error "ListSeq.lhead: empty sequence"
lhead (x:xs) = x
-ltailM [] = fail "ListSeq.ltailM: empty sequence"
+ltailM [] = error "ListSeq.ltailM: empty sequence"
ltailM (x:xs) = return xs
ltail [] = error "ListSeq.ltail: empty sequence"
ltail (x:xs) = xs
-rview [] = fail "ListSeq.rview: empty sequence"
+rview [] = error "ListSeq.rview: empty sequence"
rview xs = return (rhead xs, rtail xs)
-rheadM [] = fail "ListSeq.rheadM: empty sequence"
+rheadM [] = error "ListSeq.rheadM: empty sequence"
rheadM (x:xs) = rh x xs
where rh y [] = return y
rh y (x:xs) = rh x xs
@@ -159,7 +159,7 @@
where rh y [] = y
rh y (x:xs) = rh x xs
-rtailM [] = fail "ListSeq.rtailM: empty sequence"
+rtailM [] = error "ListSeq.rtailM: empty sequence"
rtailM (x:xs) = return (rt x xs)
where rt y [] = []
rt y (x:xs) = y : rt x xs
@@ -255,9 +255,9 @@
lookup i xs = ID.runIdentity (lookupM i xs)
lookupM i xs
- | i < 0 = fail "ListSeq.lookup: not found"
+ | i < 0 = error "ListSeq.lookup: not found"
| otherwise = case drop i xs of
- [] -> fail "ListSeq.lookup: not found"
+ [] -> error "ListSeq.lookup: not found"
(x:_) -> return x
lookupWithDefault d i xs
patches/EdisonCore-1.3.2.1.patch deleted 100644 → 0
View file @ 76f9ba89
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/AssocList.hs EdisonCore-1.3.2.1/src/Data/Edison/Assoc/AssocList.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/AssocList.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Assoc/AssocList.hs 2019-04-19 14:27:30.278406081 -0400
@@ -311,7 +311,7 @@
lookup key m = runIdentity (lookupM key m)
-lookupM _ E = fail "AssocList.lookup: lookup failed"
+lookupM _ E = error "AssocList.lookup: lookup failed"
lookupM key (I k x m) | key == k = return x
| otherwise = lookupM key m
@@ -321,7 +321,7 @@
lookupAndDelete key m = runIdentity (lookupAndDeleteM key m)
-lookupAndDeleteM _ E = fail "AssocList.lookupAndDeleteM: lookup failed"
+lookupAndDeleteM _ E = error "AssocList.lookupAndDeleteM: lookup failed"
lookupAndDeleteM key (I k x m)
| key == k = return (x,delete k m)
| otherwise = lookupAndDeleteM key m >>=
@@ -424,7 +424,7 @@
| k > k0 = findMax k a (delete k m)
| otherwise = findMax k0 a0 (delete k m)
-minView E = fail (moduleName++".minView: empty map")
+minView E = error (moduleName++".minView: empty map")
minView n@(I k a m) = let (k',x) = findMin k a m in return (x,delete k' n)
minElem E = error (moduleName++".minElem: empty map")
@@ -435,7 +435,7 @@
unsafeInsertMin = insert
-maxView E = fail (moduleName++".maxView: empty map")
+maxView E = error (moduleName++".maxView: empty map")
maxView n@(I k a m) = let (k',x) = findMax k a m in return (x,delete k' n)
maxElem E = error (moduleName++".maxElem: empty map")
@@ -482,13 +482,13 @@
partitionLE_GT k = spanFM (<=k) . mergeSortFM
partitionLT_GT k = (\(x,y) -> (x,delete k y)) . spanFM (<k) . mergeSortFM
-minViewWithKey E = fail $ moduleName++".minViewWithKey: empty map"
+minViewWithKey E = error $ moduleName++".minViewWithKey: empty map"
minViewWithKey n@(I k a m) = let (k',x) = findMin k a m in return ((k',x),delete k' n)
minElemWithKey E = error $ moduleName++".minElemWithKey: empty map"
minElemWithKey (I k a m) = findMin k a m
-maxViewWithKey E = fail $ moduleName++".maxViewWithKey: empty map"
+maxViewWithKey E = error $ moduleName++".maxViewWithKey: empty map"
maxViewWithKey n@(I k a m) = let (k',x) = findMax k a m in return ((k',x),delete k' n)
maxElemWithKey E = error $ moduleName++".maxElemWithKey: empty map"
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/Defaults.hs EdisonCore-1.3.2.1/src/Data/Edison/Assoc/Defaults.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/Defaults.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Assoc/Defaults.hs 2019-04-19 14:19:15.118124131 -0400
@@ -193,7 +193,7 @@
lookupAndDeleteMDefault :: (Monad rm, AssocX m k) => k -> m a -> rm (a, m a)
lookupAndDeleteMDefault k m =
case lookupM k m of
- Nothing -> fail (instanceName m ++ ".lookupAndDelete: lookup failed")
+ Nothing -> error (instanceName m ++ ".lookupAndDelete: lookup failed")
Just x -> return (x, delete k m)
lookupAndDeleteAllDefault :: (S.Sequence seq, AssocX m k) => k -> m a -> (seq a,m a)
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/PatriciaLoMap.hs EdisonCore-1.3.2.1/src/Data/Edison/Assoc/PatriciaLoMap.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/PatriciaLoMap.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Assoc/PatriciaLoMap.hs 2019-04-19 14:26:19.237793376 -0400
@@ -213,10 +213,10 @@
lookup k m = runIdentity (lookupM k m)
lookupM :: (Monad rm) => Int -> FM a -> rm a
-lookupM _ E = fail "PatriciaLoMap.lookup: lookup failed"
+lookupM _ E = error "PatriciaLoMap.lookup: lookup failed"
lookupM k (L j x)
| j == k = return x
- | otherwise = fail "PatriciaLoMap.lookup: lookup failed"
+ | otherwise = error "PatriciaLoMap.lookup: lookup failed"
lookupM k (B _ m t0 t1) = if zeroBit k m then lookupM k t0 else lookupM k t1
doLookupAndDelete :: z -> (a -> FM a -> z) -> Int -> FM a -> z
@@ -235,7 +235,7 @@
lookupAndDeleteM :: Monad m => Int -> FM a -> m (a, FM a)
lookupAndDeleteM = doLookupAndDelete
- (fail "PatriciaLoMap.lookupAndDelete: lookup failed")
+ (error "PatriciaLoMap.lookupAndDelete: lookup failed")
(\x m -> return (x,m))
lookupAndDeleteAll :: S.Sequence seq => Int -> FM a -> (seq a,FM a)
@@ -586,25 +586,25 @@
minView :: Monad m => FM a -> m (a, FM a)
minView fm =
case ordListFM fm of
- [] -> fail $ moduleName++".minView: empty map"
+ [] -> error $ moduleName++".minView: empty map"
((k,x):_) -> return (x,delete k fm)
minViewWithKey :: Monad m => FM a -> m ((Int, a), FM a)
minViewWithKey fm =
case ordListFM fm of
- [] -> fail $ moduleName++".minViewWithKey: empty map"
+ [] -> error $ moduleName++".minViewWithKey: empty map"
((k,x):_) -> return ((k,x),delete k fm)
maxView :: Monad m => FM a -> m (a, FM a)
maxView fm =
case ordListFM_rev fm of
- [] -> fail $ moduleName++".maxView: empty map"
+ [] -> error $ moduleName++".maxView: empty map"
((k,x):_) -> return (x,delete k fm)
maxViewWithKey :: Monad m => FM a -> m ((Int, a), FM a)
maxViewWithKey fm =
case ordListFM_rev fm of
- [] -> fail $ moduleName++".maxViewWithKey: empty map"
+ [] -> error $ moduleName++".maxViewWithKey: empty map"
((k,x):_) -> return ((k,x),delete k fm)
minElem :: FM a -> a
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/StandardMap.hs EdisonCore-1.3.2.1/src/Data/Edison/Assoc/StandardMap.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/StandardMap.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Assoc/StandardMap.hs 2019-04-19 14:25:37.089429664 -0400
@@ -199,7 +199,7 @@
member = DM.member
count = countUsingMember
lookup k m = maybe (error (moduleName ++ ".lookup: failed")) id (DM.lookup k m)
-lookupM k m = maybe (fail (moduleName ++ ".lookupM: failed")) return (DM.lookup k m)
+lookupM k m = maybe (error (moduleName ++ ".lookupM: failed")) return (DM.lookup k m)
lookupAll = lookupAllUsingLookupM
lookupWithDefault = DM.findWithDefault
lookupAndDelete = lookupAndDeleteDefault
@@ -223,14 +223,14 @@
elements = elementsUsingFold
minView m = if DM.null m
- then fail (moduleName ++ ".minView: failed")
+ then error (moduleName ++ ".minView: failed")
else let ((_,x),m') = DM.deleteFindMin m
in return (x,m')
minElem = snd . DM.findMin
deleteMin = DM.deleteMin
unsafeInsertMin = DM.insert
maxView m = if DM.null m
- then fail (moduleName ++ ".maxView: failed")
+ then error (moduleName ++ ".maxView: failed")
else let ((_,x),m') = DM.deleteFindMax m
in return (x,m')
maxElem = snd . DM.findMax
@@ -283,11 +283,11 @@
partitionWithKey = DM.partitionWithKey
minViewWithKey m = if DM.null m
- then fail (moduleName ++ ".minViewWithKey: failed")
+ then error (moduleName ++ ".minViewWithKey: failed")
else return (DM.deleteFindMin m)
minElemWithKey = DM.findMin
maxViewWithKey m = if DM.null m
- then fail (moduleName ++ ".maxViewWithKey: failed")
+ then error (moduleName ++ ".maxViewWithKey: failed")
else return (DM.deleteFindMax m)
maxElemWithKey = DM.findMax
foldrWithKey = DM.foldrWithKey
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/TernaryTrie.hs EdisonCore-1.3.2.1/src/Data/Edison/Assoc/TernaryTrie.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Assoc/TernaryTrie.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Assoc/TernaryTrie.hs 2019-04-19 14:20:46.006912560 -0400
@@ -530,12 +530,12 @@
lookup m k = runIdentity (lookupM m k)
lookupM [] (FM Nothing _)
- = fail "TernaryTrie.lookup: lookup failed"
+ = error "TernaryTrie.lookup: lookup failed"
lookupM [] (FM (Just v) _)
= return v
lookupM xs (FM _ fmb)
= case lookupFMB xs fmb of
- Nothing -> fail "TernaryTrie.lookup: lookup failed"
+ Nothing -> error "TernaryTrie.lookup: lookup failed"
Just v -> return v
lookupAll = lookupAllUsingLookupM
@@ -547,7 +547,7 @@
lookupAndDeleteM =
lookupAndDelFromFM
- (fail "TernaryTrie.lookupAndDeleteM: lookup failed")
+ (error "TernaryTrie.lookupAndDeleteM: lookup failed")
(\w m -> return (w,m))
lookupAndDeleteAll k m =
@@ -855,7 +855,7 @@
-- OrdAssocX
minViewFMB :: Monad m => FMB k a -> (FMB k a -> FM k a) -> m (a, FM k a)
-minViewFMB E _ = fail $ moduleName++".minView: empty map"
+minViewFMB E _ = error $ moduleName++".minView: empty map"
minViewFMB (I i k (Just v) E m r) f = return (v, f (I i k Nothing E m r))
minViewFMB (I _ _ Nothing E (FMB' E) _) _ = error $ moduleName++".minView: bug!"
minViewFMB (I _ k Nothing E (FMB' m) r) f = minViewFMB m (\m' -> f (mkVBalancedFMB k Nothing E (FMB' m') r))
@@ -866,7 +866,7 @@
minView (FM Nothing fmb) = minViewFMB fmb (FM Nothing)
minViewWithKeyFMB :: Monad m => FMB k a -> ([k] -> [k]) -> (FMB k a -> FM k a) -> m (([k],a),FM k a)
-minViewWithKeyFMB E _ _ = fail $ moduleName++".minView: empty map"
+minViewWithKeyFMB E _ _ = error $ moduleName++".minView: empty map"
minViewWithKeyFMB (I i k (Just v) E m r) kf f = return ((kf [k],v),f (I i k Nothing E m r))
minViewWithKeyFMB (I _ _ Nothing E (FMB' E) _) _ _ = error $ moduleName++".minViewWithKey: bug!"
minViewWithKeyFMB (I _ k Nothing E (FMB' m) r) kf f = minViewWithKeyFMB m (kf . (k:))
@@ -915,7 +915,7 @@
maxViewFMB E _ = error $ moduleName++".maxView: bug!"
maxView :: Monad m => FM k a -> m (a, FM k a)
-maxView (FM Nothing E) = fail $ moduleName++".maxView: empty map"
+maxView (FM Nothing E) = error $ moduleName++".maxView: empty map"
maxView (FM (Just v) E) = return (v,FM Nothing E)
maxView (FM mv fmb) = maxViewFMB fmb (FM mv)
@@ -931,7 +931,7 @@
maxViewWithKey :: Monad m => FM k a -> m (([k],a), FM k a)
-maxViewWithKey (FM Nothing E) = fail $ moduleName++".maxViewWithKey: empty map"
+maxViewWithKey (FM Nothing E) = error $ moduleName++".maxViewWithKey: empty map"
maxViewWithKey (FM (Just v) E) = return (([],v),FM Nothing E)
maxViewWithKey (FM mv fmb) = maxViewWithKeyFMB fmb id (FM mv)
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/Defaults.hs EdisonCore-1.3.2.1/src/Data/Edison/Coll/Defaults.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/Defaults.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Coll/Defaults.hs 2019-04-19 14:12:05.390426953 -0400
@@ -89,7 +89,7 @@
EQ -> return (x, y)
GT -> witness a ys
-- XXX
- witness _ _ = fail $ instanceName as ++ ".intersect: failed"
+ witness _ _ = error $ instanceName as ++ ".intersect: failed"
lookupUsingLookupM :: Coll c a => a -> c -> a
lookupUsingLookupM x ys = runIdentity (lookupM x ys)
@@ -104,7 +104,7 @@
lookupMUsingLookupAll x ys =
case lookupAll x ys of
(y:_) -> return y
- [] -> fail $ instanceName ys ++ ".lookupM: lookup failed"
+ [] -> error $ instanceName ys ++ ".lookupM: lookup failed"
lookupWithDefaultUsingLookupAll :: Coll c a => a -> a -> c -> a
lookupWithDefaultUsingLookupAll dflt x ys =
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/EnumSet.hs EdisonCore-1.3.2.1/src/Data/Edison/Coll/EnumSet.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/EnumSet.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Coll/EnumSet.hs 2019-04-19 14:18:03.381500731 -0400
@@ -254,7 +254,7 @@
lookupM :: (Eq a, Enum a, Monad m) => a -> Set a -> m a
lookupM x s
| member x s = return x
- | otherwise = fail (moduleName++".lookupM: lookup failed")
+ | otherwise = error (moduleName++".lookupM: lookup failed")
lookupAll :: (Eq a, Enum a, S.Sequence s) => a -> Set a -> s a
lookupAll = lookupAllUsingLookupM
@@ -342,12 +342,12 @@
minView :: (Enum a, Monad m) => Set a -> m (a, Set a)
minView (Set w)
- | w == 0 = fail (moduleName++".minView: empty set")
+ | w == 0 = error (moduleName++".minView: empty set")
| otherwise = let i = lsb w in return (toEnum i,Set $ clearBit w i)
maxView :: (Enum a, Monad m) => Set a -> m (a, Set a)
maxView (Set w)
- | w == 0 = fail (moduleName++".maxView: empty set")
+ | w == 0 = error (moduleName++".maxView: empty set")
| otherwise = let i = msb w in return (toEnum i, Set $ clearBit w i)
unsafeInsertMin :: (Ord a, Enum a) => a -> Set a -> Set a
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/LazyPairingHeap.hs EdisonCore-1.3.2.1/src/Data/Edison/Coll/LazyPairingHeap.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/LazyPairingHeap.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Coll/LazyPairingHeap.hs 2019-04-19 14:16:29.236692426 -0400
@@ -360,7 +360,7 @@
GT -> rest
minView :: (Ord a, Monad m) => Heap a -> m (a, Heap a)
-minView E = fail "LazyPairingHeap.minView: empty heap"
+minView E = error "LazyPairingHeap.minView: empty heap"
minView (H1 x xs) = return (x,xs)
minView (H2 x h xs) = return (x,union h xs)
@@ -370,7 +370,7 @@
minElem (H2 x _ _) = x
maxView :: (Ord a, Monad m) => Heap a -> m (a, Heap a)
-maxView E = fail "LazyPairingHeap.maxView: empty heap"
+maxView E = error "LazyPairingHeap.maxView: empty heap"
maxView xs = return (y,xs')
where (xs', y) = maxView' xs
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/LeftistHeap.hs EdisonCore-1.3.2.1/src/Data/Edison/Coll/LeftistHeap.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/LeftistHeap.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Coll/LeftistHeap.hs 2019-04-19 14:16:11.996544459 -0400
@@ -174,13 +174,13 @@
tol (L _ x a b) rest = S.lcons x (tol b (tol a rest))
lookupM :: (Ord a, Monad m) => a -> Heap a -> m a
-lookupM _ E = fail "LeftistHeap.lookupM: XXX"
+lookupM _ E = error "LeftistHeap.lookupM: XXX"
lookupM x (L _ y a b) =
case compare x y of
- LT -> fail "LeftistHeap.lookupM: XXX"
+ LT -> error "LeftistHeap.lookupM: XXX"
EQ -> return y
GT -> case lookupM x b `mplus` lookupM x a of
- Nothing -> fail "LeftistHeap.lookupM: XXX"
+ Nothing -> error "LeftistHeap.lookupM: XXX"
Just q -> return q
lookupAll :: (Ord a,S.Sequence seq) => a -> Heap a -> seq a
@@ -300,7 +300,7 @@
in (node x a' b', hs'')
minView :: (Ord a, Monad m) => Heap a -> m (a, Heap a)
-minView E = fail "LeftistHeap.minView: empty collection"
+minView E = error "LeftistHeap.minView: empty collection"
minView (L _ x a b) = return (x, union a b)
minElem :: Ord a => Heap a -> a
@@ -308,7 +308,7 @@
minElem (L _ x _ _) = x
maxView :: (Ord a, Monad m) => Heap a -> m (a, Heap a)
-maxView E = fail "LeftistHeap.maxView: empty collection"
+maxView E = error "LeftistHeap.maxView: empty collection"
maxView (L _ x E _) = return (x, E)
maxView (L _ x a E) = return (y, L 1 x a' E)
where Just (y,a') = maxView a
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/MinHeap.hs EdisonCore-1.3.2.1/src/Data/Edison/Coll/MinHeap.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/MinHeap.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Coll/MinHeap.hs 2019-04-19 14:14:14.447535351 -0400
@@ -201,7 +201,7 @@
lookupM x (M y ys)
| x > y = C.lookupM x ys
| x == y = return y
-lookupM _ _ = fail "lookupM.lookup: XXX"
+lookupM _ _ = error "lookupM.lookup: XXX"
lookupAll x (M y ys)
| x > y = C.lookupAll x ys
@@ -286,13 +286,13 @@
partitionLT_GT _ h = (E, h)
-minView E = fail "MinHeap.minView: empty heap"
+minView E = error "MinHeap.minView: empty heap"
minView (M x xs) = return (x, fromPrim xs)
minElem E = error "MinHeap.minElem: empty heap"
minElem (M x _) = x
-maxView E = fail "MinHeap.maxView: empty heap"
+maxView E = error "MinHeap.maxView: empty heap"
maxView (M x xs) = case C.maxView xs of
Nothing -> return (x, E)
Just (y,ys) -> return (y, M x ys)
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/SkewHeap.hs EdisonCore-1.3.2.1/src/Data/Edison/Coll/SkewHeap.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/SkewHeap.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Coll/SkewHeap.hs 2019-04-19 14:13:55.407371862 -0400
@@ -143,13 +143,13 @@
tol (T x a b) rest = S.lcons x (tol b (tol a rest))
lookupM :: (Ord a, Monad m) => a -> Heap a -> m a
-lookupM _ E = fail "SkewHeap.lookupM: XXX"
+lookupM _ E = error "SkewHeap.lookupM: XXX"
lookupM x (T y a b) =
case compare x y of
- LT -> fail "SkewHeap.lookupM: XXX"
+ LT -> error "SkewHeap.lookupM: XXX"
EQ -> return y
GT -> case lookupM x b `mplus` lookupM x a of
- Nothing -> fail "SkewHeap.lookupM: XXX"
+ Nothing -> error "SkewHeap.lookupM: XXX"
Just x -> return x
lookupAll :: (Ord a,S.Sequence seq) => a -> Heap a -> seq a
@@ -268,7 +268,7 @@
in (T x a' b', hs'')
minView :: (Ord a, Monad m) => Heap a -> m (a, Heap a)
-minView E = fail "SkewHeap.minView: empty heap"
+minView E = error "SkewHeap.minView: empty heap"
minView (T x a b) = return (x, union a b)
minElem :: Ord a => Heap a -> a
@@ -276,7 +276,7 @@
minElem (T x _ _) = x
maxView :: (Ord a, Monad m) => Heap a -> m (a, Heap a)
-maxView E = fail "SkewHeap.maxView: empty heap"
+maxView E = error "SkewHeap.maxView: empty heap"
maxView (T x E E) = return (x, E)
maxView (T x a E) = return (y, T x a' E)
where Just (y, a') = maxView a
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/SplayHeap.hs EdisonCore-1.3.2.1/src/Data/Edison/Coll/SplayHeap.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/SplayHeap.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Coll/SplayHeap.hs 2019-04-19 14:13:12.815006098 -0400
@@ -182,7 +182,7 @@
| x > y = lookup x b
| otherwise = y
-lookupM _ E = fail "SplayHeap.lookup: empty heap"
+lookupM _ E = error "SplayHeap.lookup: empty heap"
lookupM x (T a y b)
| x < y = lookupM x a
| x > y = lookupM x b
@@ -354,7 +354,7 @@
else (T a x (filterLT k ba), filterGT k bb)
else (filterLT k a, filterGT k b)
-minView E = fail "SplayHeap.minView: empty heap"
+minView E = error "SplayHeap.minView: empty heap"
minView (T a x b) = return (y, ys)
where (y,ys) = minv a x b
minv E x b = (x,b)
@@ -368,7 +368,7 @@
minel (T a x _) _ = minel a x
-maxView E = fail "SplayHeap.maxView: empty heap"
+maxView E = error "SplayHeap.maxView: empty heap"
maxView (T a x b) = return (y,ys)
where (ys,y) = maxv a x b
maxv a x E = (a,x)
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/StandardSet.hs EdisonCore-1.3.2.1/src/Data/Edison/Coll/StandardSet.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/StandardSet.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Coll/StandardSet.hs 2019-04-19 14:12:47.094785195 -0400
@@ -179,12 +179,12 @@
partitionLT_GT = DS.split
minView set = if DS.null set
- then fail (moduleName ++ ".minView: failed")
+ then error (moduleName ++ ".minView: failed")
else return (DS.deleteFindMin set)
minElem = DS.findMin
maxView set = if DS.null set
- then fail (moduleName ++ ".maxView: failed")
+ then error (moduleName ++ ".maxView: failed")
else return (DS.deleteFindMax set)
maxElem = DS.findMax
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/UnbalancedSet.hs EdisonCore-1.3.2.1/src/Data/Edison/Coll/UnbalancedSet.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Coll/UnbalancedSet.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Coll/UnbalancedSet.hs 2019-04-19 14:12:31.738653293 -0400
@@ -179,7 +179,7 @@
EQ -> True
GT -> member x b
-lookupM _ E = fail "UnbalancedSet.lookupM: XXX"
+lookupM _ E = error "UnbalancedSet.lookupM: XXX"
lookupM x (T a y b) =
case compare x y of
LT -> lookupM x a
@@ -276,7 +276,7 @@
GT -> (a0,T a1 x b)
where (a0,a1) = partitionLT_GT y a
-minView E = fail "UnbalancedSet.minView: empty collection"
+minView E = error "UnbalancedSet.minView: empty collection"
minView (T E x b) = return (x, b)
minView (T a x b) = return (y, T a' x b)
where Just (y,a') = minView a
@@ -285,7 +285,7 @@
minElem (T E x _) = x
minElem (T a _ _) = minElem a
-maxView E = fail "UnbalancedSet.maxView: empty collection"
+maxView E = error "UnbalancedSet.maxView: empty collection"
maxView (T a x E) = return (x, a)
maxView (T a x b) = return (y, T a x b')
where Just (y, b') = maxView b
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Concrete/FingerTree.hs EdisonCore-1.3.2.1/src/Data/Edison/Concrete/FingerTree.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Concrete/FingerTree.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Concrete/FingerTree.hs 2019-04-19 14:08:25.368535687 -0400
@@ -335,7 +335,7 @@
-- | /O(1)/. Analyse the left end of a sequence.
lview :: (Measured v a, Monad m) => FingerTree v a -> m (a,FingerTree v a)
-lview Empty = fail "FingerTree.lview: empty tree"
+lview Empty = error "FingerTree.lview: empty tree"
lview (Single x) = return (x, Empty)
lview (Deep _ (One x) m sf) = return . (,) x $
case lview m of
@@ -358,7 +358,7 @@
-- | /O(1)/. Analyse the right end of a sequence.
rview :: (Measured v a, Monad m) => FingerTree v a -> m (a, FingerTree v a)
-rview Empty = fail "FingerTree.rview: empty tree"
+rview Empty = error "FingerTree.rview: empty tree"
rview (Single x) = return (x, Empty)
rview (Deep _ pr m (One x)) = return . (,) x $
case rview m of
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/BankersQueue.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/BankersQueue.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/BankersQueue.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/BankersQueue.hs 2019-04-19 14:11:34.886164882 -0400
@@ -161,25 +161,25 @@
append (Q i1 xs1 ys1 j1) (Q i2 xs2 ys2 j2) =
Q (i1 + j1 + i2) (xs1 ++ L.reverseOnto ys1 xs2) ys2 j2
-lview (Q _ [] _ _) = fail "BankersQueue.lview: empty sequence"
+lview (Q _ [] _ _) = error "BankersQueue.lview: empty sequence"
lview (Q i (x:xs) ys j) = return (x, makeQ (i-1) xs ys j)
lhead (Q _ [] _ _) = error "BankersQueue.lhead: empty sequence"
lhead (Q _ (x:_) _ _) = x
-lheadM (Q _ [] _ _) = fail "BankersQueue.lheadM: empty sequence"
+lheadM (Q _ [] _ _) = error "BankersQueue.lheadM: empty sequence"
lheadM (Q _ (x:_) _ _) = return x
ltail (Q i (_:xs) ys j) = makeQ (i-1) xs ys j
ltail _ = error "BankersQueue.ltail: empty sequence"
ltailM (Q i (_:xs) ys j) = return (makeQ (i-1) xs ys j)
-ltailM _ = fail "BankersQueue.ltail: empty sequence"
+ltailM _ = error "BankersQueue.ltail: empty sequence"
rview (Q i xs (y:ys) j) = return (y, Q i xs ys (j-1))
rview (Q i xs [] _) =
case L.rview xs of
- Nothing -> fail "BankersQueue.rview: empty sequence"
+ Nothing -> error "BankersQueue.rview: empty sequence"
Just (x,xs') -> return (x, Q (i-1) xs' [] 0)
rhead (Q _ _ (y:_) _) = y
@@ -187,7 +187,7 @@
rhead (Q _ xs [] _) = L.rhead xs
rheadM (Q _ _ (y:_) _) = return y
-rheadM (Q _ [] [] _) = fail "BankersQueue.rheadM: empty sequence"
+rheadM (Q _ [] [] _) = error "BankersQueue.rheadM: empty sequence"
rheadM (Q _ xs [] _) = return (L.rhead xs)
rtail (Q i xs (_:ys) j) = Q i xs ys (j-1)
@@ -195,7 +195,7 @@
rtail (Q i xs [] _) = Q (i-1) (L.rtail xs) [] 0
rtailM (Q i xs (_:ys) j) = return (Q i xs ys (j-1))
-rtailM (Q _ [] [] _) = fail "BankersQueue.rtailM: empty sequence"
+rtailM (Q _ [] [] _) = error "BankersQueue.rtailM: empty sequence"
rtailM (Q i xs [] _) = return (Q (i-1) (L.rtail xs) [] 0)
null (Q i _ _ _) = (i == 0)
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/BinaryRandList.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/BinaryRandList.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/BinaryRandList.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/BinaryRandList.hs 2019-04-19 14:10:54.933821577 -0400
@@ -181,7 +181,7 @@
| n == 0 = E
| otherwise = Even (cp (half n) (x,x))
-lview E = fail "BinaryRandList.lview: empty sequence"
+lview E = error "BinaryRandList.lview: empty sequence"
lview (Even ps) = case lview ps of
Just ((x,y), ps') -> return (x, Odd y ps')
Nothing -> error "BinaryRandList.lview: bug!"
@@ -191,7 +191,7 @@
lhead (Even ps) = fst (lhead ps)
lhead (Odd x _) = x
-lheadM E = fail "BinaryRandList.lheadM: empty sequence"
+lheadM E = error "BinaryRandList.lheadM: empty sequence"
lheadM (Even ps) = return (fst (lhead ps))
lheadM (Odd x _) = return (x)
@@ -201,7 +201,7 @@
Nothing -> error "BinaryRandList.ltail: bug!"
ltail (Odd _ ps) = mkEven ps
-ltailM E = fail "BinaryRandList.ltailM: empty sequence"
+ltailM E = error "BinaryRandList.ltailM: empty sequence"
ltailM (Even ps) = case lview ps of
Just ((_,y), ps') -> return (Odd y ps')
Nothing -> error "BinaryRandList.ltailM: bug!"
@@ -212,7 +212,7 @@
rhead (Odd x E) = x
rhead (Odd _ ps) = snd (rhead ps)
-rheadM E = fail "BinaryRandList.rheadM: empty sequence"
+rheadM E = error "BinaryRandList.rheadM: empty sequence"
rheadM (Even ps) = return (snd (rhead ps))
rheadM (Odd x E) = return x
rheadM (Odd _ ps) = return (snd (rhead ps))
@@ -270,10 +270,10 @@
lookup i xs = runIdentity (lookupM i xs)
lookupM i xs
- | i < 0 = fail "BinaryRandList.lookup: bad subscript"
+ | i < 0 = error "BinaryRandList.lookup: bad subscript"
| otherwise = lookFun nothing xs i return
where
- nothing = fail "BinaryRandList.lookup: not found"
+ nothing = error "BinaryRandList.lookup: not found"
lookupWithDefault d i xs
| i < 0 = d
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/BraunSeq.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/BraunSeq.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/BraunSeq.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/BraunSeq.hs 2019-04-19 14:10:16.849494254 -0400
@@ -193,7 +193,7 @@
app _ _ _ = error "BraunSeq.append: bug!"
-- how does it compare to converting to/from lists?
-lview E = fail "BraunSeq.lview: empty sequence"
+lview E = error "BraunSeq.lview: empty sequence"
lview (B x a b) = return (x, combine a b)
-- not exported
@@ -204,13 +204,13 @@
lhead E = error "BraunSeq.lhead: empty sequence"
lhead (B x _ _) = x
-lheadM E = fail "BraunSeq.lheadM: empty sequence"
+lheadM E = error "BraunSeq.lheadM: empty sequence"
lheadM (B x _ _) = return x
ltail E = error "BraunSeq.ltail: empty sequence"
ltail (B _ a b) = combine a b
-ltailM E = fail "BraunSeq.ltailM: empty sequence"
+ltailM E = error "BraunSeq.ltailM: empty sequence"
ltailM (B _ a b) = return (combine a b)
-- not exported
@@ -222,20 +222,20 @@
| otherwise = B x a (delAt (half i - 1) b)
delAt _ _ = error "BraunSeq.delAt: bug. Impossible case!"
-rview E = fail "BraunSeq.rview: empty sequence"
+rview E = error "BraunSeq.rview: empty sequence"
rview xs = return (lookup m xs, delAt m xs)
where m = size xs - 1
rhead E = error "BraunSeq.rhead: empty sequence"
rhead xs = lookup (size xs - 1) xs
-rheadM E = fail "BraunSeq.rheadM: empty sequence"
+rheadM E = error "BraunSeq.rheadM: empty sequence"
rheadM xs = return (lookup (size xs - 1) xs)
rtail E = error "BraunSeq.rtail: empty sequence"
rtail xs = delAt (size xs - 1) xs
-rtailM E = fail "BraunSeq.rtailM: empty sequence"
+rtailM E = error "BraunSeq.rtailM: empty sequence"
rtailM xs = return (delAt (size xs - 1) xs)
null E = True
@@ -347,14 +347,14 @@
lookup i xs = runIdentity (lookupM i xs)
lookupM i xs
- | i < 0 = fail "BraunSeq.lookupM: bad subscript"
+ | i < 0 = error "BraunSeq.lookupM: bad subscript"
| otherwise = look xs i
where look E _ = nothing
look (B x a b) i
| odd i = look a (half i)
| i == 0 = return x
| otherwise = look b (half i - 1)
- nothing = fail "BraunSeq.lookupM: not found"
+ nothing = error "BraunSeq.lookupM: not found"
lookupWithDefault d i xs = if i < 0 then d
else look xs i
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/Defaults.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/Defaults.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/Defaults.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/Defaults.hs 2019-04-19 14:09:11.124929205 -0400
@@ -35,7 +35,7 @@
rviewDefault :: (Monad m, Sequence s) => s a -> m (a, s a)
rviewDefault xs
- | null xs = fail $ instanceName xs ++ ".rview: empty sequence"
+ | null xs = error $ instanceName xs ++ ".rview: empty sequence"
| otherwise = return (rhead xs, rtail xs)
@@ -52,7 +52,7 @@
rtailMUsingLview :: (Monad m,Sequence s) => s a -> m (s a)
rtailMUsingLview xs =
case lview xs of
- Nothing -> fail $ instanceName xs ++ ".rtailM: empty sequence"
+ Nothing -> error $ instanceName xs ++ ".rtailM: empty sequence"
Just (x, xs) -> return (rt x xs)
where rt x xs =
case lview xs of
@@ -223,7 +223,7 @@
lookupMUsingDrop :: (Monad m, Sequence s) => Int -> s a -> m a
lookupMUsingDrop i s
-- XXX better error message!
- | i < 0 || null s' = fail $ instanceName s
+ | i < 0 || null s' = error $ instanceName s
++ ".lookupMUsingDrop: empty sequence"
| otherwise = return (lhead s')
where s' = drop i s
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/FingerSeq.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/FingerSeq.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/FingerSeq.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/FingerSeq.hs 2019-04-19 14:27:49.618572817 -0400
@@ -243,7 +243,7 @@
case FT.splitTree (> (SizeM i)) (SizeM 0) xs of
FT.Split _ (Elem x) _ -> return x
- | otherwise = fail "FingerSeq.lookupM: index out of bounds"
+ | otherwise = error "FingerSeq.lookupM: index out of bounds"
lookupWithDefault d i (Seq xs)
| inBounds i (Seq xs) =
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/JoinList.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/JoinList.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/JoinList.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/JoinList.hs 2019-04-19 14:28:45.083050856 -0400
@@ -162,7 +162,7 @@
-- path reversal on lview/ltail
-lview E = fail "JoinList.lview: empty sequence"
+lview E = error "JoinList.lview: empty sequence"
lview (L x) = return (x, E)
lview (A xs ys) = lvw xs ys
where lvw E _ = error "JoinList.lvw: bug"
@@ -173,7 +173,7 @@
lhead (L x) = x
lhead (A xs _) = lhead xs
-lheadM E = fail "JoinList.lheadM: empty sequence"
+lheadM E = error "JoinList.lheadM: empty sequence"
lheadM (L x) = return x
lheadM (A xs _) = lheadM xs
@@ -184,7 +184,7 @@
ltl (L _) zs = zs
ltl (A xs ys) zs = ltl xs (A ys zs)
-ltailM E = fail "JoinList.ltailM: empty sequence"
+ltailM E = error "JoinList.ltailM: empty sequence"
ltailM (L _) = return E
ltailM (A xs ys) = return (ltl xs ys)
where ltl E _ = error "JoinList.ltl: bug"
@@ -196,7 +196,7 @@
-- that left accesses are more common, so we would prefer to keep the left
-- spine short.
-rview E = fail "JoinLis.rview: empty sequence"
+rview E = error "JoinLis.rview: empty sequence"
rview (L x) = return (x, E)
rview (A xs ys) = rvw xs ys
where rvw xs (A ys (A zs s)) = rvw (A xs (A ys zs)) s
@@ -208,7 +208,7 @@
rhead (L x) = x
rhead (A _ ys) = rhead ys
-rheadM E = fail "JoinList.rheadM: empty sequence"
+rheadM E = error "JoinList.rheadM: empty sequence"
rheadM (L x) = return x
rheadM (A _ ys) = rheadM ys
@@ -220,7 +220,7 @@
rtl xs (L _) = xs
rtl _ _ = error "JoinList.rtl: bug"
-rtailM E = fail "JoinList.rtailM: empty sequence"
+rtailM E = error "JoinList.rtailM: empty sequence"
rtailM (L _) = return E
rtailM (A xs ys) = return (rtl xs ys)
where rtl xs (A ys (A zs s)) = A (A xs ys) (rtl zs s)
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/MyersStack.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/MyersStack.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/MyersStack.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/MyersStack.hs 2019-04-19 14:29:37.987506639 -0400
@@ -151,22 +151,22 @@
| i == j = C (1 + i + j) x xs xs'
lcons x xs = C 1 x xs xs
-lview E = fail "MyersStack.lview: empty sequence"
+lview E = error "MyersStack.lview: empty sequence"
lview (C _ x xs _) = return (x, xs)
lhead E = error "MyersStack.lhead: empty sequence"
lhead (C _ x _ _) = x
-lheadM E = fail "MyersStack.lheadM: empty sequence"
+lheadM E = error "MyersStack.lheadM: empty sequence"
lheadM (C _ x _ _) = return x
ltail E = error "MyersStack.ltail: empty sequence"
ltail (C _ _ xs _) = xs
-ltailM E = fail "MyersStack.ltailM: empty sequence"
+ltailM E = error "MyersStack.ltailM: empty sequence"
ltailM (C _ _ xs _) = return xs
-rview E = fail "MyersStack.rview: empty sequence"
+rview E = error "MyersStack.rview: empty sequence"
rview xs = return (rhead xs, rtail xs)
rhead E = error "MyersStack.rhead: empty sequence"
@@ -175,7 +175,7 @@
rh _ (C _ y ys ys') E = rh y ys ys'
rh x E E = x
-rheadM E = fail "MyersStack.rheadM: empty sequence"
+rheadM E = error "MyersStack.rheadM: empty sequence"
rheadM (C _ x xs xs') = return (rh x xs xs')
where rh _ _ (C _ y ys ys') = rh y ys ys'
rh _ (C _ y ys ys') E = rh y ys ys'
@@ -186,7 +186,7 @@
where rt _ E = E
rt y (C _ x xs _) = lcons y (rt x xs)
-rtailM E = fail "MyersStack.rtailM: empty sequence"
+rtailM E = error "MyersStack.rtailM: empty sequence"
rtailM (C _ x xs _) = return (rt x xs)
where rt _ E = E
rt y (C _ x xs _) = lcons y (rt x xs)
@@ -249,13 +249,13 @@
lookup i xs = runIdentity (lookupM i xs)
lookupM i xs = look xs i
- where look E _ = fail "MyersStack.lookup: bad subscript"
+ where look E _ = error "MyersStack.lookup: bad subscript"
look (C j x xs xs') i
| i >= j = look xs' (i - j)
| i > 0 = look xs (i - 1)
| i == 0 = return x
| otherwise = nothing
- nothing = fail "MyersStack.lookup: not found"
+ nothing = error "MyersStack.lookup: not found"
lookupWithDefault d i xs = look xs i
where look E _ = d
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/RandList.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/RandList.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/RandList.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/RandList.hs 2019-04-19 14:33:51.057684970 -0400
@@ -166,7 +166,7 @@
child (T _ _ t) = t
child _ = error "RandList.copy: bug!"
-lview E = fail "RandList.lview: empty sequence"
+lview E = error "RandList.lview: empty sequence"
lview (C _ (L x) xs) = return (x, xs)
lview (C i (T x s t) xs) = return (x, C j s (C j t xs))
where j = half i
@@ -175,7 +175,7 @@
lhead (C _ (L x) _) = x
lhead (C _ (T x _ _) _) = x
-lheadM E = fail "RandList.lheadM: empty sequence"
+lheadM E = error "RandList.lheadM: empty sequence"
lheadM (C _ (L x) _) = return x
lheadM (C _ (T x _ _) _) = return x
@@ -184,7 +184,7 @@
ltail (C i (T _ s t) xs) = C j s (C j t xs)
where j = half i
-ltailM E = fail "RandList.ltailM: empty sequence"
+ltailM E = error "RandList.ltailM: empty sequence"
ltailM (C _ (L _) xs) = return xs
ltailM (C i (T _ s t) xs) = return (C j s (C j t xs))
where j = half i
@@ -195,7 +195,7 @@
treeLast (T _ _ t) = treeLast t
rhead (C _ _ xs) = rhead xs
-rheadM E = fail "RandList.rhead: empty sequence"
+rheadM E = error "RandList.rhead: empty sequence"
rheadM (C _ t E) = return(treeLast t)
where treeLast (L x) = x
treeLast (T _ _ t) = treeLast t
@@ -272,7 +272,7 @@
lookup i xs = runIdentity (lookupM i xs)
lookupM i xs = look xs i
- where look E _ = fail "RandList.lookup bad subscript"
+ where look E _ = error "RandList.lookup bad subscript"
look (C j t xs) i
| i < j = lookTree j t i
| otherwise = look xs (i - j)
@@ -285,7 +285,7 @@
| i /= 0 = lookTree k s (i - 1)
| otherwise = return x
where k = half j
- nothing = fail "RandList.lookup: not found"
+ nothing = error "RandList.lookup: not found"
lookupWithDefault d i xs = look xs i
where look E _ = d
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/RevSeq.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/RevSeq.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/RevSeq.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/RevSeq.hs 2019-04-19 14:35:45.666670672 -0400
@@ -167,7 +167,7 @@
append (N m xs) (N n ys) = N (m+n+1) (S.append ys xs)
lview (N m xs) = case S.rview xs of
- Nothing -> fail "RevSeq.lview: empty sequence"
+ Nothing -> error "RevSeq.lview: empty sequence"
Just (x,xs) -> return (x, N (m-1) xs)
lhead (N _ xs) = S.rhead xs
@@ -177,11 +177,11 @@
ltail (N (-1) _) = error "RevSeq.ltail: empty sequence"
ltail (N m xs) = N (m-1) (S.rtail xs)
-ltailM (N (-1) _) = fail "RevSeq.ltailM: empty sequence"
+ltailM (N (-1) _) = error "RevSeq.ltailM: empty sequence"
ltailM (N m xs) = return (N (m-1) (S.rtail xs))
rview (N m xs) = case S.lview xs of
- Nothing -> fail "RevSeq.rview: empty sequence"
+ Nothing -> error "RevSeq.rview: empty sequence"
Just (x,xs) -> return (x, N (m-1) xs)
rhead (N _ xs) = S.lhead xs
@@ -191,7 +191,7 @@
rtail (N (-1) _) = error "RevSeq.rtail: empty sequence"
rtail (N m xs) = N (m-1) (S.ltail xs)
-rtailM (N (-1) _) = fail "RevSeq.rtailM: empty sequence"
+rtailM (N (-1) _) = error "RevSeq.rtailM: empty sequence"
rtailM (N m xs) = return (N (m-1) (S.ltail xs))
null (N m _) = m == -1
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/SimpleQueue.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/SimpleQueue.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/SimpleQueue.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/SimpleQueue.hs 2019-04-19 14:36:21.446978325 -0400
@@ -159,14 +159,14 @@
append (Q xs1 ys1) (Q xs2 ys2) =
Q (xs1 ++ L.reverseOnto ys1 xs2) ys2
-lview (Q [] _) = fail "SimpleQueue.lview: empty sequence"
+lview (Q [] _) = error "SimpleQueue.lview: empty sequence"
lview (Q [x] ys) = return (x, Q (L.reverse ys) [])
lview (Q (x:xs) ys) = return (x, Q xs ys)
lhead (Q [] _) = error "SimpleQueue.lhead: empty sequence"
lhead (Q (x:_) _) = x
-lheadM (Q [] _) = fail "SimpleQueue.lheadM: empty sequence"
+lheadM (Q [] _) = error "SimpleQueue.lheadM: empty sequence"
lheadM (Q (x:_) _) = return x
ltail (Q [_] ys) = Q (L.reverse ys) []
@@ -175,12 +175,12 @@
ltailM (Q [_] ys) = return (Q (L.reverse ys) [])
ltailM (Q (_:xs) ys) = return (Q xs ys)
-ltailM (Q [] _) = fail "SimpleQueue.ltailM: empty sequence"
+ltailM (Q [] _) = error "SimpleQueue.ltailM: empty sequence"
rview (Q xs (y:ys)) = return (y, Q xs ys)
rview (Q xs []) =
case L.rview xs of
- Nothing -> fail "SimpleQueue.rview: empty sequence"
+ Nothing -> error "SimpleQueue.rview: empty sequence"
Just (x,xs') -> return (x, Q xs' [])
rhead (Q _ (y:_)) = y
@@ -188,7 +188,7 @@
rhead (Q xs []) = L.rhead xs
rheadM (Q _ (y:_)) = return y
-rheadM (Q [] []) = fail "SimpleQueue.rheadM: empty sequence"
+rheadM (Q [] []) = error "SimpleQueue.rheadM: empty sequence"
rheadM (Q xs []) = return (L.rhead xs)
rtail (Q xs (_:ys)) = Q xs ys
@@ -196,7 +196,7 @@
rtail (Q xs []) = Q (L.rtail xs) []
rtailM (Q xs (_:ys)) = return (Q xs ys)
-rtailM (Q [] []) = fail "SimpleQueue.rtailM: empty sequence"
+rtailM (Q [] []) = error "SimpleQueue.rtailM: empty sequence"
rtailM (Q xs []) = return (Q (L.rtail xs) [])
null (Q [] _) = True
diff -ru EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/SizedSeq.hs EdisonCore-1.3.2.1/src/Data/Edison/Seq/SizedSeq.hs
--- EdisonCore-1.3.2.1.orig/src/Data/Edison/Seq/SizedSeq.hs 2018-01-05 02:46:48.000000000 -0500
+++ EdisonCore-1.3.2.1/src/Data/Edison/Seq/SizedSeq.hs 2019-04-19 14:36:46.459193369 -0400
@@ -156,7 +156,7 @@
append (N m xs) (N n ys) = N (m+n) (S.append xs ys)
lview (N n xs) = case S.lview xs of
- Nothing -> fail "SizedSeq.lview: empty sequence"
+ Nothing -> error "SizedSeq.lview: empty sequence"
Just (x,xs) -> return (x, N (n-1) xs)
lhead (N _ xs) = S.lhead xs
@@ -166,11 +166,11 @@
ltail (N 0 _) = error "SizedSeq.ltail: empty sequence"
ltail (N n xs) = N (n-1) (S.ltail xs)
-ltailM (N 0 _) = fail "SizedSeq.ltailM: empty sequence"
+ltailM (N 0 _) = error "SizedSeq.ltailM: empty sequence"
ltailM (N n xs) = return (N (n-1) (S.ltail xs))
rview (N n xs) = case S.rview xs of
- Nothing -> fail "SizedSeq.rview: empty sequence"
+ Nothing -> error "SizedSeq.rview: empty sequence"
Just (x,xs) -> return (x, N (n-1) xs)
rhead (N _ xs) = S.rhead xs
@@ -180,7 +180,7 @@
rtail (N 0 _) = error "SizedSeq.rtail: empty sequence"
rtail (N n xs) = N (n-1) (S.rtail xs)
-rtailM (N 0 _) = fail "SizedSeq.rtailM: empty sequence"
+rtailM (N 0 _) = error "SizedSeq.rtailM: empty sequence"
rtailM (N n xs) = return (N (n-1) (S.rtail xs))
null (N n _) = n == 0
patches/FPretty-1.1.patch
View file @ 4847b274
diff -ru FPretty-1.1.orig/Text/PrettyPrint/FPretty.hs FPretty-1.1/Text/PrettyPrint/FPretty.hs
--- FPretty-1.1.orig/Text/PrettyPrint/FPretty.hs 2015-11-16 08:34:29.000000000 -0500
+++ FPretty-1.1/Text/PrettyPrint/FPretty.hs 2018-01-16 18:12:17.694618006 -0500
@@ -112,7 +112,11 @@
diff --git a/Text/PrettyPrint/FPretty.hs b/Text/PrettyPrint/FPretty.hs
index f2c0001..6138d3f 100644
--- a/Text/PrettyPrint/FPretty.hs
+++ b/Text/PrettyPrint/FPretty.hs
@@ -112,7 +112,11 @@ module Text.PrettyPrint.FPretty
#if __GLASGOW_HASKELL__ >= 710
-- The base libraries from GHC 7.10 onwards export <$> as synonym for fmap.
......
patches/FontyFruity-0.5.3.4.patch deleted 100644 → 0
View file @ 76f9ba89
diff -ru FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/CharacterMap.hs FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/CharacterMap.hs
--- FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/CharacterMap.hs 2015-04-25 05:01:06.000000000 -0400
+++ FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/CharacterMap.hs 2019-03-16 06:48:06.693682922 -0400
@@ -102,7 +102,7 @@
rnf (CharacterMaps maps) = rnf maps `seq` ()
instance Binary CharacterMaps where
- put _ = fail "Unimplemented"
+ put _ = error "Unimplemented"
get = do
startIndex <- bytesRead
versionNumber <- getWord16be
@@ -192,7 +192,7 @@
compare _ _ = GT
instance Binary CharacterTable where
- put _ = fail "Binary.put CharacterTable - Unimplemented"
+ put _ = error "Binary.put CharacterTable - Unimplemented"
get = do
format <- getWord16be
case format of
@@ -305,7 +305,7 @@
langIdOfCharMap = _format0Language
instance Binary Format0 where
- put _ = fail "Binary.Format0.put - unimplemented"
+ put _ = error "Binary.Format0.put - unimplemented"
get = do
tableSize <- getWord16be
when (tableSize /= 262) $
@@ -347,7 +347,7 @@
instance Binary Format2 where
- put _ = fail "Format2.put - unimplemented"
+ put _ = error "Format2.put - unimplemented"
get = do
_tableSize <- getWord16be
lang <- getWord16be
@@ -376,7 +376,7 @@
langIdOfCharMap = _format6Language
instance Binary Format6 where
- put _ = fail "Format6.put - unimplemented"
+ put _ = error "Format6.put - unimplemented"
get = do
_length <- getWord16be
language <- getWord16be
diff -ru FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/Glyph.hs FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/Glyph.hs
--- FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/Glyph.hs 2017-06-29 17:15:33.000000000 -0400
+++ FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/Glyph.hs 2019-03-16 06:47:22.845370697 -0400
@@ -313,7 +313,7 @@
where breaker array ix = VU.splitAt (fromIntegral ix + 1) array
instance Binary Glyph where
- put _ = fail "Glyph.put - unimplemented"
+ put _ = error "Glyph.put - unimplemented"
get = do
hdr <- get
case _glfNumberOfContours hdr of
diff -ru FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/Header.hs FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/Header.hs
--- FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/Header.hs 2016-01-05 16:09:02.000000000 -0500
+++ FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/Header.hs 2019-03-16 06:48:33.605875180 -0400
@@ -100,7 +100,7 @@
rnf (FontHeader {}) = ()
instance Binary FontHeader where
- put _ = fail "Unimplemented"
+ put _ = error "Unimplemented"
get =
FontHeader <$> get <*> get <*> g32 <*> g32 <*> get
<*> g16 <*> g64 <*> g64 <*> get <*> get
diff -ru FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/MaxpTable.hs FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/MaxpTable.hs
--- FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/MaxpTable.hs 2015-04-25 05:01:06.000000000 -0400
+++ FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/MaxpTable.hs 2019-03-16 06:48:26.633825328 -0400
@@ -50,7 +50,7 @@
rnf (MaxpTable {}) = ()
instance Binary MaxpTable where
- put _ = fail "Unimplemented"
+ put _ = error "Unimplemented"
get = MaxpTable
<$> get <*> g16 <*> g16 <*> g16 <*> g16 <*> g16
<*> g16 <*> g16 <*> g16 <*> g16 <*> g16 <*> g16
diff -ru FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/Name.hs FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/Name.hs
--- FontyFruity-0.5.3.4.orig/src/Graphics/Text/TrueType/Name.hs 2015-04-25 05:01:06.000000000 -0400
+++ FontyFruity-0.5.3.4/src/Graphics/Text/TrueType/Name.hs 2019-03-16 06:48:14.853741168 -0400
@@ -35,7 +35,7 @@
rnf (NameTable {}) = ()
instance Binary NameTable where
- put _ = fail "Binary.put NameTable - unimplemented"
+ put _ = error "Binary.put NameTable - unimplemented"
get = do
nameFormatId <- getWord16be
when (nameFormatId /= 0) $
patches/HTTP-4000.3.13.patch deleted 100644 → 0
View file @ 76f9ba89
diff -ru HTTP-4000.3.13.orig/Network/Browser.hs HTTP-4000.3.13/Network/Browser.hs
--- HTTP-4000.3.13.orig/Network/Browser.hs 2019-03-17 07:46:06.000000000 -0400
+++ HTTP-4000.3.13/Network/Browser.hs 2019-03-23 09:56:07.221275392 -0400
@@ -143,6 +143,7 @@
#else
import Control.Monad (filterM, forM_, when)
#endif
+import qualified Control.Monad.Fail as Fail
import Control.Monad.State (StateT (..), MonadIO (..), modify, gets, withStateT, evalStateT, MonadState (..))
import qualified System.IO
@@ -416,13 +417,13 @@
newtype BrowserAction conn a
= BA { unBA :: StateT (BrowserState conn) IO a }
#ifdef MTL1
- deriving (Functor, Monad, MonadIO, MonadState (BrowserState conn))
+ deriving (Functor, Monad, MonadIO, MonadState (BrowserState conn), Fail.MonadFail)
instance Applicative (BrowserAction conn) where
pure = return
(<*>) = ap
#else
- deriving (Functor, Applicative, Monad, MonadIO, MonadState (BrowserState conn))
+ deriving (Functor, Applicative, Monad, MonadIO, MonadState (BrowserState conn), Fail.MonadFail)
#endif
runBA :: BrowserState conn -> BrowserAction conn a -> IO a
diff -ru HTTP-4000.3.13.orig/Network/HTTP/Base.hs HTTP-4000.3.13/Network/HTTP/Base.hs
--- HTTP-4000.3.13.orig/Network/HTTP/Base.hs 2019-03-17 07:46:06.000000000 -0400
+++ HTTP-4000.3.13/Network/HTTP/Base.hs 2019-03-23 09:55:00.736769582 -0400
@@ -108,6 +108,7 @@
import Control.Monad ( guard )
import Control.Monad.Error.Class ()
+import qualified Control.Monad.Fail as Fail
import Data.Bits ( (.&.), (.|.), shiftL, shiftR )
import Data.Word ( Word8 )
import Data.Char ( digitToInt, intToDigit, toLower, isDigit,
@@ -209,7 +210,7 @@
default_http = 80
default_https = 443
-failHTTPS :: Monad m => URI -> m ()
+failHTTPS :: Fail.MonadFail m => URI -> m ()
failHTTPS uri
| map toLower (uriScheme uri) == "https:" = fail "https not supported"
| otherwise = return ()
@@ -713,7 +714,7 @@
-- | @getAuth req@ fishes out the authority portion of the URL in a request's @Host@
-- header.
-getAuth :: Monad m => Request ty -> m URIAuthority
+getAuth :: Fail.MonadFail m => Request ty -> m URIAuthority
getAuth r =
-- ToDo: verify that Network.URI functionality doesn't take care of this (now.)
case parseURIAuthority auth of
patches/HsYAML-0.1.1.3.patch deleted 100644 → 0
View file @ 76f9ba89
commit 12031cb665d5dc365ae3ea7dee6df23badcc740e
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri May 17 13:52:00 2019 -0400
Adapt to base-4.13.0.0
diff --git a/src/Data/YAML.hs b/src/Data/YAML.hs
index 9eb3a66..46ad654 100644
--- a/src/Data/YAML.hs
+++ b/src/Data/YAML.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}
@@ -211,7 +212,9 @@ instance Monad Parser where
return = pure
P m >>= k = P (m >>= unP . k)
(>>) = (*>)
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
+#endif
-- | @since 0.1.1.0
instance Fail.MonadFail Parser where
diff --git a/src/Data/YAML/Token.hs b/src/Data/YAML/Token.hs
index df3e95e..ff9d0f9 100644
--- a/src/Data/YAML/Token.hs
+++ b/src/Data/YAML/Token.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
@@ -24,6 +25,7 @@ module Data.YAML.Token
, Code(..)
) where
+import qualified Control.Monad.Fail as Fail
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.DList as D
import Prelude hiding ((*), (+), (-), (/), (^))
@@ -442,6 +444,12 @@ instance Monad Parser where
(>>) = (*>)
+#if !(MIN_VERSION_base(4,13,0))
+ -- @fail message@ does just that - fails with a /message/.
+ fail = Fail.fail
+#endif
+
+instance Fail.MonadFail Parser where
-- @fail message@ does just that - fails with a /message/.
fail message = Parser $ \state -> failReply state message
patches/JuicyPixels-3.3.3.cabal deleted 100644 → 0
View file @ 76f9ba89
Name: JuicyPixels
Version: 3.3.3
x-revision: 1
Synopsis: Picture loading/serialization (in png, jpeg, bitmap, gif, tga, tiff and radiance)
Description:
<<data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAMAAAADABAMAAACg8nE0AAAAElBMVEUAAABJqDSTWEL/qyb///8AAABH/1GTAAAAAXRSTlMAQObYZgAAAN5JREFUeF7s1sEJgFAQxFBbsAV72v5bEVYWPwT/XDxmCsi7zvHXavYREBDI3XP2GgICqBBYuwIC+/rVayPUAyAg0HvIXBcQoDFDGnUBgWQQ2Bx3AYFaRoBpAQHWb3bt2ARgGAiCYFFuwf3X5HA/McgGJWI2FdykCv4aBYzmKwDwvl6NVmUAAK2vlwEALK7fo88GANB6HQsAAAAAAAAA7P94AQCzswEAAAAAAAAAAAAAAAAAAICzh4UAO4zWAYBfRutHA4Bn5C69JhowAMGoBaMWDG0wCkbBKBgFo2AUAACPmegUST/IJAAAAABJRU5ErkJggg==>>
.
This library can load and store images in PNG,Bitmap, Jpeg, Radiance, Tiff and Gif images.
homepage: https://github.com/Twinside/Juicy.Pixels
License: BSD3
License-file: LICENSE
Author: Vincent Berthoux
Maintainer: vincent.berthoux@gmail.com
Category: Codec, Graphics, Image
Stability: Stable
Build-type: Simple
-- Constraint on the version of Cabal needed to build this package.
Cabal-version: >= 1.18
extra-source-files: changelog, docimages/*.png, docimages/*.svg, README.md
extra-doc-files: docimages/*.png, docimages/*.svg
Source-Repository head
Type: git
Location: git://github.com/Twinside/Juicy.Pixels.git
Source-Repository this
Type: git
Location: git://github.com/Twinside/Juicy.Pixels.git
Tag: v3.3.3
Flag Mmap
Description: Enable the file loading via mmap (memory map)
Default: False
Library
hs-source-dirs: src
Default-Language: Haskell2010
Exposed-modules: Codec.Picture,
Codec.Picture.Bitmap,
Codec.Picture.Gif,
Codec.Picture.Png,
Codec.Picture.Jpg,
Codec.Picture.HDR,
Codec.Picture.Tga,
Codec.Picture.Tiff,
Codec.Picture.Metadata,
Codec.Picture.Metadata.Exif,
Codec.Picture.Saving,
Codec.Picture.Types,
Codec.Picture.ColorQuant,
Codec.Picture.Jpg.Internal.DefaultTable,
Codec.Picture.Jpg.Internal.Metadata,
Codec.Picture.Jpg.Internal.FastIdct,
Codec.Picture.Jpg.Internal.FastDct,
Codec.Picture.Jpg.Internal.Types,
Codec.Picture.Jpg.Internal.Common,
Codec.Picture.Jpg.Internal.Progressive,
Codec.Picture.Gif.Internal.LZW,
Codec.Picture.Gif.Internal.LZWEncoding,
Codec.Picture.Png.Internal.Export,
Codec.Picture.Png.Internal.Type,
Codec.Picture.Png.Internal.Metadata,
Codec.Picture.Tiff.Internal.Metadata,
Codec.Picture.Tiff.Internal.Types
Ghc-options: -O3 -Wall
Build-depends: base >= 4.11 && < 5,
bytestring >= 0.9 && < 0.11,
mtl >= 1.1 && < 2.3,
binary >= 0.5 && < 0.9,
zlib >= 0.5.3.1 && < 0.7,
transformers >= 0.2,
vector >= 0.10 && < 0.13,
primitive >= 0.4 && < 0.7,
deepseq >= 1.1 && < 1.5,
containers >= 0.4.2 && < 0.7
-- Modules not exported by this package.
Other-modules: Codec.Picture.BitWriter,
Codec.Picture.InternalHelper,
Codec.Picture.VectorByteConversion
Install-Includes: src/Codec/Picture/ConvGraph.hs
Include-Dirs: src/Codec/Picture
patches/JuicyPixels-3.3.3.patch deleted 100644 → 0
View file @ 76f9ba89
diff -ru JuicyPixels-3.3.3.orig/src/Codec/Picture/Bitmap.hs JuicyPixels-3.3.3/src/Codec/Picture/Bitmap.hs
--- JuicyPixels-3.3.3.orig/src/Codec/Picture/Bitmap.hs 2018-12-16 16:36:06.000000000 -0500
+++ JuicyPixels-3.3.3/src/Codec/Picture/Bitmap.hs 2019-03-16 08:05:10.530793764 -0400
@@ -26,6 +26,7 @@
import Control.Arrow( first )
import Control.Monad( replicateM, when, foldM_, forM_, void )
+import qualified Control.Monad.Fail as Fail
import Control.Monad.ST ( ST, runST )
import Data.Maybe( fromMaybe )
import qualified Data.Vector.Storable as VS
@@ -884,7 +885,7 @@
a -> fail $ "Can't handle BMP file " ++ show a
-- | Decode a bitfield. Will fail if the bitfield is empty.
-getBitfield :: (FiniteBits t, Integral t, Num t, Monad m) => t -> m (Bitfield t)
+getBitfield :: (FiniteBits t, Integral t, Num t, Fail.MonadFail m) => t -> m (Bitfield t)
getBitfield 0 = fail $
"Codec.Picture.Bitmap.getBitfield: bitfield cannot be 0"
getBitfield w = return (makeBitfield w)
diff -ru JuicyPixels-3.3.3.orig/src/Codec/Picture/Jpg.hs JuicyPixels-3.3.3/src/Codec/Picture/Jpg.hs
--- JuicyPixels-3.3.3.orig/src/Codec/Picture/Jpg.hs 2018-12-16 16:36:06.000000000 -0500
+++ JuicyPixels-3.3.3/src/Codec/Picture/Jpg.hs 2019-03-16 08:05:34.710988437 -0400
@@ -309,7 +309,7 @@
scanSpecifier scanCount scanSpec = do
compMapping <- gets componentIndexMapping
comp <- case lookup (componentSelector scanSpec) compMapping of
- Nothing -> fail "Jpg decoding error - bad component selector in blob."
+ Nothing -> error "Jpg decoding error - bad component selector in blob."
Just v -> return v
let maximumHuffmanTable = 4
dcIndex = min (maximumHuffmanTable - 1)
@@ -326,7 +326,7 @@
frameInfo <- gets currentFrame
blobId <- gets seenBlobs
case frameInfo of
- Nothing -> fail "Jpg decoding error - no previous frame"
+ Nothing -> error "Jpg decoding error - no previous frame"
Just v -> do
let compDesc = jpgComponents v !! comp
compCount = length $ jpgComponents v
patches/JuicyPixels-3.3.8.patch 0 → 100644
View file @ 4847b274
diff --git a/src/Codec/Picture/Metadata.hs b/src/Codec/Picture/Metadata.hs
index a7b5014..bfbd553 100644
--- a/src/Codec/Picture/Metadata.hs
+++ b/src/Codec/Picture/Metadata.hs
@@ -43,6 +43,7 @@ module Codec.Picture.Metadata( -- * Types
, dotsPerCentiMeterToDotPerInch
) where
+import Prelude hiding (foldl')
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid( Monoid, mempty, mappend )
import Data.Word( Word )
patches/QuickCheck-2.13.1.patch deleted 100644 → 0
View file @ 76f9ba89
commit d8126acd23b70c225c591d40a18a1d6b7833bbab
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri Mar 29 06:46:04 2019 -0400
Adapt to base-4.13.0.0
diff --git a/Test/QuickCheck/Monadic.hs b/Test/QuickCheck/Monadic.hs
index a8f3043..23153f2 100644
--- a/Test/QuickCheck/Monadic.hs
+++ b/Test/QuickCheck/Monadic.hs
@@ -123,7 +123,9 @@ instance Applicative (PropertyM m) where
instance Monad m => Monad (PropertyM m) where
return = pure
(>>=) = bind
+#if !defined(NO_MONADFAIL) && !(MIN_VERSION_base(4,13,0))
fail = fail_
+#endif
#ifndef NO_MONADFAIL
instance Monad m => Fail.MonadFail (PropertyM m) where
patches/STMonadTrans-0.4.3.cabal deleted 100644 → 0
View file @ 76f9ba89
name: STMonadTrans
version: 0.4.3
x-revision: 1
cabal-version: >= 1.8
license: BSD3
license-file: LICENSE
author: Josef Svenningsson
maintainer: josef.svenningsson@gmail.com
category: Monads
build-type: Simple
synopsis: A monad transformer version of the ST monad
description:
A monad transformer version of the ST monad
Warning! This monad transformer should not be used with monads that
can contain multiple answers, like the list monad. The reason is that
the state token will be duplicated across the different answers and
this causes Bad Things to happen (such as loss of referential
transparency). Safe monads include the monads State, Reader, Writer,
Maybe and combinations of their corresponding monad transformers.
extra-source-files:
changelog.md
source-repository head
type: git
location: https://github.com/josefs/STMonadTrans
flag splitBase
description: Choose the new smaller, split-up base package.
library
build-depends: base >= 4.6
if flag(splitBase)
build-depends: base >= 3, base < 5, mtl, array
else
build-depends: base < 3
exposed-modules:
Control.Monad.ST.Trans,
Control.Monad.ST.Trans.Internal
extensions: CPP, MagicHash, UnboxedTuples, Rank2Types, FlexibleInstances,
MultiParamTypeClasses, UndecidableInstances
Test-Suite foo
type: detailed-0.9
hs-source-dirs: test
test-module: Test
build-depends: STMonadTrans, base, mtl, array, Cabal
patches/STMonadTrans-0.4.3.patch deleted 100644 → 0
View file @ 76f9ba89
diff -ru STMonadTrans-0.4.3.orig/Control/Monad/ST/Trans/Internal.hs STMonadTrans-0.4.3/Control/Monad/ST/Trans/Internal.hs
--- STMonadTrans-0.4.3.orig/Control/Monad/ST/Trans/Internal.hs 2017-02-09 08:18:16.000000000 -0500
+++ STMonadTrans-0.4.3/Control/Monad/ST/Trans/Internal.hs 2019-04-19 13:40:49.646093718 -0400
@@ -1,5 +1,5 @@
{-# LANGUAGE MagicHash, UnboxedTuples, Rank2Types, FlexibleInstances,
- MultiParamTypeClasses, UndecidableInstances, RecursiveDo #-}
+ MultiParamTypeClasses, UndecidableInstances, RecursiveDo, CPP #-}
{- |
Module : Control.Monad.ST.Trans
Copyright : Josef Svenningsson 2008-2010
@@ -26,6 +26,7 @@
import GHC.Base
import GHC.ST hiding (liftST)
+import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.Trans
import Control.Monad.Error.Class
@@ -69,7 +70,12 @@
case ret of
STTRet new_st a ->
unSTT (k a) new_st
+#if !(MIN_VERSION_base(4,13,0))
fail msg = lift (fail msg)
+#endif
+
+instance Fail.MonadFail m => Fail.MonadFail (STT s m) where
+ fail msg = lift (Fail.fail msg)
instance MonadTrans (STT s) where
lift m = STT $ \st ->
patches/Unixutils-1.54.1.patch deleted 100644 → 0
View file @ 76f9ba89
diff -ru Unixutils-1.54.1.orig/System/Unix/Chroot.hs Unixutils-1.54.1/System/Unix/Chroot.hs
--- Unixutils-1.54.1.orig/System/Unix/Chroot.hs 2015-08-11 16:02:44.000000000 -0400
+++ Unixutils-1.54.1/System/Unix/Chroot.hs 2018-07-04 21:18:53.544302297 -0400
@@ -1,4 +1,4 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
-- | This module, except for useEnv, is copied from the build-env package.
module System.Unix.Chroot
( fchroot
@@ -45,7 +45,11 @@
fchroot :: (MonadIO m, MonadMask m) => FilePath -> m a -> m a
fchroot path action =
do origWd <- liftIO $ getWorkingDirectory
- rootFd <- liftIO $ openFd "/" ReadOnly Nothing defaultFileFlags
+ rootFd <- liftIO $ openFd "/" ReadOnly
+#if !(MIN_VERSION_unix(2,8,0))
+ Nothing
+#endif
+ defaultFileFlags
liftIO $ chroot path
liftIO $ changeWorkingDirectory "/"
action `finally` (liftIO $ breakFree origWd rootFd)
patches/Yampa-0.13.patch deleted 100644 → 0
View file @ 76f9ba89
commit e1fd4b583d8a09d54e089fe2b89e921d3b854182
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri Mar 15 18:49:39 2019 -0400
Adapt to base-4.13.0.0
diff --git a/src/FRP/Yampa/Event.hs b/src/FRP/Yampa/Event.hs
index 804fe46..0639f3f 100644
--- a/src/FRP/Yampa/Event.hs
+++ b/src/FRP/Yampa/Event.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
-----------------------------------------------------------------------------------------
-- |
@@ -90,6 +91,7 @@ module FRP.Yampa.Event where
import Control.Applicative
import Control.DeepSeq (NFData(..))
+import qualified Control.Monad.Fail as Fail
import FRP.Yampa.Diagnostics
@@ -175,9 +177,14 @@ instance Monad Event where
-- | See 'pure'.
return = pure
+#if !(MIN_VERSION_base(4,13,0))
-- | Fail with 'NoEvent'.
- fail _ = NoEvent
+ fail = Fail.fail
+#endif
+instance Fail.MonadFail Event where
+ -- | Fail with 'NoEvent'.
+ fail _ = NoEvent
-- | Alternative instance
instance Alternative Event where
patches/aeson-1.4.3.0.patch deleted 100644 → 0
View file @ 76f9ba89
commit 194eaa0d3dbafd593eeb12deb57374476a1adf4f
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri Mar 15 18:27:52 2019 -0400
Adapt to base-4.13.0.0
diff --git a/Data/Aeson/Types/Internal.hs b/Data/Aeson/Types/Internal.hs
index abe5afc..319225c 100644
--- a/Data/Aeson/Types/Internal.hs
+++ b/Data/Aeson/Types/Internal.hs
@@ -157,8 +157,10 @@ instance Monad IResult where
IError path err >>= _ = IError path err
{-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
{-# INLINE fail #-}
+#endif
instance Fail.MonadFail IResult where
fail err = IError [] err
@@ -172,8 +174,10 @@ instance Monad Result where
Error err >>= _ = Error err
{-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
{-# INLINE fail #-}
+#endif
instance Fail.MonadFail Result where
fail err = Error err
@@ -287,8 +291,10 @@ instance Monad Parser where
{-# INLINE (>>=) #-}
return = pure
{-# INLINE return #-}
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
{-# INLINE fail #-}
+#endif
instance Fail.MonadFail Parser where
fail msg = Parser $ \path kf _ks -> kf (reverse path) msg