Commit 079b88d1 authored by Ben Gamari's avatar Ben Gamari 🐢

Drop store patches

These will require more work than I have time for at the moment.
parent 7c08f296
diff --git a/src/Data/Store/TH.hs b/src/Data/Store/TH.hs
index 67ce65f..a5409f1 100644
--- a/src/Data/Store/TH.hs
+++ b/src/Data/Store/TH.hs
@@ -37,6 +37,7 @@ module Data.Store.TH
, assertRoundtrip
) where
+import qualified Control.Monad.Fail as Fail
import Data.Complex ()
import Data.Store.Impl
import Data.Typeable (Typeable, typeOf)
@@ -60,7 +61,7 @@ smallcheckManyStore verbose depth = smallcheckMany . map testRoundtrip
expr <- [e| property $ changeDepth (\_ -> depth) $ \x -> checkRoundtrip verbose (x :: $(return ty)) |]
return ("Roundtrips (" ++ pprint ty ++ ")", expr)
-assertRoundtrip :: (Eq a, Show a, Store a, Monad m, Typeable a) => Bool -> a -> m ()
+assertRoundtrip :: (Eq a, Show a, Store a, Fail.MonadFail m, Typeable a) => Bool -> a -> m ()
assertRoundtrip verbose x
| checkRoundtrip verbose x = return ()
| otherwise = fail $ "Failed to roundtrip " ++ show (typeOf x)
diff --git a/src/Data/Store/TH/Internal.hs b/src/Data/Store/TH/Internal.hs
index d9bc138..377e97f 100644
--- a/src/Data/Store/TH/Internal.hs
+++ b/src/Data/Store/TH/Internal.hs
@@ -363,7 +363,14 @@ getUnboxInfo = do
FamilyI _ insts <- reify ''UV.Vector
return (map (everywhere (id `extT` dequalVarT) . go) insts)
where
-#if MIN_VERSION_template_haskell(2,11,0)
+#if MIN_VERSION_template_haskell(2,15,0)
+ go (NewtypeInstD preds _ lhs _ con _)
+ | [_, ty] <- unAppsT lhs
+ = (preds, ty, conToDataCons con)
+ go (DataInstD preds _ lhs _ cons _)
+ | [_, ty] <- unAppsT lhs
+ = (preds, ty, concatMap conToDataCons cons)
+#elif MIN_VERSION_template_haskell(2,11,0)
go (NewtypeInstD preds _ [ty] _ con _) = (preds, ty, conToDataCons con)
go (DataInstD preds _ [ty] _ cons _) = (preds, ty, concatMap conToDataCons cons)
#else
diff --git a/src/Data/Store/Version.hs b/src/Data/Store/Version.hs
index e378978..75a3a66 100644
--- a/src/Data/Store/Version.hs
+++ b/src/Data/Store/Version.hs
@@ -217,7 +217,7 @@ getStructureInfo' ignore renames _ = do
goField = do
s <- get
case sFieldNames s of
- [] -> fail "impossible case in getStructureInfo'"
+ [] -> error "impossible case in getStructureInfo'"
(name:names) -> do
getStructureInfo' ignore renames (Proxy :: Proxy b)
s' <- get
diff --git a/src/System/IO/ByteBuffer.hs b/src/System/IO/ByteBuffer.hs
index 21dc3ac..77562f5 100644
--- a/src/System/IO/ByteBuffer.hs
+++ b/src/System/IO/ByteBuffer.hs
@@ -43,6 +43,7 @@ module System.IO.ByteBuffer
import Control.Applicative
import Control.Exception (SomeException, throwIO)
import Control.Exception.Lifted (Exception, bracket, catch)
+import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.ByteString (ByteString)
@@ -280,7 +281,7 @@ copyByteString bb bs =
-- such the ones created by the @network@ package.
--
-- Returns how many bytes could be read non-blockingly.
-fillFromFd :: MonadIO m => ByteBuffer -> Fd -> Int -> m Int
+fillFromFd :: (MonadIO m, Fail.MonadFail m) => ByteBuffer -> Fd -> Int -> m Int
fillFromFd bb sock maxBytes = if maxBytes < 0
then fail ("fillFromFd: negative argument (" ++ show maxBytes ++ ")")
else bbHandler "fillFromFd" bb go
diff --git a/src/Data/Store/Core.hs b/src/Data/Store/Core.hs
index 382afc9..d6699a7 100644
--- a/src/Data/Store/Core.hs
+++ b/src/Data/Store/Core.hs
@@ -112,8 +112,10 @@ instance Monad Poke where
(offset2, x') <- x ptr offset1
runPoke (f x') ptr offset2
{-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
fail = pokeException . T.pack
{-# INLINE fail #-}
+#endif
#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail Poke where
@@ -228,8 +230,10 @@ instance Monad Peek where
PeekResult ptr2 x' <- x end ptr1
runPeek (f x') end ptr2
{-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
fail = peekException . T.pack
{-# INLINE fail #-}
+#endif
#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail Peek where
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment