commit 8da6c0f7d8666766e2f0693425c347c0adb492dc Author: Andrés Sicard-Ramírez 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"