path: root/dev-haskell/edisonapi/files/edisonapi-1.3.1-ghc-8.8.patch

commit 8da6c0f7d8666766e2f0693425c347c0adb492dc
Author: Andrés Sicard-Ramírez <asr@eafit.edu.co>
Date:   Thu Jul 4 18:15:17 2019 -0500

    Supported GHC 8.8.1.
    
    All changes were required by the MonadFail proposal.

diff --git a/EdisonAPI.cabal b/EdisonAPI.cabal
index 0f8f161..072cbd2 100644
--- a/EdisonAPI.cabal
+++ b/EdisonAPI.cabal
@@ -40,6 +40,8 @@ Library
   Build-Depends:
      base == 4.*,
      mtl >= 1.0
+  if impl(ghc < 8.0)
+    build-depends: fail
   Default-Language: Haskell2010
   Default-Extensions:
      MultiParamTypeClasses
diff --git a/src/Data/Edison/Assoc.hs b/src/Data/Edison/Assoc.hs
index fac1c59..3993dce 100644
--- a/src/Data/Edison/Assoc.hs
+++ b/src/Data/Edison/Assoc.hs
@@ -71,6 +71,8 @@ module Data.Edison.Assoc (
 
 import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter)
 
+import qualified Control.Monad.Fail as Fail
+
 import Data.Edison.Prelude
 
 import Data.Edison.Seq(Sequence)
@@ -212,7 +214,7 @@ class (Eq k,Functor m) => AssocX m k | m -> k where
   --
   --   This function is /ambiguous/ at finite relation types if the key appears
   --   more than once in the finite relation.  Otherwise, it is /unambiguous/.
-  lookupM        :: (Monad rm) => k -> m a -> rm a
+  lookupM        :: (Fail.MonadFail rm) => k -> m a -> rm a
 
   -- | Return all elements bound by the given key in an unspecified order.
   --
@@ -236,7 +238,7 @@ class (Eq k,Functor m) => AssocX m k | m -> k where
   --
   --   This function is /ambiguous/ at finite relation types if the key appears
   --   more than once in the finite relation.  Otherwise, it is /unambiguous/.
-  lookupAndDeleteM :: (Monad rm) => k -> m a -> rm (a, m a)
+  lookupAndDeleteM :: (Fail.MonadFail rm) => k -> m a -> rm (a, m a)
 
   -- | Find all elements bound by the given key; return a sequence containing
   --   all such bound elements in an unspecified order and the collection
@@ -395,7 +397,7 @@ class (AssocX m k, Ord k) => OrdAssocX m k | m -> k where
   --
   --   This function is /ambiguous/ at finite relation types if the finite relation
   --   contains more than one minimum key.  Otherwise it is /unambiguous/.
-  minView            :: (Monad rm) => m a -> rm (a, m a)
+  minView            :: (Fail.MonadFail rm) => m a -> rm (a, m a)
 
   -- | Find the binding with the minimum key and return its element. Signals
   --   an error if the associative collection is empty.  Which element is chosen
@@ -426,7 +428,7 @@ class (AssocX m k, Ord k) => OrdAssocX m k | m -> k where
   --
   --   This function is /ambiguous/ at finite relation types if the finite relation
   --   contains more than one minimum key.  Otherwise it is /unambiguous/.
-  maxView            :: (Monad rm) => m a -> rm (a, m a)
+  maxView            :: (Fail.MonadFail rm) => m a -> rm (a, m a)
 
   -- | Find the binding with the maximum key and return its element.  Signals
   --   an error if the associative collection is empty.  Which element is chosen
@@ -777,7 +779,7 @@ class (Assoc m k, OrdAssocX m k) => OrdAssoc m k | m -> k where
   --   minimum key exists in the relation.  Furthermore, it is /ambiguous/
   --   with respect to the actual key observed unless the @Eq@ instance on
   --   keys corresponds to indistinguisability.
-  minViewWithKey  :: (Monad rm) => m a -> rm ((k, a), m a)
+  minViewWithKey  :: (Fail.MonadFail rm) => m a -> rm ((k, a), m a)
 
   -- | Find the binding with the minimum key in an associative collection and
   --   return the key and the element.  Signals an error if the associative
@@ -800,7 +802,7 @@ class (Assoc m k, OrdAssocX m k) => OrdAssoc m k | m -> k where
   --   maximum key exists in the relation.  Furthermore, it is /ambiguous/
   --   with respect to the actual key observed unless the @Eq@ instance on
   --   keys corresponds to indistinguisability.
-  maxViewWithKey  :: (Monad rm) => m a -> rm ((k, a), m a)
+  maxViewWithKey  :: (Fail.MonadFail rm) => m a -> rm ((k, a), m a)
 
   -- | Find the binding with the maximum key in an associative collection and
   --   return the key and the element.  Signals an error if the associative
diff --git a/src/Data/Edison/Coll.hs b/src/Data/Edison/Coll.hs
index 88ae755..be4df08 100644
--- a/src/Data/Edison/Coll.hs
+++ b/src/Data/Edison/Coll.hs
@@ -97,6 +97,7 @@ module Data.Edison.Coll (
 ) where
 
 import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter)
+import qualified Control.Monad.Fail as Fail
 import Data.Monoid
 
 import Data.Edison.Prelude
@@ -421,7 +422,7 @@ class CollX c a => Coll c a | c -> a where
   --   This function is /ambiguous/ at bag types, when more than one
   --   element equivalent to the given item is in the bag.  Otherwise
   --   it is /unambiguous/.
-  lookupM    :: (Monad m) => a -> c -> m a
+  lookupM    :: (Fail.MonadFail m) => a -> c -> m a
 
   -- | Return a sequence containing all elements in the collection equal to
   --   the given element in an unspecified order.
@@ -504,7 +505,7 @@ class (Coll c a, OrdCollX c a) => OrdColl c a | c -> a where
   --
   --   This function is /ambiguous/ at bag types, if more than one minimum
   --   element exists in the bag.  Otherwise, it is /unambiguous/.
-  minView    :: (Monad m) => c -> m (a, c)
+  minView    :: (Fail.MonadFail m) => c -> m (a, c)
 
   -- | Return the minimum element in the collection.  If there are multiple
   --   copies of the minimum element, it is unspecified which is chosen.
@@ -523,7 +524,7 @@ class (Coll c a, OrdCollX c a) => OrdColl c a | c -> a where
   --
   --   This function is /ambiguous/ at bag types, if more than one maximum
   --   element exists in the bag.  Otherwise, it is /unambiguous/.
-  maxView    :: (Monad m) => c -> m (a, c)
+  maxView    :: (Fail.MonadFail m) => c -> m (a, c)
 
   -- | Return the maximum element in the collection.  If there are multiple
   --   copies of the maximum element, it is unspecified which is chosen.
diff --git a/src/Data/Edison/Prelude.hs b/src/Data/Edison/Prelude.hs
index 2ac6968..8281f46 100644
--- a/src/Data/Edison/Prelude.hs
+++ b/src/Data/Edison/Prelude.hs
@@ -10,14 +10,19 @@
 --   This module is a central depository of common definitions
 --   used throughout Edison.
 
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Data.Edison.Prelude (
 -- * Hashing classes
   Hash (..)
 , UniqueHash
 , ReversibleHash (..)
 , Measured (..)
+-- * Pure MonadFail
+,  runFail_
 ) where
 
+import Control.Monad.Fail
 import Data.Monoid
 
 -- | This class represents hashable objects. If obeys the 
@@ -62,3 +67,14 @@ class UniqueHash a => ReversibleHash a where
 --   the computation.
 class (Monoid v) => Measured v a | a -> v where
   measure :: a -> v
+
+-- From Agda source code: src/full/Agda/Utils/Fail.hs
+-- | A pure MonadFail.
+newtype Fail a = Fail { runFail :: Either String a }
+  deriving (Functor, Applicative, Monad)
+
+instance MonadFail Fail where
+  fail = Fail . Left
+
+runFail_ :: Fail a -> a
+runFail_ = either error id . runFail
diff --git a/src/Data/Edison/Seq.hs b/src/Data/Edison/Seq.hs
index 78ca245..0394d58 100644
--- a/src/Data/Edison/Seq.hs
+++ b/src/Data/Edison/Seq.hs
@@ -58,6 +58,7 @@ import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1,
                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null)
 
 import Control.Monad
+import qualified Control.Monad.Fail as Fail
 import Data.Monoid
 
 import Data.Edison.Prelude
@@ -221,7 +222,7 @@ class (Functor s, MonadPlus s) => Sequence s where
   --   This function is always /unambiguous/.
   --
   --   Default running time: @O( 1 )@
-  lview     :: (Monad m) => s a -> m (a, s a)
+  lview     :: (Fail.MonadFail m) => s a -> m (a, s a)
 
   -- | Return the first element of a sequence.
   --   Signals an error if the sequence is empty.
@@ -249,7 +250,7 @@ class (Functor s, MonadPlus s) => Sequence s where
   --   This function is always /unambiguous/.
   --
   --   Default running time: @O( 1 )@
-  lheadM    :: (Monad m) => s a -> m a 
+  lheadM    :: (Fail.MonadFail m) => s a -> m a 
 
   -- | Delete the first element of the sequence.
   --   Signals error if sequence is empty.
@@ -277,7 +278,7 @@ class (Functor s, MonadPlus s) => Sequence s where
   --   This function is always /unambiguous/.
   --
   --   Default running time: @O( 1 )@
-  ltailM    :: (Monad m) => s a -> m (s a)
+  ltailM    :: (Fail.MonadFail m) => s a -> m (s a)
 
   -- | Separate a sequence into its last (rightmost) element and the
   --   remaining sequence.  Calls 'fail' if the sequence is empty.
@@ -291,7 +292,7 @@ class (Functor s, MonadPlus s) => Sequence s where
   --   This function is always /unambiguous/.
   --
   --   Default running time: @O( n )@
-  rview     :: (Monad m) => s a -> m (a, s a)
+  rview     :: (Fail.MonadFail m) => s a -> m (a, s a)
 
   -- | Return the last (rightmost) element of the sequence.
   --   Signals error if sequence is empty.
@@ -319,7 +320,7 @@ class (Functor s, MonadPlus s) => Sequence s where
   --   This function is always /unambiguous/.
   --
   --   Default running time: @O( n )@
-  rheadM    :: (Monad m) => s a -> m a
+  rheadM    :: (Fail.MonadFail m) => s a -> m a
 
   -- | Delete the last (rightmost) element of the sequence.
   --   Signals an error if the sequence is empty.
@@ -347,7 +348,7 @@ class (Functor s, MonadPlus s) => Sequence s where
   --   This function is always /unambiguous/.
   --
   --   Default running time: @O( n )@
-  rtailM    :: (Monad m) => s a -> m (s a)
+  rtailM    :: (Fail.MonadFail m) => s a -> m (s a)
 
   -- | Returns 'True' if the sequence is empty and 'False' otherwise.
   -- 
@@ -948,7 +949,7 @@ class (Functor s, MonadPlus s) => Sequence s where
   --   This function is always /unambiguous/.
   --
   --   Default running time: @O( i )@
-  lookupM   :: (Monad m) => Int -> s a -> m a
+  lookupM   :: (Fail.MonadFail m) => Int -> s a -> m a
 
   -- | Return the element at the given index, or the
   --   default argument if the index is out of bounds.  All indexes are
diff --git a/src/Data/Edison/Seq/ListSeq.hs b/src/Data/Edison/Seq/ListSeq.hs
index 1ad677f..890b66f 100644
--- a/src/Data/Edison/Seq/ListSeq.hs
+++ b/src/Data/Edison/Seq/ListSeq.hs
@@ -40,9 +40,9 @@ module Data.Edison.Seq.ListSeq (
 import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1,
                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,
                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null)
-import qualified Control.Monad.Identity as ID
+import qualified Control.Monad.Fail as Fail
 import qualified Prelude
-import Data.Edison.Prelude
+import Data.Edison.Prelude ( runFail_ )
 import qualified Data.List
 import Data.Monoid
 import qualified Data.Edison.Seq as S ( Sequence(..) ) 
@@ -54,16 +54,16 @@ singleton      :: a -> [a]
 lcons          :: a -> [a] -> [a]
 rcons          :: a -> [a] -> [a]
 append         :: [a] -> [a] -> [a]
-lview          :: (Monad rm) => [a] -> rm (a, [a])
+lview          :: (Fail.MonadFail rm) => [a] -> rm (a, [a])
 lhead          :: [a] -> a
-lheadM         :: (Monad rm) => [a] -> rm a
+lheadM         :: (Fail.MonadFail rm) => [a] -> rm a
 ltail          :: [a] -> [a]
-ltailM         :: (Monad rm) => [a] -> rm [a]
-rview          :: (Monad rm) => [a] -> rm (a, [a])
+ltailM         :: (Fail.MonadFail rm) => [a] -> rm [a]
+rview          :: (Fail.MonadFail rm) => [a] -> rm (a, [a])
 rhead          :: [a] -> a
-rheadM         :: (Monad rm) => [a] -> rm a
+rheadM         :: (Fail.MonadFail rm) => [a] -> rm a
 rtail          :: [a] -> [a]
-rtailM         :: (Monad rm) => [a] -> rm [a]
+rtailM         :: (Fail.MonadFail rm) => [a] -> rm [a]
 null           :: [a] -> Bool
 size           :: [a] -> Int
 concat         :: [[a]] -> [a]
@@ -92,7 +92,7 @@ reduce1'       :: (a -> a -> a) -> [a] -> a
 copy           :: Int -> a -> [a]
 inBounds       :: Int -> [a] -> Bool
 lookup         :: Int -> [a] -> a
-lookupM        :: (Monad m) => Int -> [a] -> m a
+lookupM        :: (Fail.MonadFail m) => Int -> [a] -> m a
 lookupWithDefault :: a -> Int -> [a] -> a
 update         :: Int -> a -> [a] -> [a]
 adjust         :: (a -> a) -> Int -> [a] -> [a]
@@ -252,7 +252,7 @@ inBounds i xs
   | i >= 0    = not (null (drop i xs))
   | otherwise = False
 
-lookup i xs = ID.runIdentity (lookupM i xs)
+lookup i xs = runFail_ (lookupM i xs)
 
 lookupM i xs
   | i < 0 = fail "ListSeq.lookup: not found"