haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-12 23:38:29 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Delete a whole bunch of old patches

Browse Source
This commit is contained in:
Michael Snoyman 2014-08-28 09:38:25 +03:00
parent 1ef4ceafe9
commit 9301f5524f
67 changed files with 12 additions and 18745 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
patching/patches/BiobaseTurner-0.3.1.1.patch
View File

@ -1,23 +0,0 @@
diff -ru orig/Biobase/Turner/Import.hs new/Biobase/Turner/Import.hs
--- orig/Biobase/Turner/Import.hs 2014-04-03 10:53:56.310194793 +0300
+++ new/Biobase/Turner/Import.hs 2014-04-03 10:53:56.000000000 +0300
@@ -37,6 +37,7 @@
module Biobase.Turner.Import where
import Control.Arrow
+import Control.Monad.Trans.Resource (runResourceT)
import Data.Array.Repa.Index
import Data.ByteString.Char8 as BS
import Data.ByteString.Lex.Double
diff -ru orig/BiobaseTurner.cabal new/BiobaseTurner.cabal
--- orig/BiobaseTurner.cabal 2014-04-03 10:53:56.310194793 +0300
+++ new/BiobaseTurner.cabal 2014-04-03 10:53:56.000000000 +0300
@@ -35,6 +35,8 @@
bytestring >= 0.9 ,
bytestring-lexing >= 0.4 ,
conduit >= 0.5 ,
+ conduit-extra >= 1.0 ,
+ resourcet >= 0.4 ,
containers >= 0.4 ,
filepath >= 1 ,
lens >= 3.8 ,

15
patching/patches/BlogLiterately-diagrams-0.1.4.2.patch
View File

@ -1,15 +0,0 @@
diff -ru orig/BlogLiterately-diagrams.cabal new/BlogLiterately-diagrams.cabal
--- orig/BlogLiterately-diagrams.cabal 2014-06-03 16:05:19.882144431 +0300
+++ new/BlogLiterately-diagrams.cabal 2014-06-03 16:05:19.000000000 +0300
@@ -79,9 +79,9 @@
containers,
filepath,
directory,
- diagrams-cairo >= 1.0.1 && < 1.2,
+ diagrams-cairo >= 1.0.1 && < 1.3,
diagrams-builder >= 0.5 && < 0.6,
- diagrams-lib >= 1.0.1 && < 1.2,
+ diagrams-lib >= 1.0.1 && < 1.3,
BlogLiterately >= 0.6 && < 0.8,
pandoc >= 1.9 && < 1.13,
safe ==0.3.*

34
patching/patches/ChasingBottoms-1.3.0.7.patch
View File

@ -1,34 +0,0 @@
diff -ru orig/ChasingBottoms.cabal new/ChasingBottoms.cabal
--- orig/ChasingBottoms.cabal 2014-06-10 13:09:03.210534172 +0300
+++ new/ChasingBottoms.cabal 2014-06-10 13:09:03.000000000 +0300
@@ -121,7 +121,7 @@
other-modules: Test.ChasingBottoms.IsType
- build-depends: QuickCheck >= 2.1 && < 2.7,
+ build-depends: QuickCheck >= 2.1 && < 2.8,
mtl >= 1.1 && < 2.2,
base >= 4.0 && < 4.8,
containers >= 0.3 && < 0.6,
@@ -150,7 +150,7 @@
Test.ChasingBottoms.TestUtilities.Generators,
Test.ChasingBottoms.TimeOut.Tests
- build-depends: QuickCheck >= 2.1 && < 2.7,
+ build-depends: QuickCheck >= 2.1 && < 2.8,
mtl >= 1.1 && < 2.2,
base >= 4.0 && < 4.8,
containers >= 0.3 && < 0.6,
diff -ru orig/Test/ChasingBottoms/ContinuousFunctions.hs new/Test/ChasingBottoms/ContinuousFunctions.hs
--- orig/Test/ChasingBottoms/ContinuousFunctions.hs 2014-06-10 13:09:03.202534172 +0300
+++ new/Test/ChasingBottoms/ContinuousFunctions.hs 2014-06-10 13:09:03.000000000 +0300
@@ -143,7 +143,8 @@
, listOf
) where
-import Test.QuickCheck hiding ((><), listOf)
+import Test.QuickCheck hiding ((><), listOf, infiniteListOf)
+import Test.QuickCheck.Gen.Unsafe (promote)
import Data.Sequence as Seq
import Data.Foldable as Seq (foldr)
import Prelude as P hiding (concat)

13157
patching/patches/MFlow-0.4.5.4.patch
View File

File diff suppressed because it is too large Load Diff

28
patching/patches/MusicBrainz-0.2.1.patch
View File

@ -1,28 +0,0 @@
diff -ru orig/MusicBrainz.cabal new/MusicBrainz.cabal
--- orig/MusicBrainz.cabal 2014-06-30 16:08:08.987902131 +0300
+++ new/MusicBrainz.cabal 2014-06-30 16:08:08.000000000 +0300
@@ -23,8 +23,10 @@
, monad-control ==0.3.*
, bytestring
, conduit >= 1.0.0
+ , conduit-extra >= 1.0.0
, text
, time
+ , resourcet
, vector >=0.9
, xml-types ==0.3.*
, http-conduit >= 1.8.8
diff -ru orig/Network/Protocol/MusicBrainz/XML2/WebService.hs new/Network/Protocol/MusicBrainz/XML2/WebService.hs
--- orig/Network/Protocol/MusicBrainz/XML2/WebService.hs 2014-06-30 16:08:08.987902131 +0300
+++ new/Network/Protocol/MusicBrainz/XML2/WebService.hs 2014-06-30 16:08:08.000000000 +0300
@@ -11,8 +11,9 @@
import Control.Applicative (liftA2, (<|>))
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Control (MonadBaseControl)
+import Control.Monad.Trans.Resource (MonadThrow, runResourceT)
import qualified Data.ByteString.Lazy as BL
-import Data.Conduit (Consumer, ($=), ($$), MonadThrow, runResourceT)
+import Data.Conduit (Consumer, ($=), ($$))
import Data.Conduit.Binary (sourceLbs)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)

19
patching/patches/Octree-0.5.2.patch
View File

@ -1,19 +0,0 @@
diff -ru orig/Octree.cabal new/Octree.cabal
--- orig/Octree.cabal 2014-04-17 19:22:31.263672240 +0300
+++ new/Octree.cabal 2014-04-17 19:22:31.000000000 +0300
@@ -32,13 +32,13 @@
Test-suite test_Octree
Type: exitcode-stdio-1.0
- Build-depends: base>=4.0 && < 4.7, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0
+ Build-depends: base>=4.0 && < 4.8, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0
Main-is: tests/test_Octree.hs
Test-suite readme
type: exitcode-stdio-1.0
-- We have a symlink: README.lhs -> README.md
main-is: README.lhs
- Build-depends: base>=4.0 && < 4.7, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0, markdown-unlit
+ Build-depends: base>=4.0 && < 4.8, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0, markdown-unlit
ghc-options: -pgmL markdown-unlit

19
patching/patches/Octree-0.5.3.patch
View File

@ -1,19 +0,0 @@
diff -ru orig/Octree.cabal new/Octree.cabal
--- orig/Octree.cabal 2014-05-01 18:10:50.650819156 +0300
+++ new/Octree.cabal 2014-05-01 18:10:50.000000000 +0300
@@ -33,13 +33,13 @@
Test-suite test_Octree
Type: exitcode-stdio-1.0
- Build-depends: base>=4.0 && < 4.7, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0
+ Build-depends: base>=4.0 && < 4.8, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0
Main-is: tests/test_Octree.hs
Test-suite readme
type: exitcode-stdio-1.0
-- We have a symlink: README.lhs -> README.md
main-is: README.lhs
- Build-depends: base>=4.0 && < 4.7, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0, markdown-unlit
+ Build-depends: base>=4.0 && < 4.8, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0, markdown-unlit
ghc-options: -pgmL markdown-unlit

30
patching/patches/arbtt-0.8.1.patch
View File

@ -1,30 +0,0 @@
diff -ruN orig/arbtt.cabal new/arbtt.cabal
--- orig/arbtt.cabal 2014-08-10 08:32:58.666725004 +0300
+++ new/arbtt.cabal 2014-08-10 08:32:58.000000000 +0300
@@ -35,7 +35,7 @@
build-depends:
base == 4.5.* || == 4.6.* || == 4.7.*,
filepath, directory, transformers, time >= 1.4, utf8-string,
- aeson == 0.6.* || == 0.7.*,
+ aeson,
array == 0.4.* || == 0.5.*,
binary >= 0.5,
bytestring, deepseq, strict, old-locale
@@ -82,7 +82,7 @@
binary >= 0.5,
deepseq, bytestring, utf8-string, time >= 1.4, strict,
transformers, unix, directory, filepath,
- aeson == 0.6.* || == 0.7.*,
+ aeson,
array == 0.4.* || == 0.5.*,
terminal-progress-bar, bytestring-progress
other-modules:
@@ -112,7 +112,7 @@
base == 4.5.* || == 4.6.* || == 4.7.*,
parsec == 3.*,
containers == 0.5.*,
- aeson == 0.6.* || == 0.7.*,
+ aeson,
array == 0.4.* || == 0.5.*,
binary >= 0.5,
deepseq, bytestring, utf8-string, time >= 1.4, strict,

40
patching/patches/async-2.0.1.5.patch
View File

@ -1,40 +0,0 @@
diff -ruN orig/Control/Concurrent/Async.hs new/Control/Concurrent/Async.hs
--- orig/Control/Concurrent/Async.hs 2014-08-11 12:23:17.688591763 +0300
+++ new/Control/Concurrent/Async.hs 2014-08-11 12:23:17.000000000 +0300
@@ -246,7 +246,10 @@
--
{-# INLINE waitCatch #-}
waitCatch :: Async a -> IO (Either SomeException a)
-waitCatch = atomically . waitCatchSTM
+waitCatch = tryAgain . atomically . waitCatchSTM
+ where
+ -- See: https://github.com/simonmar/async/issues/14
+ tryAgain f = f `catch` \BlockedIndefinitelyOnSTM -> f
-- | Check whether an 'Async' has completed yet. If it has not
-- completed yet, then the result is @Nothing@, otherwise the result
diff -ruN orig/test/test-async.hs new/test/test-async.hs
--- orig/test/test-async.hs 2014-08-11 12:23:17.688591763 +0300
+++ new/test/test-async.hs 2014-08-11 12:23:17.000000000 +0300
@@ -29,6 +29,7 @@
testCase "async_cancel" async_cancel
, testCase "async_poll" async_poll
, testCase "async_poll2" async_poll2
+ , testCase "withasync_waitCatch_blocked" withasync_waitCatch_blocked
]
value = 42 :: Int
@@ -104,3 +105,13 @@
when (isNothing r) $ assertFailure ""
r <- poll a -- poll twice, just to check we don't deadlock
when (isNothing r) $ assertFailure ""
+
+withasync_waitCatch_blocked :: Assertion
+withasync_waitCatch_blocked = do
+ r <- withAsync (newEmptyMVar >>= takeMVar) waitCatch
+ case r of
+ Left e ->
+ case fromException e of
+ Just BlockedIndefinitelyOnMVar -> return ()
+ Nothing -> assertFailure $ show e
+ Right () -> assertFailure ""

147
patching/patches/authenticate-oauth-1.4.0.8.patch
View File

@ -1,147 +0,0 @@
diff -ru orig/authenticate-oauth.cabal new/authenticate-oauth.cabal
--- orig/authenticate-oauth.cabal 2014-02-21 07:19:28.878548521 +0200
+++ new/authenticate-oauth.cabal 2014-02-21 07:19:28.000000000 +0200
@@ -19,7 +19,7 @@
, transformers >= 0.1 && < 0.4
, bytestring >= 0.9
, crypto-pubkey-types >= 0.1 && < 0.5
- , RSA >= 1.2 && < 1.3
+ , RSA >= 1.2 && < 2.1
, time
, data-default
, base64-bytestring >= 0.1 && < 1.1
diff -ru orig/Web/Authenticate/OAuth.hs new/Web/Authenticate/OAuth.hs
--- orig/Web/Authenticate/OAuth.hs 2014-02-21 07:19:28.874548521 +0200
+++ new/Web/Authenticate/OAuth.hs 2014-02-21 07:19:28.000000000 +0200
@@ -1,5 +1,5 @@
-{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings, StandaloneDeriving #-}
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving, FlexibleContexts #-}
+{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
module Web.Authenticate.OAuth
( -- * Data types
@@ -15,48 +15,50 @@
authorizeUrl, authorizeUrl', getAccessToken, getTemporaryCredential,
getTokenCredential, getTemporaryCredentialWithScope,
getAccessTokenProxy, getTemporaryCredentialProxy,
- getTokenCredentialProxy,
+ getTokenCredentialProxy,
getAccessToken', getTemporaryCredential',
-- * Utility Methods
paramEncode, addScope, addMaybeProxy
) where
-import Blaze.ByteString.Builder (toByteString, Builder)
-import Codec.Crypto.RSA (ha_SHA1, rsassa_pkcs1_v1_5_sign)
-import Control.Exception
-import Control.Monad
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Monad.Trans.Control
-import Control.Monad.Trans.Resource
-import Crypto.Types.PubKey.RSA (PrivateKey (..), PublicKey (..))
-import Data.ByteString.Base64
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.ByteString.Lazy.Char8 as BSL
-import Data.Char
-import Data.Conduit (Source, ($$), ($=))
-import Data.Conduit.Blaze (builderToByteString)
-import qualified Data.Conduit.List as CL
-import Data.Default
-import Data.Digest.Pure.SHA
-import qualified Data.IORef as I
-import Data.List (sortBy)
-import Data.Maybe
-import Data.Time
-import Network.HTTP.Conduit
-import Network.HTTP.Types (SimpleQuery, parseSimpleQuery)
-import Network.HTTP.Types (Header)
-import Network.HTTP.Types (renderSimpleQuery, status200)
-import Numeric
-import System.Random
-#if MIN_VERSION_base(4,7,0)
-import Data.Data hiding (Proxy (..))
-#else
+import Network.HTTP.Conduit
import Data.Data
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import Data.Maybe
+import Network.HTTP.Types (parseSimpleQuery, SimpleQuery)
+import Control.Exception
+import Control.Monad
+import Data.List (sortBy)
+import System.Random
+import Data.Char
+import Data.Digest.Pure.SHA
+import Data.ByteString.Base64
+import Data.Time
+import Numeric
+#if MIN_VERSION_RSA(2, 0, 0)
+import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, hashSHA1)
+#else
+import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, ha_SHA1)
#endif
+import Crypto.Types.PubKey.RSA (PrivateKey(..), PublicKey(..))
+import Network.HTTP.Types (Header)
+import Blaze.ByteString.Builder (toByteString)
+import Control.Monad.IO.Class (MonadIO)
+import Network.HTTP.Types (renderSimpleQuery, status200)
+import Data.Conduit (($$), ($=), Source)
+import qualified Data.Conduit.List as CL
+import Data.Conduit.Blaze (builderToByteString)
+import Blaze.ByteString.Builder (Builder)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Control
+import Control.Monad.Trans.Resource
+import Data.Default
+import qualified Data.IORef as I
-- | Data type for OAuth client (consumer).
---
--- The constructor for this data type is not exposed.
--- Instead, you should use the 'def' method or 'newOAuth' function to retrieve a default instance,
+--
+-- The constructor for this data type is not exposed.
+-- Instead, you should use the 'def' method or 'newOAuth' function to retrieve a default instance,
-- and then use the records below to make modifications.
-- This approach allows us to add configuration options without breaking backwards compatibility.
data OAuth = OAuth { oauthServerName :: String -- ^ Service name (default: @\"\"@)
@@ -71,7 +73,7 @@
, oauthAuthorizeUri :: String
-- ^ Uri to authorize (default: @\"\"@).
-- You MUST specify if you use 'authorizeUrl' or 'authorizeZUrl'';
- -- otherwise you can just leave this empty.
+ -- otherwise you can just leave this empty.
, oauthSignatureMethod :: SignMethod
-- ^ Signature Method (default: 'HMACSHA1')
, oauthConsumerKey :: BS.ByteString
@@ -188,7 +190,7 @@
getTemporaryCredential' hook oa manager = do
let req = fromJust $ parseUrl $ oauthRequestUri oa
crd = maybe id (insert "oauth_callback") (oauthCallback oa) $ emptyCredential
- req' <- signOAuth oa crd $ hook (req { method = "POST" })
+ req' <- signOAuth oa crd $ hook (req { method = "POST" })
rsp <- httpLbs req' manager
if responseStatus rsp == status200
then do
@@ -211,7 +213,7 @@
-> String -- ^ URL to authorize
authorizeUrl' f oa cr = oauthAuthorizeUri oa ++ BS.unpack (renderSimpleQuery True queries)
where fixed = ("oauth_token", token cr):f oa cr
- queries =
+ queries =
case oauthCallback oa of
Nothing -> fixed
Just callback -> ("oauth_callback", callback):fixed
@@ -346,7 +348,11 @@
PLAINTEXT ->
return $ BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok]
RSASHA1 pr ->
+#if MIN_VERSION_RSA(2, 0, 0)
+ liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign hashSHA1 pr) (getBaseString tok req)
+#else
liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign ha_SHA1 pr) (getBaseString tok req)
+#endif
#if MIN_VERSION_http_conduit(2, 0, 0)
addAuthHeader :: BS.ByteString -> Credential -> Request -> Request

596
patching/patches/aws-0.8.6.patch
View File

@ -1,596 +0,0 @@
diff -ru orig/Aws/Aws.hs new/Aws/Aws.hs
--- orig/Aws/Aws.hs 2014-04-04 10:18:25.108401067 +0300
+++ new/Aws/Aws.hs 2014-04-04 10:18:24.000000000 +0300
@@ -33,7 +33,6 @@
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Resource
-import Data.Attempt (Attempt(Success, Failure))
import qualified Data.ByteString as B
import qualified Data.CaseInsensitive as CI
import qualified Data.Conduit as C
@@ -185,11 +184,8 @@
unsafeAws cfg scfg manager request = do
metadataRef <- liftIO $ newIORef mempty
- let catchAll :: ResourceT IO a -> ResourceT IO (Attempt a)
- catchAll = E.handle (return . failure') . fmap Success
-
- failure' :: E.SomeException -> Attempt a
- failure' = Failure
+ let catchAll :: ResourceT IO a -> ResourceT IO (Either E.SomeException a)
+ catchAll = E.handle (return . Left) . fmap Right
resp <- catchAll $
unsafeAwsRef cfg scfg manager metadataRef request
@@ -268,8 +264,8 @@
where go request = do resp <- lift $ aws cfg scfg manager request
C.yield resp
case responseResult resp of
- Failure _ -> return ()
- Success x ->
+ Left _ -> return ()
+ Right x ->
case nextIteratedRequest request x of
Nothing -> return ()
Just nextRequest -> go nextRequest
diff -ru orig/Aws/Core.hs new/Aws/Core.hs
--- orig/Aws/Core.hs 2014-04-04 10:18:25.108401067 +0300
+++ new/Aws/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -89,13 +89,12 @@
import Control.Applicative
import Control.Arrow
import qualified Control.Exception as E
-import qualified Control.Failure as F
import Control.Monad
import Control.Monad.IO.Class
+import Control.Monad.Trans.Resource (ResourceT, MonadThrow (throwM))
import qualified Crypto.Classes as Crypto
import qualified Crypto.HMAC as HMAC
import Crypto.Hash.CryptoAPI (MD5, SHA1, SHA256, hash')
-import Data.Attempt (Attempt(..), FromAttempt(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as Base16
@@ -104,7 +103,7 @@
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as BU
import Data.Char
-import Data.Conduit (ResourceT, ($$+-))
+import Data.Conduit (($$+-))
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import Data.Default (def)
@@ -137,12 +136,12 @@
--
-- Response forms a Writer-like monad.
data Response m a = Response { responseMetadata :: m
- , responseResult :: Attempt a }
+ , responseResult :: Either E.SomeException a }
deriving (Show, Functor)
-- | Read a response result (if it's a success response, fail otherwise).
-readResponse :: FromAttempt f => Response m a -> f a
-readResponse = fromAttempt . responseResult
+readResponse :: MonadThrow n => Response m a -> n a
+readResponse = either throwM return . responseResult
-- | Read a response result (if it's a success response, fail otherwise). In MonadIO.
readResponseIO :: MonadIO io => Response m a -> io a
@@ -159,13 +158,13 @@
--multiResponse :: Monoid m => Response m a -> Response [m] a ->
instance Monoid m => Monad (Response m) where
- return x = Response mempty (Success x)
- Response m1 (Failure e) >>= _ = Response m1 (Failure e)
- Response m1 (Success x) >>= f = let Response m2 y = f x
+ return x = Response mempty (Right x)
+ Response m1 (Left e) >>= _ = Response m1 (Left e)
+ Response m1 (Right x) >>= f = let Response m2 y = f x
in Response (m1 `mappend` m2) y -- currently using First-semantics, Last SHOULD work too
-instance (Monoid m, E.Exception e) => F.Failure e (Response m) where
- failure e = Response mempty (F.failure e)
+instance Monoid m => MonadThrow (Response m) where
+ throwM e = Response mempty (throwM e)
-- | Add metadata to an 'IORef' (using 'mappend').
tellMetadataRef :: Monoid m => IORef m -> m -> IO ()
@@ -696,24 +695,24 @@
elCont name = laxElement name &/ content &| T.unpack
-- | Extract the first element from a parser result list, and throw an 'XmlException' if the list is empty.
-force :: F.Failure XmlException m => String -> [a] -> m a
+force :: MonadThrow m => String -> [a] -> m a
force = Cu.force . XmlException
-- | Extract the first element from a monadic parser result list, and throw an 'XmlException' if the list is empty.
-forceM :: F.Failure XmlException m => String -> [m a] -> m a
+forceM :: MonadThrow m => String -> [m a] -> m a
forceM = Cu.forceM . XmlException
-- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure.
-textReadInt :: (F.Failure XmlException m, Num a) => T.Text -> m a
+textReadInt :: (MonadThrow m, Num a) => T.Text -> m a
textReadInt s = case reads $ T.unpack s of
[(n,"")] -> return $ fromInteger n
- _ -> F.failure $ XmlException "Invalid Integer"
+ _ -> throwM $ XmlException "Invalid Integer"
-- | Read an integer from a 'String', throwing an 'XmlException' on failure.
-readInt :: (F.Failure XmlException m, Num a) => String -> m a
+readInt :: (MonadThrow m, Num a) => String -> m a
readInt s = case reads s of
[(n,"")] -> return $ fromInteger n
- _ -> F.failure $ XmlException "Invalid Integer"
+ _ -> throwM $ XmlException "Invalid Integer"
-- | Create a complete 'HTTPResponseConsumer' from a simple function that takes a 'Cu.Cursor' to XML in the response
-- body.
@@ -731,5 +730,5 @@
let Response metadata x = parse cursor
liftIO $ tellMetadataRef metadataRef metadata
case x of
- Failure err -> liftIO $ C.monadThrow err
- Success v -> return v
+ Left err -> liftIO $ throwM err
+ Right v -> return v
diff -ru orig/Aws/DynamoDb/Core.hs new/Aws/DynamoDb/Core.hs
--- orig/Aws/DynamoDb/Core.hs 2014-04-04 10:18:25.108401067 +0300
+++ new/Aws/DynamoDb/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -2,6 +2,7 @@
import Aws.Core
import qualified Control.Exception as C
+import Control.Monad.Trans.Resource (throwM)
import Crypto.Hash.CryptoAPI (SHA256, hash)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
@@ -125,5 +126,5 @@
(HTTP.Status{HTTP.statusCode=200}) -> do
case A.fromJSON val of
A.Success a -> return a
- A.Error err -> monadThrow $ DyError (HTTP.responseStatus resp) "" err
- _ -> monadThrow $ DyError (HTTP.responseStatus resp) "" (show val)
+ A.Error err -> throwM $ DyError (HTTP.responseStatus resp) "" err
+ _ -> throwM $ DyError (HTTP.responseStatus resp) "" (show val)
diff -ru orig/Aws/Ec2/InstanceMetadata.hs new/Aws/Ec2/InstanceMetadata.hs
--- orig/Aws/Ec2/InstanceMetadata.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/Ec2/InstanceMetadata.hs 2014-04-04 10:18:24.000000000 +0300
@@ -2,7 +2,7 @@
import Control.Applicative
import Control.Exception
-import Control.Failure
+import Control.Monad.Trans.Resource (throwM)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as B8
import Data.ByteString.Lazy.UTF8 as BU
@@ -25,7 +25,7 @@
getInstanceMetadataFirst :: HTTP.Manager -> String -> IO L.ByteString
getInstanceMetadataFirst mgr p = do listing <- getInstanceMetadataListing mgr p
case listing of
- [] -> failure (MetadataNotFound p)
+ [] -> throwM (MetadataNotFound p)
(x:_) -> getInstanceMetadata mgr p x
getInstanceMetadataOrFirst :: HTTP.Manager -> String -> Maybe String -> IO L.ByteString
diff -ru orig/Aws/Iam/Core.hs new/Aws/Iam/Core.hs
--- orig/Aws/Iam/Core.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/Iam/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -19,8 +19,8 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import Control.Exception (Exception)
-import qualified Control.Failure as F
import Control.Monad
+import Control.Monad.Trans.Resource (MonadThrow, throwM)
import Data.ByteString (ByteString)
import Data.IORef
import Data.List (intersperse, sort)
@@ -152,13 +152,13 @@
fromError cursor = do
errCode <- force "Missing Error Code" $ cursor $// elContent "Code"
errMsg <- force "Missing Error Message" $ cursor $// elContent "Message"
- F.failure $ IamError (HTTP.responseStatus resp) errCode errMsg
+ throwM $ IamError (HTTP.responseStatus resp) errCode errMsg
-- | Parses IAM @DateTime@ data type.
-parseDateTime :: (F.Failure XmlException m) => String -> m UTCTime
+parseDateTime :: MonadThrow m => String -> m UTCTime
parseDateTime x
= case parseTime defaultTimeLocale iso8601UtcDate x of
- Nothing -> F.failure $ XmlException $ "Invalid DateTime: " ++ x
+ Nothing -> throwM $ XmlException $ "Invalid DateTime: " ++ x
Just dt -> return dt
-- | The IAM @User@ data type.
@@ -180,7 +180,7 @@
deriving (Eq, Ord, Show, Typeable)
-- | Parses the IAM @User@ data type.
-parseUser :: (F.Failure XmlException m) => Cu.Cursor -> m User
+parseUser :: MonadThrow m => Cu.Cursor -> m User
parseUser cursor = do
userArn <- attr "Arn"
userCreateDate <- attr "CreateDate" >>= parseDateTime . Text.unpack
diff -ru orig/Aws/Iam/Internal.hs new/Aws/Iam/Internal.hs
--- orig/Aws/Iam/Internal.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/Iam/Internal.hs 2014-04-04 10:18:24.000000000 +0300
@@ -15,8 +15,8 @@
import Aws.Iam.Core
import Control.Applicative
import Control.Arrow (second)
-import qualified Control.Failure as F
import Control.Monad
+import Control.Monad.Trans.Resource (MonadThrow)
import Data.ByteString (ByteString)
import Data.Maybe
import Data.Monoid ((<>))
@@ -62,7 +62,7 @@
-- | Reads and returns the @IsTruncated@ and @Marker@ attributes present in
-- all IAM data pagination responses.
markedIterResponse
- :: F.Failure XmlException m
+ :: MonadThrow m
=> Cu.Cursor
-> m (Bool, Maybe Text)
markedIterResponse cursor = do
diff -ru orig/Aws/S3/Commands/CopyObject.hs new/Aws/S3/Commands/CopyObject.hs
--- orig/Aws/S3/Commands/CopyObject.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/S3/Commands/CopyObject.hs 2014-04-04 10:18:24.000000000 +0300
@@ -5,7 +5,7 @@
import Aws.S3.Core
import Control.Applicative
import Control.Arrow (second)
-import Control.Failure
+import Control.Monad.Trans.Resource (throwM)
import qualified Data.CaseInsensitive as CI
import Data.Maybe
import qualified Data.Text as T
@@ -93,7 +93,7 @@
return $ CopyObjectResponse vid lastMod etag
where parse el = do
let parseHttpDate' x = case parseTime defaultTimeLocale iso8601UtcDate x of
- Nothing -> failure $ XmlException ("Invalid Last-Modified " ++ x)
+ Nothing -> throwM $ XmlException ("Invalid Last-Modified " ++ x)
Just y -> return y
lastMod <- forceM "Missing Last-Modified" $ el $/ elContent "LastModified" &| (parseHttpDate' . T.unpack)
etag <- force "Missing ETag" $ el $/ elContent "ETag"
diff -ru orig/Aws/S3/Core.hs new/Aws/S3/Core.hs
--- orig/Aws/S3/Core.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/S3/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -5,8 +5,8 @@
import Control.Arrow ((***))
import Control.Monad
import Control.Monad.IO.Class
+import Control.Monad.Trans.Resource (MonadThrow, throwM)
import Crypto.Hash.CryptoAPI (MD5)
-import Data.Attempt (Attempt(..))
import Data.Conduit (($$+-))
import Data.Function
import Data.IORef
@@ -20,12 +20,10 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception as C
-import qualified Control.Failure as F
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Base64 as Base64
import qualified Data.CaseInsensitive as CI
-import qualified Data.Conduit as C
import qualified Data.Serialize as Serialize
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
@@ -248,10 +246,10 @@
= do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def
let cursor = Cu.fromDocument doc
liftIO $ case parseError cursor of
- Success err -> C.monadThrow err
- Failure otherErr -> C.monadThrow otherErr
+ Right err -> throwM err
+ Left otherErr -> throwM otherErr
where
- parseError :: Cu.Cursor -> Attempt S3Error
+ parseError :: Cu.Cursor -> Either C.SomeException S3Error
parseError root = do code <- force "Missing error Code" $ root $/ elContent "Code"
message <- force "Missing error Message" $ root $/ elContent "Message"
let resource = listToMaybe $ root $/ elContent "Resource"
@@ -279,7 +277,7 @@
}
deriving (Show)
-parseUserInfo :: F.Failure XmlException m => Cu.Cursor -> m UserInfo
+parseUserInfo :: MonadThrow m => Cu.Cursor -> m UserInfo
parseUserInfo el = do id_ <- force "Missing user ID" $ el $/ elContent "ID"
displayName <- force "Missing user DisplayName" $ el $/ elContent "DisplayName"
return UserInfo { userId = id_, userDisplayName = displayName }
@@ -308,10 +306,10 @@
| ReducedRedundancy
deriving (Show)
-parseStorageClass :: F.Failure XmlException m => T.Text -> m StorageClass
+parseStorageClass :: MonadThrow m => T.Text -> m StorageClass
parseStorageClass "STANDARD" = return Standard
parseStorageClass "REDUCED_REDUNDANCY" = return ReducedRedundancy
-parseStorageClass s = F.failure . XmlException $ "Invalid Storage Class: " ++ T.unpack s
+parseStorageClass s = throwM . XmlException $ "Invalid Storage Class: " ++ T.unpack s
writeStorageClass :: StorageClass -> T.Text
writeStorageClass Standard = "STANDARD"
@@ -321,9 +319,9 @@
= AES256
deriving (Show)
-parseServerSideEncryption :: F.Failure XmlException m => T.Text -> m ServerSideEncryption
+parseServerSideEncryption :: MonadThrow m => T.Text -> m ServerSideEncryption
parseServerSideEncryption "AES256" = return AES256
-parseServerSideEncryption s = F.failure . XmlException $ "Invalid Server Side Encryption: " ++ T.unpack s
+parseServerSideEncryption s = throwM . XmlException $ "Invalid Server Side Encryption: " ++ T.unpack s
writeServerSideEncryption :: ServerSideEncryption -> T.Text
writeServerSideEncryption AES256 = "AES256"
@@ -358,11 +356,11 @@
}
deriving (Show)
-parseObjectInfo :: F.Failure XmlException m => Cu.Cursor -> m ObjectInfo
+parseObjectInfo :: MonadThrow m => Cu.Cursor -> m ObjectInfo
parseObjectInfo el
= do key <- force "Missing object Key" $ el $/ elContent "Key"
let time s = case parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" $ T.unpack s of
- Nothing -> F.failure $ XmlException "Invalid time"
+ Nothing -> throwM $ XmlException "Invalid time"
Just v -> return v
lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time
eTag <- force "Missing object ETag" $ el $/ elContent "ETag"
@@ -392,7 +390,7 @@
}
deriving (Show)
-parseObjectMetadata :: F.Failure HeaderException m => HTTP.ResponseHeaders -> m ObjectMetadata
+parseObjectMetadata :: MonadThrow m => HTTP.ResponseHeaders -> m ObjectMetadata
parseObjectMetadata h = ObjectMetadata
`liftM` deleteMarker
`ap` etag
@@ -406,15 +404,15 @@
Nothing -> return False
Just "true" -> return True
Just "false" -> return False
- Just x -> F.failure $ HeaderException ("Invalid x-amz-delete-marker " ++ x)
+ Just x -> throwM $ HeaderException ("Invalid x-amz-delete-marker " ++ x)
etag = case T.decodeUtf8 `fmap` lookup "ETag" h of
Just x -> return x
- Nothing -> F.failure $ HeaderException "ETag missing"
+ Nothing -> throwM $ HeaderException "ETag missing"
lastModified = case B8.unpack `fmap` lookup "Last-Modified" h of
Just ts -> case parseHttpDate ts of
Just t -> return t
- Nothing -> F.failure $ HeaderException ("Invalid Last-Modified: " ++ ts)
- Nothing -> F.failure $ HeaderException "Last-Modified missing"
+ Nothing -> throwM $ HeaderException ("Invalid Last-Modified: " ++ ts)
+ Nothing -> throwM $ HeaderException "Last-Modified missing"
versionId = T.decodeUtf8 `fmap` lookup "x-amz-version-id" h
-- expiration = return undefined
userMetadata = flip mapMaybe ht $
diff -ru orig/Aws/Ses/Core.hs new/Aws/Ses/Core.hs
--- orig/Aws/Ses/Core.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/Ses/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -22,8 +22,8 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception as C
-import qualified Control.Failure as F
import Control.Monad (mplus)
+import Control.Monad.Trans.Resource (throwM)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 ({-IsString-})
@@ -128,7 +128,7 @@
fromError cursor = do
errCode <- force "Missing Error Code" $ cursor $// elContent "Code"
errMessage <- force "Missing Error Message" $ cursor $// elContent "Message"
- F.failure $ SesError (HTTP.responseStatus resp) errCode errMessage
+ throwM $ SesError (HTTP.responseStatus resp) errCode errMessage
class SesAsQuery a where
-- | Write a data type as a list of query parameters.
diff -ru orig/Aws/SimpleDb/Core.hs new/Aws/SimpleDb/Core.hs
--- orig/Aws/SimpleDb/Core.hs 2014-04-04 10:18:25.116401067 +0300
+++ new/Aws/SimpleDb/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -4,8 +4,8 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception as C
-import qualified Control.Failure as F
import Control.Monad
+import Control.Monad.Trans.Resource (MonadThrow, throwM)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as Base64
import Data.IORef
@@ -149,16 +149,16 @@
(err:_) -> fromError err
fromError cursor = do errCode <- force "Missing Error Code" $ cursor $// elCont "Code"
errMessage <- force "Missing Error Message" $ cursor $// elCont "Message"
- F.failure $ SdbError (HTTP.responseStatus resp) errCode errMessage
+ throwM $ SdbError (HTTP.responseStatus resp) errCode errMessage
class SdbFromResponse a where
sdbFromResponse :: Cu.Cursor -> Response SdbMetadata a
-sdbCheckResponseType :: F.Failure XmlException m => a -> T.Text -> Cu.Cursor -> m a
+sdbCheckResponseType :: MonadThrow m => a -> T.Text -> Cu.Cursor -> m a
sdbCheckResponseType a n c = do _ <- force ("Expected response type " ++ T.unpack n) (Cu.laxElement n c)
return a
-decodeBase64 :: F.Failure XmlException m => Cu.Cursor -> m T.Text
+decodeBase64 :: MonadThrow m => Cu.Cursor -> m T.Text
decodeBase64 cursor =
let encoded = T.concat $ cursor $/ Cu.content
encoding = listToMaybe $ cursor $| Cu.laxAttribute "encoding" &| T.toCaseFold
@@ -166,15 +166,15 @@
case encoding of
Nothing -> return encoded
Just "base64" -> case Base64.decode . T.encodeUtf8 $ encoded of
- Left msg -> F.failure $ XmlException ("Invalid Base64 data: " ++ msg)
+ Left msg -> throwM $ XmlException ("Invalid Base64 data: " ++ msg)
Right x -> return $ T.decodeUtf8 x
- Just actual -> F.failure $ XmlException ("Unrecognized encoding " ++ T.unpack actual)
+ Just actual -> throwM $ XmlException ("Unrecognized encoding " ++ T.unpack actual)
data Attribute a
= ForAttribute { attributeName :: T.Text, attributeData :: a }
deriving (Show)
-readAttribute :: F.Failure XmlException m => Cu.Cursor -> m (Attribute T.Text)
+readAttribute :: MonadThrow m => Cu.Cursor -> m (Attribute T.Text)
readAttribute cursor = do
name <- forceM "Missing Name" $ cursor $/ Cu.laxElement "Name" &| decodeBase64
value <- forceM "Missing Value" $ cursor $/ Cu.laxElement "Value" &| decodeBase64
@@ -225,7 +225,7 @@
= Item { itemName :: T.Text, itemData :: a }
deriving (Show)
-readItem :: F.Failure XmlException m => Cu.Cursor -> m (Item [Attribute T.Text])
+readItem :: MonadThrow m => Cu.Cursor -> m (Item [Attribute T.Text])
readItem cursor = do
name <- force "Missing Name" <=< sequence $ cursor $/ Cu.laxElement "Name" &| decodeBase64
attributes <- sequence $ cursor $/ Cu.laxElement "Attribute" &| readAttribute
diff -ru orig/Aws/Sqs/Commands/Message.hs new/Aws/Sqs/Commands/Message.hs
--- orig/Aws/Sqs/Commands/Message.hs 2014-04-04 10:18:25.116401067 +0300
+++ new/Aws/Sqs/Commands/Message.hs 2014-04-04 10:18:24.000000000 +0300
@@ -4,9 +4,9 @@
import Aws.Core
import Aws.Sqs.Core
import Control.Applicative
+import Control.Monad.Trans.Resource (MonadThrow)
import Data.Maybe
import Text.XML.Cursor (($/), ($//), (&/), (&|))
-import qualified Control.Failure as F
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@@ -98,7 +98,7 @@
}
deriving (Show)
-readMessageAttribute :: F.Failure XmlException m => Cu.Cursor -> m (MessageAttribute,T.Text)
+readMessageAttribute :: MonadThrow m => Cu.Cursor -> m (MessageAttribute,T.Text)
readMessageAttribute cursor = do
name <- force "Missing Name" $ cursor $/ Cu.laxElement "Name" &/ Cu.content
value <- force "Missing Value" $ cursor $/ Cu.laxElement "Value" &/ Cu.content
diff -ru orig/Aws/Sqs/Core.hs new/Aws/Sqs/Core.hs
--- orig/Aws/Sqs/Core.hs 2014-04-04 10:18:25.116401067 +0300
+++ new/Aws/Sqs/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -5,14 +5,12 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception as C
-import qualified Control.Failure as F
import Control.Monad
import Control.Monad.IO.Class
-import Data.Attempt (Attempt(..))
+import Control.Monad.Trans.Resource (MonadThrow, throwM)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.Conduit (($$+-))
-import qualified Data.Conduit as C
import Data.IORef
import Data.List
import Data.Maybe
@@ -234,10 +232,10 @@
= do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def
let cursor = Cu.fromDocument doc
liftIO $ case parseError cursor of
- Success err -> C.monadThrow err
- Failure otherErr -> C.monadThrow otherErr
+ Right err -> throwM err
+ Left otherErr -> throwM otherErr
where
- parseError :: Cu.Cursor -> Attempt SqsError
+ parseError :: Cu.Cursor -> Either C.SomeException SqsError
parseError root = do cursor <- force "Missing Error" $ root $/ Cu.laxElement "Error"
code <- force "Missing error Code" $ cursor $/ elContent "Code"
message <- force "Missing error Message" $ cursor $/ elContent "Message"
@@ -291,7 +289,7 @@
| PermissionGetQueueAttributes
deriving (Show, Enum, Eq)
-parseQueueAttribute :: F.Failure XmlException m => T.Text -> m QueueAttribute
+parseQueueAttribute :: MonadThrow m => T.Text -> m QueueAttribute
parseQueueAttribute "ApproximateNumberOfMessages" = return ApproximateNumberOfMessages
parseQueueAttribute "ApproximateNumberOfMessagesNotVisible" = return ApproximateNumberOfMessagesNotVisible
parseQueueAttribute "VisibilityTimeout" = return VisibilityTimeout
@@ -301,7 +299,7 @@
parseQueueAttribute "MaximumMessageSize" = return MaximumMessageSize
parseQueueAttribute "MessageRetentionPeriod" = return MessageRetentionPeriod
parseQueueAttribute "QueueArn" = return QueueArn
-parseQueueAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)
+parseQueueAttribute x = throwM $ XmlException ( "Invalid Attribute Name. " ++ show x)
printQueueAttribute :: QueueAttribute -> T.Text
printQueueAttribute QueueAll = "All"
@@ -315,12 +313,12 @@
printQueueAttribute MessageRetentionPeriod = "MessageRetentionPeriod"
printQueueAttribute QueueArn = "QueueArn"
-parseMessageAttribute :: F.Failure XmlException m => T.Text -> m MessageAttribute
+parseMessageAttribute :: MonadThrow m => T.Text -> m MessageAttribute
parseMessageAttribute "SenderId" = return SenderId
parseMessageAttribute "SentTimestamp" = return SentTimestamp
parseMessageAttribute "ApproximateReceiveCount" = return ApproximateReceiveCount
parseMessageAttribute "ApproximateFirstReceiveTimestamp" = return ApproximateFirstReceiveTimestamp
-parseMessageAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)
+parseMessageAttribute x = throwM $ XmlException ( "Invalid Attribute Name. " ++ show x)
printMessageAttribute :: MessageAttribute -> T.Text
printMessageAttribute MessageAll = "All"
diff -ru orig/aws.cabal new/aws.cabal
--- orig/aws.cabal 2014-04-04 10:18:25.120401065 +0300
+++ new/aws.cabal 2014-04-04 10:18:24.000000000 +0300
@@ -98,8 +98,6 @@
Aws.DynamoDb.Core
Build-depends:
- attempt >= 0.3.1.1 && < 0.5,
- attoparsec-conduit >= 1.0 && < 1.1,
aeson >= 0.6 && < 0.8,
base == 4.*,
base16-bytestring == 0.1.*,
@@ -108,29 +106,30 @@
bytestring >= 0.9 && < 0.11,
case-insensitive >= 0.2 && < 1.3,
cereal >= 0.3 && < 0.5,
- conduit >= 1.0 && < 1.1,
+ conduit >= 1.1 && < 1.2,
+ conduit-extra >= 1.1 && < 1.2,
containers >= 0.4,
crypto-api >= 0.9,
cryptohash >= 0.8 && < 0.12,
cryptohash-cryptoapi == 0.1.*,
data-default == 0.5.*,
directory >= 1.0 && < 1.3,
- failure >= 0.2.0.1 && < 0.3,
filepath >= 1.1 && < 1.4,
- http-conduit >= 1.9 && < 2.1,
+ http-conduit >= 2.1 && < 2.2,
http-types >= 0.7 && < 0.9,
lifted-base >= 0.1 && < 0.3,
monad-control >= 0.3,
mtl == 2.*,
old-locale == 1.*,
- resourcet >= 0.3.3 && <0.5,
+ resourcet >= 1.1 && < 1.2,
text >= 0.11,
time >= 1.1.4 && < 1.5,
transformers >= 0.2.2.0 && < 0.4,
unordered-containers >= 0.2,
utf8-string == 0.3.*,
vector >= 0.10,
- xml-conduit >= 1.1 && <1.2
+ xml-conduit >= 1.2 && <1.3
+ , ghc-prim
GHC-Options: -Wall

12
patching/patches/aws-0.9.3.patch Normal file
View File

@ -0,0 +1,12 @@
diff -ruN orig/aws.cabal new/aws.cabal
--- orig/aws.cabal 2014-08-28 07:02:24.655832025 +0300
+++ new/aws.cabal 2014-08-28 07:02:24.000000000 +0300
@@ -109,7 +109,7 @@
bytestring >= 0.9 && < 0.11,
case-insensitive >= 0.2 && < 1.3,
cereal >= 0.3 && < 0.5,
- conduit >= 1.1 && < 1.2,
+ conduit >= 1.1 && < 1.3,
conduit-extra >= 1.1 && < 1.2,
containers >= 0.4,
cryptohash >= 0.11 && < 0.12,

25
patching/patches/bytes-0.14.0.1.patch
View File

@ -1,25 +0,0 @@
diff -ru orig/src/Data/Bytes/Serial.hs new/src/Data/Bytes/Serial.hs
--- orig/src/Data/Bytes/Serial.hs 2014-06-08 07:58:00.820951939 +0300
+++ new/src/Data/Bytes/Serial.hs 2014-06-08 07:58:00.000000000 +0300
@@ -58,7 +58,9 @@
import Data.Int
import Data.Bits
import Data.Monoid as Monoid
+#if MIN_VERSION_base(4, 6, 0)
import Data.Ord (Down(..))
+#endif
import Data.Functor.Identity as Functor
import Data.Functor.Constant as Functor
import Data.Functor.Product as Functor
@@ -475,9 +477,11 @@
serialize = serialize . (fromIntegral::Int -> Int8) . fromEnum
deserialize = (toEnum . (fromIntegral::Int8 -> Int)) `liftM` deserialize
+#if MIN_VERSION_base(4, 6, 0)
instance Serial a => Serial (Down a) where
serialize (Down a) = serialize a
deserialize = Down `liftM` deserialize
+#endif
instance Serial Version where
serialize (Version vb ts) = serialize (fmap VarInt vb, ts)

46
patching/patches/bzlib-conduit-0.2.1.1.patch
View File

@ -1,46 +0,0 @@
diff -ru orig/bzlib-conduit.cabal new/bzlib-conduit.cabal
--- orig/bzlib-conduit.cabal 2014-04-02 12:25:07.231917434 +0300
+++ new/bzlib-conduit.cabal 2014-04-02 12:25:06.000000000 +0300
@@ -26,7 +26,8 @@
build-depends: base == 4.*
, bytestring >=0.9 && <0.11
, mtl == 2.*
- , conduit >= 0.5 && < 1.1
+ , conduit >= 0.5 && < 1.2
+ , conduit-extra >= 1.0 && < 1.2
, resourcet
, data-default
, bindings-DSL
@@ -54,7 +55,9 @@
, QuickCheck
, random
, conduit
+ , conduit-extra
, bzlib-conduit
+ , resourcet
benchmark bench
type: exitcode-stdio-1.0
@@ -62,4 +65,5 @@
main-is: bench.hs
build-depends: base == 4.*
, conduit
+ , conduit-extra
, bzlib-conduit
diff -ru orig/test/test.hs new/test/test.hs
--- orig/test/test.hs 2014-04-02 12:25:07.227917434 +0300
+++ new/test/test.hs 2014-04-02 12:25:06.000000000 +0300
@@ -1,6 +1,7 @@
{-# LANGUAGE ViewPatterns #-}
import Control.Applicative
import Control.Monad
+import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Conduit
@@ -36,4 +37,4 @@
<$> replicateM (abs n) randomIO
dest <- runResourceT $ do
C.sourceList (P.map S.pack ss) =$= bzip2 =$= bunzip2 $$ B.take (10^9)
- return $ dest == L.pack (concat ss)
+ return $ dest == L.pack (P.concat ss)

53
patching/patches/cereal-conduit-0.7.2.patch
View File

@ -1,53 +0,0 @@
diff -ru orig/cereal-conduit.cabal new/cereal-conduit.cabal
--- orig/cereal-conduit.cabal 2014-04-03 08:22:14.122388542 +0300
+++ new/cereal-conduit.cabal 2014-04-03 08:22:13.000000000 +0300
@@ -19,7 +19,8 @@
library
build-depends: base >= 4 && < 5
- , conduit >= 1.0.0 && < 1.1
+ , conduit >= 1.0.0 && < 1.2
+ , resourcet >= 0.4 && < 1.2
, cereal >= 0.4.0.0 && < 0.5
, bytestring
, transformers >= 0.2.0.0
diff -ru orig/Data/Conduit/Cereal.hs new/Data/Conduit/Cereal.hs
--- orig/Data/Conduit/Cereal.hs 2014-04-03 08:22:14.122388542 +0300
+++ new/Data/Conduit/Cereal.hs 2014-04-03 08:22:13.000000000 +0300
@@ -19,6 +19,7 @@
import Control.Exception.Base
import Control.Monad.Trans.Class (MonadTrans, lift)
+import Control.Monad.Trans.Resource (MonadThrow, monadThrow)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Conduit as C
@@ -34,7 +35,7 @@
instance Exception GetException
-- | Run a 'Get' repeatedly on the input stream, producing an output stream of whatever the 'Get' outputs.
-conduitGet :: C.MonadThrow m => Get o -> C.Conduit BS.ByteString m o
+conduitGet :: MonadThrow m => Get o -> C.Conduit BS.ByteString m o
conduitGet = mkConduitGet errorHandler
where errorHandler msg = pipeError $ GetException msg
@@ -42,7 +43,7 @@
--
-- If 'Get' succeed it will return the data read and unconsumed part of the input stream.
-- If the 'Get' fails due to deserialization error or early termination of the input stream it raise an error.
-sinkGet :: C.MonadThrow m => Get r -> C.Consumer BS.ByteString m r
+sinkGet :: MonadThrow m => Get r -> C.Consumer BS.ByteString m r
sinkGet = mkSinkGet errorHandler terminationHandler
where errorHandler msg = pipeError $ GetException msg
terminationHandler f = case f BS.empty of
@@ -50,8 +51,8 @@
Done r lo -> C.leftover lo >> return r
Partial _ -> pipeError $ GetException "Failed reading: Internal error: unexpected Partial."
-pipeError :: (C.MonadThrow m, MonadTrans t, Exception e) => e -> t m a
-pipeError e = lift $ C.monadThrow e
+pipeError :: (MonadThrow m, MonadTrans t, Exception e) => e -> t m a
+pipeError e = lift $ monadThrow e
-- | Convert a 'Put' into a 'Source'. Runs in constant memory.
sourcePut :: Monad m => Put -> C.Producer m BS.ByteString

21
patching/patches/concurrent-extra-0.7.0.6.patch
View File

@ -1,21 +0,0 @@
diff -ru orig/concurrent-extra.cabal new/concurrent-extra.cabal
--- orig/concurrent-extra.cabal 2014-04-04 14:42:42.732063525 +0300
+++ new/concurrent-extra.cabal 2014-04-04 14:42:42.000000000 +0300
@@ -50,7 +50,7 @@
-------------------------------------------------------------------------------
library
- build-depends: base >= 3 && < 4.7
+ build-depends: base >= 3 && < 4.8
, base-unicode-symbols >= 0.1.1 && < 0.3
, stm >= 2.1.2.1 && < 2.5
, unbounded-delays >= 0.1 && < 0.2
@@ -80,7 +80,7 @@
ghc-options: -Wall -threaded
- build-depends: base >= 3 && < 4.7
+ build-depends: base >= 3 && < 4.8
, base-unicode-symbols >= 0.1.1 && < 0.3
, stm >= 2.1.2.1 && < 2.5
, unbounded-delays >= 0.1 && < 0.2

1643
patching/patches/criterion-1.0.0.2.patch
View File

File diff suppressed because one or more lines are too long

32
patching/patches/csv-conduit-0.6.2.1.patch
View File

@ -1,32 +0,0 @@
diff -ru orig/csv-conduit.cabal new/csv-conduit.cabal
--- orig/csv-conduit.cabal 2014-04-03 10:44:52.994206357 +0300
+++ new/csv-conduit.cabal 2014-04-03 10:44:52.000000000 +0300
@@ -78,6 +78,7 @@
, base >= 4 && < 5
, bytestring
, conduit >= 1.0 && < 2.0
+ , conduit-extra
, containers >= 0.3
, monad-control
, text
@@ -90,6 +91,7 @@
, mtl
, mmorph
, primitive
+ , resourcet
ghc-prof-options: -fprof-auto
if impl(ghc >= 7.2.1)
diff -ru orig/src/Data/CSV/Conduit.hs new/src/Data/CSV/Conduit.hs
--- orig/src/Data/CSV/Conduit.hs 2014-04-03 10:44:52.962206360 +0300
+++ new/src/Data/CSV/Conduit.hs 2014-04-03 10:44:52.000000000 +0300
@@ -36,6 +36,9 @@
import Control.Monad.Primitive
import Control.Monad.ST
import Control.Monad.Trans
+import Control.Monad.Trans.Resource (MonadResource, MonadThrow,
+ runExceptionT,
+ runResourceT)
import Data.Attoparsec.Types (Parser)
import qualified Data.ByteString as B
import Data.ByteString.Char8 (ByteString)

12
patching/patches/diagrams-builder-0.5.0.10.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/diagrams-builder.cabal new/diagrams-builder.cabal
--- orig/diagrams-builder.cabal 2014-05-23 06:40:50.633726383 +0300
+++ new/diagrams-builder.cabal 2014-05-23 06:40:50.000000000 +0300
@@ -59,7 +59,7 @@
cmdargs >= 0.6 && < 0.11,
lens >= 3.9 && < 4.2,
hashable >= 1.1 && < 1.3,
- exceptions >= 0.3 && < 0.6
+ exceptions >= 0.3 && < 0.7
hs-source-dirs: src
default-language: Haskell2010
other-extensions: StandaloneDeriving,

12
patching/patches/diagrams-builder-0.5.0.6.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/diagrams-builder.cabal new/diagrams-builder.cabal
--- orig/diagrams-builder.cabal 2014-04-03 08:17:21.630394766 +0300
+++ new/diagrams-builder.cabal 2014-04-03 08:17:21.000000000 +0300
@@ -59,7 +59,7 @@
cmdargs >= 0.6 && < 0.11,
lens >= 3.9 && < 4.2,
hashable >= 1.1 && < 1.3,
- exceptions >= 0.3 && < 0.4
+ exceptions >= 0.3 && < 0.6
hs-source-dirs: src
default-language: Haskell2010
other-extensions: StandaloneDeriving,

12
patching/patches/diagrams-builder-0.5.0.9.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/diagrams-builder.cabal new/diagrams-builder.cabal
--- orig/diagrams-builder.cabal 2014-05-11 11:28:24.019992070 +0300
+++ new/diagrams-builder.cabal 2014-05-11 11:28:23.000000000 +0300
@@ -59,7 +59,7 @@
cmdargs >= 0.6 && < 0.11,
lens >= 3.9 && < 4.2,
hashable >= 1.1 && < 1.3,
- exceptions >= 0.3 && < 0.6
+ exceptions >= 0.3 && < 0.7
hs-source-dirs: src
default-language: Haskell2010
other-extensions: StandaloneDeriving,

27
patching/patches/diagrams-builder-0.6.patch
View File

@ -1,27 +0,0 @@
diff -ruN orig/diagrams-builder.cabal new/diagrams-builder.cabal
--- orig/diagrams-builder.cabal 2014-08-10 08:43:22.462711726 +0300
+++ new/diagrams-builder.cabal 2014-08-10 08:43:22.000000000 +0300
@@ -57,7 +57,7 @@
split >= 0.2 && < 0.3,
haskell-src-exts >= 1.14 && < 1.16,
cmdargs >= 0.6 && < 0.11,
- lens >= 3.9 && < 4.3,
+ lens,
hashable >= 1.1 && < 1.3,
exceptions >= 0.3 && < 0.7
hs-source-dirs: src
@@ -100,7 +100,7 @@
diagrams-lib >= 0.6 && < 1.3,
diagrams-cairo >= 0.6 && < 1.3,
cmdargs >= 0.6 && < 0.11,
- lens >= 3.8 && < 4.3
+ lens
executable diagrams-builder-svg
main-is: diagrams-builder-svg.hs
@@ -141,4 +141,4 @@
diagrams-lib >= 0.6 && < 1.3,
diagrams-postscript >= 0.6 && < 1.2,
cmdargs >= 0.6 && < 0.11,
- lens >= 3.8 && < 4.3
+ lens

21
patching/patches/diagrams-haddock-0.2.2.10.patch
View File

@ -1,21 +0,0 @@
diff -ruN orig/diagrams-haddock.cabal new/diagrams-haddock.cabal
--- orig/diagrams-haddock.cabal 2014-08-10 08:43:22.698711721 +0300
+++ new/diagrams-haddock.cabal 2014-08-10 08:43:22.000000000 +0300
@@ -48,7 +48,7 @@
diagrams-lib >= 0.6 && < 1.3,
diagrams-svg >= 0.8.0.1 && < 1.2,
vector-space >= 0.8 && < 0.9,
- lens >= 3.8 && < 4.3,
+ lens,
cpphs >= 1.15,
cautious-file >= 1.0 && < 1.1,
uniplate >= 1.6 && < 1.7,
@@ -81,7 +81,7 @@
tasty-quickcheck >= 0.8 && < 0.9,
parsec >= 3,
haskell-src-exts >= 1.14 && < 1.16,
- lens >= 3.8 && < 4.3,
+ lens,
diagrams-haddock
hs-source-dirs: test
default-language: Haskell2010

96
patching/patches/distributed-process-0.4.2.patch
View File

@ -1,96 +0,0 @@
diff -ru orig/distributed-process.cabal new/distributed-process.cabal
--- orig/distributed-process.cabal 2014-03-27 18:23:44.792359466 +0200
+++ new/distributed-process.cabal 2014-03-27 18:23:44.000000000 +0200
@@ -39,7 +39,7 @@
Library
Build-Depends: base >= 4.4 && < 5,
- binary >= 0.5 && < 0.7,
+ binary >= 0.5,
network-transport >= 0.3 && < 0.4,
stm >= 2.3 && < 2.5,
transformers >= 0.2 && < 0.4,
@@ -53,7 +53,7 @@
ghc-prim >= 0.2 && < 0.4,
distributed-static >= 0.2 && < 0.3,
rank1dynamic >= 0.1 && < 0.2,
- syb >= 0.3 && < 0.4
+ syb >= 0.3
Exposed-modules: Control.Distributed.Process,
Control.Distributed.Process.Serializable,
Control.Distributed.Process.Closure,
@@ -90,11 +90,11 @@
Main-Is: TestCH.hs
Build-Depends: base >= 4.4 && < 5,
random >= 1.0 && < 1.1,
- ansi-terminal >= 0.5 && < 0.6,
+ ansi-terminal >= 0.5,
distributed-process,
network-transport >= 0.3 && < 0.4,
network-transport-tcp >= 0.3 && < 0.4,
- binary >= 0.5 && < 0.7,
+ binary >= 0.5,
network >= 2.3 && < 2.5,
HUnit >= 1.2 && < 1.3,
test-framework >= 0.6 && < 0.9,
@@ -111,7 +111,7 @@
Main-Is: TestClosure.hs
Build-Depends: base >= 4.4 && < 5,
random >= 1.0 && < 1.1,
- ansi-terminal >= 0.5 && < 0.6,
+ ansi-terminal >= 0.5,
distributed-static >= 0.2 && < 0.3,
distributed-process,
network-transport >= 0.3 && < 0.4,
@@ -131,13 +131,13 @@
Main-Is: TestStats.hs
Build-Depends: base >= 4.4 && < 5,
random >= 1.0 && < 1.1,
- ansi-terminal >= 0.5 && < 0.6,
+ ansi-terminal >= 0.5,
containers >= 0.4 && < 0.6,
stm >= 2.3 && < 2.5,
distributed-process,
network-transport >= 0.3 && < 0.4,
network-transport-tcp >= 0.3 && < 0.4,
- binary >= 0.5 && < 0.7,
+ binary >= 0.5,
network >= 2.3 && < 2.5,
HUnit >= 1.2 && < 1.3,
test-framework >= 0.6 && < 0.9,
@@ -156,7 +156,7 @@
distributed-process,
network-transport-tcp >= 0.3 && < 0.4,
bytestring >= 0.9 && < 0.11,
- binary >= 0.5 && < 0.7
+ binary >= 0.5
else
buildable: False
Main-Is: benchmarks/Throughput.hs
@@ -169,7 +169,7 @@
distributed-process,
network-transport-tcp >= 0.3 && < 0.4,
bytestring >= 0.9 && < 0.11,
- binary >= 0.5 && < 0.7
+ binary >= 0.5
else
buildable: False
Main-Is: benchmarks/Latency.hs
@@ -182,7 +182,7 @@
distributed-process,
network-transport-tcp >= 0.3 && < 0.4,
bytestring >= 0.9 && < 0.11,
- binary >= 0.5 && < 0.7
+ binary >= 0.5
else
buildable: False
Main-Is: benchmarks/Channels.hs
@@ -195,7 +195,7 @@
distributed-process,
network-transport-tcp >= 0.3 && < 0.4,
bytestring >= 0.9 && < 0.11,
- binary >= 0.5 && < 0.7
+ binary >= 0.5
else
buildable: False
Main-Is: benchmarks/Spawns.hs

21
patching/patches/distributed-process-simplelocalnet-0.2.0.9.patch
View File

@ -1,21 +0,0 @@
diff -ru orig/distributed-process-simplelocalnet.cabal new/distributed-process-simplelocalnet.cabal
--- orig/distributed-process-simplelocalnet.cabal 2014-03-27 18:23:44.960359467 +0200
+++ new/distributed-process-simplelocalnet.cabal 2014-03-27 18:23:44.000000000 +0200
@@ -33,7 +33,7 @@
network >= 2.3 && < 2.5,
network-multicast >= 0.0 && < 0.1,
data-accessor >= 0.2 && < 0.3,
- binary >= 0.5 && < 0.7,
+ binary >= 0.5,
containers >= 0.4 && < 0.6,
transformers >= 0.2 && < 0.4,
network-transport >= 0.3 && < 0.4,
@@ -55,7 +55,7 @@
network >= 2.3 && < 2.5,
network-multicast >= 0.0 && < 0.1,
data-accessor >= 0.2 && < 0.3,
- binary >= 0.5 && < 0.7,
+ binary >= 0.5,
containers >= 0.4 && < 0.6,
transformers >= 0.2 && < 0.4,
network-transport >= 0.3 && < 0.4,

11
patching/patches/distributive-0.4.3.patch
View File

@ -1,11 +0,0 @@
diff -ru orig/distributive.cabal new/distributive.cabal
--- orig/distributive.cabal 2014-04-03 09:44:06.518283977 +0300
+++ new/distributive.cabal 2014-04-03 09:44:06.000000000 +0300
@@ -36,6 +36,7 @@
tagged >= 0.7 && < 1,
transformers >= 0.2 && < 0.4,
transformers-compat >= 0.1 && < 0.2
+ , ghc-prim
hs-source-dirs: src
exposed-modules:

12
patching/patches/esqueleto-1.3.8.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/esqueleto.cabal new/esqueleto.cabal
--- orig/esqueleto.cabal 2014-04-03 08:31:02.238377300 +0300
+++ new/esqueleto.cabal 2014-04-03 08:31:01.000000000 +0300
@@ -91,7 +91,7 @@
, containers
, HUnit
, QuickCheck
- , hspec >= 1.9
+ , hspec >= 1.8
, persistent-sqlite >= 1.2 && < 1.4
, persistent-template >= 1.2 && < 1.4
, monad-control

12
patching/patches/fay-0.19.0.2.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/fay.cabal new/fay.cabal
--- orig/fay.cabal 2014-03-13 05:59:43.874058759 +0200
+++ new/fay.cabal 2014-03-13 05:59:43.000000000 +0200
@@ -122,7 +122,7 @@
, language-ecmascript >= 0.15 && < 1.0
, mtl < 2.2
, pretty-show >= 1.6 && < 1.7
- , process < 1.2
+ , process < 1.3
, safe < 0.4
, split < 0.3
, syb < 0.5

12
patching/patches/fb-1.0.1.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/fb.cabal new/fb.cabal
--- orig/fb.cabal 2014-06-30 12:41:53.267551936 +0300
+++ new/fb.cabal 2014-06-30 12:41:52.000000000 +0300
@@ -76,7 +76,7 @@
, data-default
, http-types
, http-conduit >= 2.0 && < 2.2
- , attoparsec >= 0.10.4 && < 0.12
+ , attoparsec >= 0.10.4 && < 0.13
, unordered-containers
, aeson >= 0.5 && < 0.8
, base16-bytestring >= 0.1

12
patching/patches/foldl-1.0.2.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/foldl.cabal new/foldl.cabal
--- orig/foldl.cabal 2014-03-13 07:47:41.009928017 +0200
+++ new/foldl.cabal 2014-03-13 07:47:40.000000000 +0200
@@ -24,7 +24,7 @@
base >= 4 && < 5 ,
bytestring >= 0.9.2.1 && < 0.11,
primitive < 0.6 ,
- text >= 0.11.2.0 && < 1.1 ,
+ text >= 0.11.2.0 && < 1.2 ,
vector >= 0.7 && < 0.11
Exposed-Modules:
Control.Foldl,

12
patching/patches/force-layout-0.3.0.5.patch
View File

@ -1,12 +0,0 @@
diff -ruN orig/force-layout.cabal new/force-layout.cabal
--- orig/force-layout.cabal 2014-08-10 08:43:22.898711717 +0300
+++ new/force-layout.cabal 2014-08-10 08:43:22.000000000 +0300
@@ -23,7 +23,7 @@
build-depends: base >= 4.2 && < 4.8,
vector-space >=0.7 && <0.9,
vector-space-points >= 0.1.1 && < 0.3,
- lens >= 3 && < 4.3,
+ lens,
containers >=0.4 && < 0.6,
data-default-class >= 0.0.1 && < 0.1
hs-source-dirs: src

23
patching/patches/github-0.7.4.patch
View File

@ -1,23 +0,0 @@
diff -ru orig/Github/Private.hs new/Github/Private.hs
--- orig/Github/Private.hs 2014-04-03 09:50:34.182275724 +0300
+++ new/Github/Private.hs 2014-04-03 09:50:33.000000000 +0300
@@ -14,7 +14,7 @@
import qualified Data.ByteString.Lazy.Char8 as LBS
import Network.HTTP.Types (Method, Status(..))
import Network.HTTP.Conduit
-import Data.Conduit (ResourceT)
+import Control.Monad.Trans.Resource (ResourceT)
import qualified Control.Exception as E
import Data.Maybe (fromMaybe)
diff -ru orig/github.cabal new/github.cabal
--- orig/github.cabal 2014-04-03 09:50:34.194275724 +0300
+++ new/github.cabal 2014-04-03 09:50:33.000000000 +0300
@@ -158,6 +158,7 @@
http-types,
data-default,
vector,
+ resourcet,
unordered-containers >= 0.2 && < 0.3
-- Modules not exported by this package.

191
patching/patches/gitlib-3.0.2.patch
View File

@ -1,191 +0,0 @@
diff -ru orig/Git/Commit/Push.hs new/Git/Commit/Push.hs
--- orig/Git/Commit/Push.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Commit/Push.hs 2014-04-06 09:02:45.000000000 +0300
@@ -1,11 +1,11 @@
module Git.Commit.Push where
import Control.Applicative
-import Control.Failure
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
+import Control.Monad.Trans.Resource
import Data.Function
import qualified Data.HashSet as HashSet
import Data.List
@@ -33,14 +33,14 @@
mrref' <- for mrref $ \rref ->
if rref `elem` commits
then lift $ copyCommitOid rref
- else failure $ PushNotFastForward
+ else throwM $ PushNotFastForward
$ "SHA " <> renderObjOid rref
<> " not found in remote"
objs <- lift $ listAllObjects mrref' coid
let shas = HashSet.fromList $ map (renderOid . untagObjOid) objs
(cref,_) <- copyCommit coid Nothing shas
unless (renderObjOid coid == renderObjOid cref) $
- failure $ BackendError $ "Error copying commit: "
+ throwM $ BackendError $ "Error copying commit: "
<> renderObjOid coid <> " /= " <> renderObjOid cref
-- jww (2013-04-18): This is something the user must decide to do
-- updateReference_ remoteRefName (RefObj cref)
@@ -79,6 +79,6 @@
mref <- fmap renderOid <$> resolveReference refName
unless (maybe False (renderObjOid coid ==) mref) $
- failure (BackendError $
+ throwM (BackendError $
"Could not resolve destination reference '"
<> refName <> "'in project")
diff -ru orig/Git/Commit.hs new/Git/Commit.hs
--- orig/Git/Commit.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Commit.hs 2014-04-06 09:02:45.000000000 +0300
@@ -1,8 +1,8 @@
module Git.Commit where
-import Control.Failure
import Control.Monad
import Control.Monad.Trans.Class
+import Control.Monad.Trans.Resource
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Function
@@ -41,7 +41,7 @@
(parentRefs,needed') <- foldM copyParent ([],needed) parents
(tr,needed'') <- copyTree (commitTree commit) needed'
unless (renderObjOid (commitTree commit) == renderObjOid tr) $
- failure $ BackendError $ "Error copying tree: "
+ throwM $ BackendError $ "Error copying tree: "
<> renderObjOid (commitTree commit)
<> " /= " <> renderObjOid tr
@@ -60,7 +60,7 @@
copyParent (prefs,needed') cref = do
(cref2,needed'') <- copyCommit cref Nothing needed'
unless (renderObjOid cref == renderObjOid cref2) $
- failure $ BackendError $ "Error copying commit: "
+ throwM $ BackendError $ "Error copying commit: "
<> renderObjOid cref <> " /= " <> renderObjOid cref2
let x = cref2 `seq` (cref2:prefs)
return $ x `seq` needed'' `seq` (x,needed'')
diff -ru orig/Git/Repository.hs new/Git/Repository.hs
--- orig/Git/Repository.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Repository.hs 2014-04-06 09:02:45.000000000 +0300
@@ -6,6 +6,7 @@
import Data.Conduit
import Git.Types
import System.Directory
+import Control.Monad.Trans.Control (MonadBaseControl)
withNewRepository :: (MonadGit r n, MonadBaseControl IO n, MonadIO m)
=> RepositoryFactory n m r
diff -ru orig/Git/Tree/Builder.hs new/Git/Tree/Builder.hs
--- orig/Git/Tree/Builder.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Tree/Builder.hs 2014-04-06 09:02:45.000000000 +0300
@@ -25,12 +25,12 @@
) where
import Control.Applicative
-import Control.Failure
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Logger
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
+import Control.Monad.Trans.Resource
import Control.Monad.Trans.State
import qualified Data.ByteString as B
import Data.Char
@@ -143,9 +143,9 @@
update bm _ _ (Right Nothing) = return (bm, TreeEntryNotFound)
update _ _ _ (Right (Just BlobEntry {})) =
- failure TreeCannotTraverseBlob
+ throwM TreeCannotTraverseBlob
update _ _ _ (Right (Just CommitEntry {})) =
- failure TreeCannotTraverseCommit
+ throwM TreeCannotTraverseCommit
update bm name names arg = do
sbm <- case arg of
diff -ru orig/Git/Tree.hs new/Git/Tree.hs
--- orig/Git/Tree.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Tree.hs 2014-04-06 09:02:45.000000000 +0300
@@ -1,8 +1,8 @@
module Git.Tree where
-import Control.Failure
import Control.Monad
import Control.Monad.Trans.Class
+import Control.Monad.Trans.Resource
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.HashSet (HashSet)
@@ -22,7 +22,7 @@
copyTreeEntry (BlobEntry oid kind) needed = do
(b,needed') <- copyBlob oid needed
unless (renderObjOid oid == renderObjOid b) $
- failure $ BackendError $ "Error copying blob: "
+ throwM $ BackendError $ "Error copying blob: "
<> renderObjOid oid <> " /= " <> renderObjOid b
return (BlobEntry b kind, needed')
copyTreeEntry (CommitEntry oid) needed = do
diff -ru orig/Git/Types.hs new/Git/Types.hs
--- orig/Git/Types.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Types.hs 2014-04-06 09:02:45.000000000 +0300
@@ -2,9 +2,9 @@
import Control.Applicative
import qualified Control.Exception.Lifted as Exc
-import Control.Failure
import Control.Monad
import Control.Monad.Trans.Class
+import Control.Monad.Trans.Resource
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as BL
@@ -35,7 +35,7 @@
-- | 'Repository' is the central point of contact between user code and Git
-- data objects. Every object must belong to some repository.
-class (Applicative m, Monad m, Failure GitException m,
+class (Applicative m, Monad m, MonadThrow m,
IsOid (Oid r), Show (Oid r), Eq (Oid r), Ord (Oid r))
=> MonadGit r m | m -> r where
type Oid r :: *
diff -ru orig/Git/Working.hs new/Git/Working.hs
--- orig/Git/Working.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Working.hs 2014-04-06 09:02:45.000000000 +0300
@@ -3,7 +3,6 @@
module Git.Working where
import Control.Applicative
-import Control.Failure
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Conduit
@@ -39,7 +38,7 @@
| cloneSubmodules -> cloneSubmodule oid fullPath
| otherwise -> liftIO $ createDirectory fullPath
where
- decodeError path e = failure $ PathEncodingError $
+ decodeError path e = throwM $ PathEncodingError $
"Could not decode path " <> T.pack (show path) <> ":" <> T.pack e
checkoutBlob oid kind fullPath = do
diff -ru orig/gitlib.cabal new/gitlib.cabal
--- orig/gitlib.cabal 2014-04-06 09:02:45.575789820 +0300
+++ new/gitlib.cabal 2014-04-06 09:02:45.000000000 +0300
@@ -43,9 +43,9 @@
, base16-bytestring >= 0.1.1.5
, bytestring >= 0.9.2.1
, conduit >= 1.0.0
+ , conduit-extra >= 1.0.0
, containers >= 0.4.2.1
, directory >= 1.1.0.2
- , failure >= 0.2.0.1
, filepath >= 1.3.0.0
, hashable >= 1.1.2.5
, lifted-base >= 0.2

43
patching/patches/gitlib-cmdline-3.0.1.patch
View File

@ -1,43 +0,0 @@
diff -ru orig/Git/CmdLine.hs new/Git/CmdLine.hs
--- orig/Git/CmdLine.hs 2014-04-06 18:49:23.851795879 +0300
+++ new/Git/CmdLine.hs 2014-04-06 18:49:23.000000000 +0300
@@ -23,8 +23,9 @@
import Control.Monad.Reader.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
+import Control.Monad.Trans.Resource (MonadThrow (..))
import qualified Data.ByteString as B
-import Data.Conduit hiding (MonadBaseControl)
+import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Foldable (for_)
import Data.Function
@@ -88,7 +89,7 @@
-- instance HasCliRepo (env, CliRepo) where
-- getCliRepo = snd
-instance (Applicative m, Failure GitException m, MonadIO m)
+instance (Applicative m, Failure GitException m, MonadIO m, MonadThrow m)
=> MonadGit CliRepo (ReaderT CliRepo m) where
type Oid CliRepo = SHA
data Tree CliRepo = CmdLineTree (TreeOid CliRepo)
@@ -127,7 +128,7 @@
diffContentsWithTree = error "Not defined cliDiffContentsWithTree"
-type MonadCli m = (Applicative m, Failure GitException m, MonadIO m)
+type MonadCli m = (Applicative m, Failure GitException m, MonadIO m, MonadThrow m)
mkOid :: MonadCli m => forall o. TL.Text -> ReaderT CliRepo m (Tagged o SHA)
mkOid = fmap Tagged <$> textToSha . toStrict
diff -ru orig/gitlib-cmdline.cabal new/gitlib-cmdline.cabal
--- orig/gitlib-cmdline.cabal 2014-04-06 18:49:23.895795879 +0300
+++ new/gitlib-cmdline.cabal 2014-04-06 18:49:23.000000000 +0300
@@ -39,6 +39,7 @@
, transformers >= 0.2.2
, transformers-base >= 0.4.1
, unordered-containers >= 0.2.3.0
+ , resourcet
exposed-modules:
Git.CmdLine

280
patching/patches/gitlib-libgit2-3.0.1.patch
View File

@ -1,280 +0,0 @@
diff -ru orig/Git/Libgit2/Internal.hs new/Git/Libgit2/Internal.hs
--- orig/Git/Libgit2/Internal.hs 2014-04-06 09:02:46.523789820 +0300
+++ new/Git/Libgit2/Internal.hs 2014-04-06 09:02:46.000000000 +0300
@@ -8,9 +8,9 @@
import Bindings.Libgit2
import Control.Applicative
-import Control.Failure
import Control.Monad
import Control.Monad.Trans.Control
+import Control.Monad.Trans.Resource
import Data.ByteString
import qualified Data.Text as T
import qualified Data.Text.ICU.Convert as U
@@ -85,7 +85,7 @@
let p = castPtr ptr'
fptr <- FC.newForeignPtr p (c'git_object_free p)
run $ Right <$> createFn coidCopy (castForeignPtr fptr) ptr'
- either (failure . Git.BackendError) return result
+ either (throwM . Git.BackendError) return result
-- lgLookupObject :: Text -> LgRepository Dynamic
-- lgLookupObject str
diff -ru orig/Git/Libgit2/Types.hs new/Git/Libgit2/Types.hs
--- orig/Git/Libgit2/Types.hs 2014-04-06 09:02:46.523789820 +0300
+++ new/Git/Libgit2/Types.hs 2014-04-06 09:02:46.000000000 +0300
@@ -10,10 +10,10 @@
import Bindings.Libgit2
import Control.Applicative
-import Control.Failure
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Trans.Control
+import Control.Monad.Trans.Resource
import Data.IORef
import Foreign.ForeignPtr
import qualified Git
@@ -52,7 +52,7 @@
type TreeBuilder = Git.TreeBuilder LgRepo
type Options = Git.Options LgRepo
-type MonadLg m = (Applicative m, Failure Git.GitException m,
+type MonadLg m = (Applicative m, MonadThrow m,
MonadIO m, MonadBaseControl IO m, MonadLogger m)
-- Types.hs
diff -ru orig/Git/Libgit2.hs new/Git/Libgit2.hs
--- orig/Git/Libgit2.hs 2014-04-06 09:02:46.523789820 +0300
+++ new/Git/Libgit2.hs 2014-04-06 09:02:46.000000000 +0300
@@ -60,7 +60,6 @@
import Control.Concurrent.Async.Lifted
import Control.Concurrent.STM
import Control.Exception.Lifted
-import Control.Failure
import Control.Monad hiding (forM, forM_, mapM, mapM_, sequence)
import Control.Monad.IO.Class
import Control.Monad.Logger
@@ -154,11 +153,11 @@
lgParseOid :: MonadLg m => Text -> m Oid
lgParseOid str
- | len > 40 = failure (Git.OidParseFailed str)
+ | len > 40 = throwM (Git.OidParseFailed str)
| otherwise = do
moid <- liftIO $ lgParseOidIO str len
case moid of
- Nothing -> failure (Git.OidParseFailed str)
+ Nothing -> throwM (Git.OidParseFailed str)
Just oid -> return oid
where
len = T.length str
@@ -179,7 +178,7 @@
instance Eq OidPtr where
oid1 == oid2 = oid1 `compare` oid2 == EQ
-instance (Applicative m, Failure Git.GitException m,
+instance (Applicative m, MonadThrow m,
MonadBaseControl IO m, MonadIO m, MonadLogger m)
=> Git.MonadGit LgRepo (ReaderT LgRepo m) where
type Oid LgRepo = OidPtr
@@ -427,7 +426,7 @@
return $ Just fptr
case mfptr of
Nothing ->
- failure (Git.TreeCreateFailed "Failed to create new tree builder")
+ throwM (Git.TreeCreateFailed "Failed to create new tree builder")
Just fptr -> do
toid <- mapM Git.treeOid mtree
return (lgMakeBuilder fptr) { Git.mtbBaseTreeOid = toid }
@@ -441,7 +440,7 @@
withFilePath key $ \name ->
c'git_treebuilder_insert nullPtr ptr name coid
(fromIntegral mode)
- when (r2 < 0) $ failure (Git.TreeBuilderInsertFailed key)
+ when (r2 < 0) $ throwM (Git.TreeBuilderInsertFailed key)
treeEntryToOid :: TreeEntry -> (Oid, CUInt)
treeEntryToOid (Git.BlobEntry oid kind) =
@@ -503,7 +502,7 @@
liftIO $ withForeignPtr fptr $ \builder -> alloca $ \pptr -> do
r <- c'git_treebuilder_create pptr nullPtr
when (r < 0) $
- failure (Git.BackendError "Could not create new treebuilder")
+ throwM (Git.BackendError "Could not create new treebuilder")
builder' <- peek pptr
bracket
(mk'git_treebuilder_filter_cb (callback builder'))
@@ -522,7 +521,7 @@
coid
fmode
when (r < 0) $
- failure (Git.BackendError "Could not insert entry in treebuilder")
+ throwM (Git.BackendError "Could not insert entry in treebuilder")
return 0
lgLookupTree :: MonadLg m => TreeOid -> ReaderT LgRepo m Tree
@@ -547,7 +546,7 @@
0o100644 -> return Git.PlainBlob
0o100755 -> return Git.ExecutableBlob
0o120000 -> return Git.SymlinkBlob
- _ -> failure $ Git.BackendError $
+ _ -> throwM $ Git.BackendError $
"Unknown blob mode: " <> T.pack (show mode)
| typ == c'GIT_OBJ_TREE ->
return $ Git.TreeEntry (Tagged (mkOid oid))
@@ -642,7 +641,7 @@
r1 <- c'git_odb_exists ptr coid 0
c'git_odb_free ptr
return (Just (r1 == 0))
- maybe (failure Git.RepositoryInvalid) return result
+ maybe (throwM Git.RepositoryInvalid) return result
lgForEachObject :: Ptr C'git_odb
-> (Ptr C'git_oid -> Ptr () -> IO CInt)
@@ -663,7 +662,7 @@
r <- withForeignPtr (repoObj repo) $ \repoPtr ->
c'git_revwalk_new pptr repoPtr
when (r < 0) $
- failure (Git.BackendError "Could not create revwalker")
+ throwM (Git.BackendError "Could not create revwalker")
ptr <- peek pptr
FC.newForeignPtr ptr (c'git_revwalk_free ptr)
@@ -673,7 +672,7 @@
liftIO $ withForeignPtr (getOid oid) $ \coid -> do
r2 <- withForeignPtr walker $ flip c'git_revwalk_push coid
when (r2 < 0) $
- failure (Git.BackendError $ "Could not push oid "
+ throwM (Git.BackendError $ "Could not push oid "
<> pack (show oid) <> " onto revwalker")
case mhave of
@@ -681,7 +680,7 @@
Just have -> liftIO $ withForeignPtr (getOid (untag have)) $ \coid -> do
r2 <- withForeignPtr walker $ flip c'git_revwalk_hide coid
when (r2 < 0) $
- failure (Git.BackendError $ "Could not hide commit "
+ throwM (Git.BackendError $ "Could not hide commit "
<> pack (show (untag have)) <> " from revwalker")
liftIO $ withForeignPtr walker $ flip c'git_revwalk_sorting
@@ -831,7 +830,7 @@
else do
ref <- peek ptr
c'git_reference_delete ref
- when (r < 0) $ failure (Git.ReferenceDeleteFailed name)
+ when (r < 0) $ throwM (Git.ReferenceDeleteFailed name)
-- int git_reference_packall(git_repository *repo)
@@ -957,7 +956,7 @@
--compareRef = c'git_reference_cmp
-lgThrow :: (MonadIO m, Failure e m) => (Text -> e) -> m ()
+lgThrow :: (Exception e, MonadIO m, MonadThrow m) => (Text -> e) -> m ()
lgThrow f = do
errStr <- liftIO $ do
errPtr <- c'giterr_last
@@ -966,7 +965,7 @@
else do
err <- peek errPtr
peekCString (c'git_error'message err)
- failure (f (pack errStr))
+ throwM (f (pack errStr))
-- withLgTempRepo :: MonadLg m => ReaderT LgRepo m a -> m a
-- withLgTempRepo f = withTempDir $ \dir -> do
@@ -1048,13 +1047,13 @@
-- (Either Git.SHA ByteString)) m
-- (Git.TreeFilePath, Either Git.SHA ByteString)
handlePath (Right _) =
- lift $ failure $ Git.DiffTreeToIndexFailed
+ lift $ throwM $ Git.DiffTreeToIndexFailed
"Received a Right value when a Left RawFilePath was expected"
handlePath (Left path) = do
mcontent <- await
case mcontent of
Nothing ->
- lift $ failure $ Git.DiffTreeToIndexFailed $
+ lift $ throwM $ Git.DiffTreeToIndexFailed $
"Content not provided for " <> T.pack (show path)
Just x -> handleContent path x
@@ -1064,11 +1063,11 @@
-- (Either Git.SHA ByteString)) m
-- (Git.TreeFilePath, Either Git.SHA ByteString)
handleContent _path (Left _) =
- lift $ failure $ Git.DiffTreeToIndexFailed
+ lift $ throwM $ Git.DiffTreeToIndexFailed
"Received a Left value when a Right ByteString was expected"
handleContent path (Right content) = return (path, content)
- -- diffBlob :: Failure Git.GitException m
+ -- diffBlob :: MonadThrow m
-- => Git.TreeFilePath
-- -> Maybe (Either Git.SHA ByteString)
-- -> Maybe (ForeignPtr C'git_oid)
@@ -1183,8 +1182,8 @@
B.cons (fromIntegral lineOrigin) bs
return 0
-checkResult :: (Eq a, Num a, Failure Git.GitException m) => a -> Text -> m ()
-checkResult r why = when (r /= 0) $ failure (Git.BackendError why)
+checkResult :: (Eq a, Num a, MonadThrow m) => a -> Text -> m ()
+checkResult r why = when (r /= 0) $ throwM (Git.BackendError why)
lgBuildPackFile :: MonadLg m
=> FilePath -> [Either CommitOid TreeOid]
@@ -1353,7 +1352,7 @@
lgLoadPackFileInMemory
:: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> FilePath
-> Ptr (Ptr C'git_odb_backend)
-> Ptr (Ptr C'git_odb)
@@ -1385,7 +1384,7 @@
return odbPtr
lgOpenPackFile :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> FilePath -> m (Ptr C'git_odb)
lgOpenPackFile idxPath = control $ \run ->
alloca $ \odbPtrPtr ->
@@ -1393,17 +1392,17 @@
lgLoadPackFileInMemory idxPath backendPtrPtr odbPtrPtr
lgClosePackFile :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> Ptr C'git_odb -> m ()
lgClosePackFile = liftIO . c'git_odb_free
lgWithPackFile :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> FilePath -> (Ptr C'git_odb -> m a) -> m a
lgWithPackFile idxPath = bracket (lgOpenPackFile idxPath) lgClosePackFile
lgReadFromPack :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> Ptr C'git_odb -> Git.SHA -> Bool
-> m (Maybe (C'git_otype, CSize, ByteString))
lgReadFromPack odbPtr sha metadataOnly = liftIO $ do
diff -ru orig/gitlib-libgit2.cabal new/gitlib-libgit2.cabal
--- orig/gitlib-libgit2.cabal 2014-04-06 09:02:46.527789820 +0300
+++ new/gitlib-libgit2.cabal 2014-04-06 09:02:46.000000000 +0300
@@ -42,7 +42,6 @@
, conduit >= 0.5.5
, containers >= 0.4.2.1
, directory >= 1.1.0.2
- , failure >= 0.2.0.1
, fast-logger
, filepath >= 1.3.0
, lifted-async >= 0.1.0

276
patching/patches/gitlib-s3-3.0.2.patch
View File

@ -1,276 +0,0 @@
diff -ru orig/Git/S3.hs new/Git/S3.hs
--- orig/Git/S3.hs 2014-04-06 09:02:47.247789820 +0300
+++ new/Git/S3.hs 2014-04-06 09:02:47.000000000 +0300
@@ -42,7 +42,6 @@
import Control.Monad.Trans.Resource
import Control.Retry
import Data.Aeson as A
-import Data.Attempt
import Data.Bifunctor
import Data.Binary as Bin
import Data.ByteString (ByteString)
@@ -141,7 +140,7 @@
}
deriving (Eq, Show, Generic)
-type MonadS3 m = (Failure Git.GitException m,
+type MonadS3 m = (MonadThrow m,
MonadIO m, MonadBaseControl IO m, MonadLogger m)
data BackendCallbacks = BackendCallbacks
@@ -478,7 +477,10 @@
-> ResourceT m (Response (ResponseMetadata a) a)
awsRetry cfg svcfg mgr r =
transResourceT liftIO $
- retrying def (isFailure . responseResult) $ aws cfg svcfg mgr r
+ retrying def (isLeft . responseResult) $ aws cfg svcfg mgr r
+ where
+ isLeft Left{} = True
+ isLeft Right{} = False
listBucketS3 :: MonadS3 m => OdbS3Details -> ResourceT m [Text]
listBucketS3 dets = do
@@ -622,7 +624,7 @@
sha <- oidToSha oid
modifyIORef mshas (sha:)
return c'GIT_OK
- checkResult r "lgForEachObject failed"
+ either throwM return $ checkResult r "lgForEachObject failed"
-- Update the known objects map with the fact that we've got a local cache
-- of the pack file.
@@ -637,7 +639,7 @@
++ show (Prelude.length shas) ++ " objects"
return shas
-catalogPackFile :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+catalogPackFile :: (MonadS3 m, MonadThrow m)
=> OdbS3Details -> Text -> FilePath -> m [SHA]
catalogPackFile dets packSha idxPath = do
-- Load the pack file, and iterate over the objects within it to determine
@@ -710,7 +712,7 @@
lgDebug $ "cacheUpdateEntry " ++ show (shaToText sha) ++ " " ++ show ce
liftIO $ atomically $ modifyTVar (knownObjects dets) $ M.insert sha ce
-cacheLoadObject :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+cacheLoadObject :: (MonadS3 m, MonadThrow m)
=> OdbS3Details -> SHA -> CacheEntry -> Bool
-> m (Maybe ObjectInfo)
cacheLoadObject dets sha ce metadataOnly = do
@@ -958,7 +960,7 @@
remoteStoreObject _ _ _ =
throw (Git.BackendError "remoteStoreObject was not given any data")
-remoteCatalogContents :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+remoteCatalogContents :: (MonadS3 m, MonadThrow m)
=> OdbS3Details -> ResourceT m ()
remoteCatalogContents dets = do
lgDebug "remoteCatalogContents"
@@ -982,7 +984,7 @@
| otherwise -> return ()
-accessObject :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+accessObject :: (MonadS3 m, MonadThrow m)
=> OdbS3Details -> SHA -> Bool -> m (Maybe CacheEntry)
accessObject dets sha checkRemote = do
mentry <- cacheLookupEntry dets sha
@@ -1032,19 +1034,19 @@
-- cache and with the callback interface. This is to avoid recataloging
-- in the future.
-objectExists :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+objectExists :: (MonadS3 m, MonadThrow m)
=> OdbS3Details -> SHA -> Bool -> m CacheEntry
objectExists dets sha checkRemote = do
mce <- accessObject dets sha checkRemote
return $ fromMaybe DoesNotExist mce
-readObject :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+readObject :: (MonadS3 m, MonadThrow m)
=> OdbS3Details -> SHA -> Bool -> m (Maybe ObjectInfo)
readObject dets sha metadataOnly = do
ce <- objectExists dets sha True
cacheLoadObject dets sha ce metadataOnly `orElse` return Nothing
-readObjectMetadata :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+readObjectMetadata :: (MonadS3 m, MonadThrow m)
=> OdbS3Details -> SHA -> m (Maybe ObjectInfo)
readObjectMetadata dets sha = readObject dets sha True
@@ -1054,7 +1056,7 @@
callbackRegisterObject dets sha info
cacheStoreObject dets sha info
-writePackFile :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+writePackFile :: (MonadS3 m, MonadThrow m)
=> OdbS3Details -> BL.ByteString -> m ()
writePackFile dets bytes = do
let dir = tempDirectory dets
@@ -1073,7 +1075,7 @@
shas <- catalogPackFile dets packSha idxPath
callbackRegisterPackFile dets packSha shas
-readCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+readCallback :: (MonadS3 m, MonadThrow m)
=> Ptr (Ptr ())
-> Ptr CSize
-> Ptr C'git_otype
@@ -1104,7 +1106,7 @@
BU.unsafeUseAsCString chunk $ copyBytes p ?? len
return $ p `plusPtr` len
-readPrefixCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+readPrefixCallback :: (MonadS3 m, MonadThrow m)
=> Ptr C'git_oid
-> Ptr (Ptr ())
-> Ptr CSize
@@ -1140,7 +1142,7 @@
go dets sha False
| otherwise = return Nothing
-readHeaderCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+readHeaderCallback :: (MonadS3 m, MonadThrow m)
=> Ptr CSize
-> Ptr C'git_otype
-> Ptr C'git_odb_backend
@@ -1158,7 +1160,7 @@
poke len_p (toLength len)
poke type_p (toType typ)
-writeCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+writeCallback :: (MonadS3 m, MonadThrow m)
=> Ptr C'git_oid
-> Ptr C'git_odb_backend
-> Ptr ()
@@ -1184,7 +1186,7 @@
(ObjectInfo (fromLength len) (fromType obj_type)
Nothing (Just (BL.fromChunks [bytes])))
-existsCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+existsCallback :: (MonadS3 m, MonadThrow m)
=> Ptr C'git_odb_backend -> Ptr C'git_oid -> CInt -> m CInt
existsCallback be oid confirmNotExists = do
(dets, sha) <- liftIO $ unpackDetails be oid
@@ -1194,18 +1196,18 @@
return $ if ce == DoesNotExist then 0 else 1)
(return c'GIT_ERROR)
-refreshCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+refreshCallback :: (MonadS3 m, MonadThrow m)
=> Ptr C'git_odb_backend -> m CInt
refreshCallback _ =
return c'GIT_OK -- do nothing
-foreachCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+foreachCallback :: (MonadS3 m, MonadThrow m)
=> Ptr C'git_odb_backend -> C'git_odb_foreach_cb -> Ptr ()
-> m CInt
foreachCallback _be _callback _payload =
return c'GIT_ERROR -- fallback to standard method
-writePackCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+writePackCallback :: (MonadS3 m, MonadThrow m)
=> Ptr (Ptr C'git_odb_writepack)
-> Ptr C'git_odb_backend
-> C'git_transfer_progress_callback
@@ -1248,7 +1250,7 @@
foreign import ccall "&freeCallback"
freeCallbackPtr :: FunPtr F'git_odb_backend_free_callback
-packAddCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+packAddCallback :: (MonadS3 m, MonadThrow m)
=> Ptr C'git_odb_writepack
-> Ptr ()
-> CSize
@@ -1267,7 +1269,7 @@
(castPtr dataPtr) (fromIntegral len)
writePackFile dets (BL.fromChunks [bytes])
-packCommitCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+packCommitCallback :: (MonadS3 m, MonadThrow m)
=> Ptr C'git_odb_writepack -> Ptr C'git_transfer_progress
-> m CInt
packCommitCallback _wp _progress =
@@ -1380,7 +1382,7 @@
liftIO $ writeIORef result res
readIORef result
-odbS3Backend :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+odbS3Backend :: (MonadS3 m, MonadThrow m)
=> Aws.S3Configuration NormalQuery
-> Configuration
-> Manager
@@ -1475,7 +1477,7 @@
-- | Given a repository object obtained from Libgit2, add an S3 backend to it,
-- making it the primary store for objects associated with that repository.
-addS3Backend :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+addS3Backend :: (MonadS3 m, MonadThrow m)
=> LgRepo
-> Text -- ^ bucket
-> Text -- ^ prefix
@@ -1505,7 +1507,7 @@
void $ liftIO $ odbBackendAdd repo odbS3 100
return repo
-s3Factory :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+s3Factory :: (MonadS3 m, MonadThrow m)
=> Maybe Text -> Text -> Text -> FilePath -> BackendCallbacks
-> Git.RepositoryFactory (ReaderT LgRepo (NoLoggingT m)) m LgRepo
s3Factory bucket accessKey secretKey dir callbacks = lgFactory
@@ -1528,7 +1530,7 @@
dir
callbacks
-s3FactoryLogger :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
+s3FactoryLogger :: (MonadS3 m, MonadThrow m)
=> Maybe Text -> Text -> Text -> FilePath -> BackendCallbacks
-> Git.RepositoryFactory (ReaderT LgRepo m) m LgRepo
s3FactoryLogger bucket accessKey secretKey dir callbacks = lgFactoryLogger
diff -ru orig/gitlib-s3.cabal new/gitlib-s3.cabal
--- orig/gitlib-s3.cabal 2014-04-06 09:02:47.247789820 +0300
+++ new/gitlib-s3.cabal 2014-04-06 09:02:47.000000000 +0300
@@ -33,7 +33,6 @@
, hspec-expectations >= 0.3
, data-default >= 0.5.1
, directory >= 1.1.0.2
- , failure >= 0.2.0.1
, filepath >= 1.3.0
, monad-logger >= 0.3.1.1
, resourcet >= 0.4.6
@@ -52,12 +51,12 @@
, ghc-prim
, hlibgit2 >= 0.18.0.11
, aeson >= 0.6.1.0
- , attempt >= 0.4.0
, aws >= 0.7.5
, bifunctors >= 3.2.0.1
, binary >= 0.5.1.0
, bytestring >= 0.9.2.1
, conduit >= 0.5.5
+ , conduit-extra
, data-default >= 0.5.1
, directory >= 1.1.0.2
, filepath >= 1.3.0
diff -ru orig/test/Smoke.hs new/test/Smoke.hs
--- orig/test/Smoke.hs 2014-04-06 09:02:47.247789820 +0300
+++ new/test/Smoke.hs 2014-04-06 09:02:47.000000000 +0300
@@ -11,7 +11,6 @@
import Aws
import Control.Applicative
-import Control.Failure
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Trans.Reader
@@ -30,8 +29,7 @@
import Test.Hspec.Runner
s3Factory
- :: (Failure Git.GitException m, MonadIO m, MonadBaseControl IO m,
- MonadUnsafeIO m, MonadThrow m)
+ :: (MonadThrow m, MonadIO m, MonadBaseControl IO m)
=> Git.RepositoryFactory (ReaderT Lg.LgRepo (NoLoggingT m)) m Lg.LgRepo
s3Factory = Lg.lgFactory
{ Git.runRepository = \ctxt m ->

11
patching/patches/gitlib-test-3.0.1.patch
View File

@ -1,11 +0,0 @@
diff -ru orig/gitlib-test.cabal new/gitlib-test.cabal
--- orig/gitlib-test.cabal 2014-04-06 09:02:47.671789820 +0300
+++ new/gitlib-test.cabal 2014-04-06 09:02:47.000000000 +0300
@@ -28,6 +28,7 @@
, bytestring
, failure >= 0.2.0
, conduit
+ , conduit-extra
, monad-control >= 0.3.1
, tagged >= 0.4.4
, text >= 0.11.2

12
patching/patches/haskell-names-0.3.2.6.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/haskell-names.cabal new/haskell-names.cabal
--- orig/haskell-names.cabal 2014-03-06 15:00:30.424709530 +0200
+++ new/haskell-names.cabal 2014-03-06 15:00:30.000000000 +0200
@@ -271,7 +271,7 @@
, data-lens-template
, tagged
, traverse-with-class
- , type-eq == 0.4
+ , type-eq >= 0.4
, Cabal >= 1.14 && < 1.20
Hs-source-dirs: src
Ghc-options: -Wall -fno-warn-name-shadowing

11
patching/patches/haskell-packages-0.2.3.3.patch
View File

@ -1,11 +0,0 @@
diff -ru orig/haskell-packages.cabal new/haskell-packages.cabal
--- orig/haskell-packages.cabal 2014-02-20 12:04:23.945608732 +0200
+++ new/haskell-packages.cabal 2014-02-20 12:04:23.000000000 +0200
@@ -48,6 +48,6 @@
, containers
, mtl >= 2.1
, hse-cpp
- , EitherT
+ , either
, haskell-src-exts >= 1.14
, tagged

12
patching/patches/hdaemonize-0.4.5.0.patch
View File

@ -1,12 +0,0 @@
diff -ruN orig/System/Posix/Daemonize.hs new/System/Posix/Daemonize.hs
--- orig/System/Posix/Daemonize.hs 2014-08-10 13:47:22.378323475 +0300
+++ new/System/Posix/Daemonize.hs 2014-08-10 13:47:22.000000000 +0300
@@ -147,7 +147,7 @@
process daemon' args
where
- program' daemon = withSyslog (fromJust $ name daemon) (syslogOptions daemon) DAEMON $
+ program' daemon = withSyslog (fromJust $ name daemon) (syslogOptions daemon) DAEMON [] $
do let log = syslog Notice
log "starting"
pidWrite daemon

12
patching/patches/heist-0.13.0.6.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/heist.cabal new/heist.cabal
--- orig/heist.cabal 2014-03-13 06:02:39.554055215 +0200
+++ new/heist.cabal 2014-03-13 06:02:39.000000000 +0200
@@ -153,7 +153,7 @@
filepath >= 1.3 && < 1.4,
hashable >= 1.1 && < 1.3,
mtl >= 2.0 && < 2.2,
- process >= 1.1 && < 1.2,
+ process >= 1.1 && < 1.3,
random >= 1.0.1.0 && < 1.1,
text >= 0.10 && < 1.2,
time >= 1.1 && < 1.5,

21
patching/patches/hint-0.4.2.0.patch
View File

@ -1,21 +0,0 @@
diff -ru orig/unit-tests/run-unit-tests.hs new/unit-tests/run-unit-tests.hs
--- orig/unit-tests/run-unit-tests.hs 2014-05-11 18:47:29.102698531 +0300
+++ new/unit-tests/run-unit-tests.hs 2014-05-11 18:47:28.000000000 +0300
@@ -191,7 +191,7 @@
test_catch :: TestCase
test_catch = TestCase "catch" [] $ do
setImports ["Prelude"]
- succeeds (action `catch` handler) @@? "catch failed"
+ succeeds (action `MC.catch` handler) @@? "catch failed"
where handler DivideByZero = return "catched"
handler e = throwM e
action = do s <- eval "1 `div` 0 :: Int"
@@ -203,7 +203,7 @@
liftIO $ do
r <- newEmptyMVar
let concurrent = runInterpreter (liftIO $ putMVar r False)
- `catch` \MultipleInstancesNotAllowed ->
+ `MC.catch` \MultipleInstancesNotAllowed ->
do liftIO $ putMVar r True
return $ Right ()
_ <- forkIO $ concurrent >> return ()

58
patching/patches/hoogle-4.2.32.patch
View File

@ -1,58 +0,0 @@
diff -ru orig/src/General/Web.hs new/src/General/Web.hs
--- orig/src/General/Web.hs 2014-06-09 15:25:38.583521732 +0300
+++ new/src/General/Web.hs 2014-06-09 15:25:38.000000000 +0300
@@ -21,6 +21,9 @@
import General.Base
import System.FilePath
import Network.Wai
+#if MIN_VERSION_wai(3, 0, 0)
+import Data.IORef
+#endif
#if MIN_VERSION_wai(2, 0, 0)
import Network.Wai.Internal
#endif
@@ -46,7 +49,15 @@
responseFlatten :: Response -> IO (Status, ResponseHeaders, LBString)
responseFlatten r = do
-#if MIN_VERSION_wai(2, 0, 0)
+#if MIN_VERSION_wai(3, 0, 0)
+ let (s,hs,withBody) = responseToStream r
+ ref <- newIORef mempty
+ let addChunk builder = modifyIORef ref (<> builder)
+ withBody $ \body -> body addChunk (return ())
+ builder <- readIORef ref
+ let res = toLazyByteString builder
+ return (s,hs,res)
+#elif MIN_VERSION_wai(2, 0, 0)
let (s,hs,withSrc) = responseToSource r
chunks <- withSrc $ \src -> src $$ consume
let res = toLazyByteString $ mconcat [x | Chunk x <- chunks]
diff -ru orig/src/Web/Server.hs new/src/Web/Server.hs
--- orig/src/Web/Server.hs 2014-06-09 15:25:38.575521732 +0300
+++ new/src/Web/Server.hs 2014-06-09 15:25:38.000000000 +0300
@@ -32,14 +32,23 @@
resp <- respArgs q
v <- newMVar ()
putStrLn $ "Starting Hoogle Server on port " ++ show port
- runSettings defaultSettings{settingsOnException=exception, settingsPort=port} $ \r -> liftIO $ do
+ runSettings defaultSettings{settingsOnException=exception, settingsPort=port}
+#if MIN_VERSION_wai(3, 0, 0)
+ $ \r sendResponse -> do
+#else
+ $ \r -> liftIO $ do
+#endif
start <- getCurrentTime
res <- talk resp q r
responseEvaluate res
stop <- getCurrentTime
let t = floor $ diffUTCTime stop start * 1000
withMVar v $ const $ putStrLn $ bsUnpack (rawPathInfo r) ++ bsUnpack (rawQueryString r) ++ " ms:" ++ show t
+#if MIN_VERSION_wai(3, 0, 0)
+ sendResponse res
+#else
return res
+#endif
#if MIN_VERSION_wai(2, 0, 0)

23
patching/patches/hweblib-0.6.1.patch
View File

@ -1,23 +0,0 @@
diff -ru orig/src/Network/Parser/Mime.hs new/src/Network/Parser/Mime.hs
--- orig/src/Network/Parser/Mime.hs 2014-03-19 12:03:48.222054709 +0200
+++ new/src/Network/Parser/Mime.hs 2014-03-19 12:03:47.000000000 +0200
@@ -43,7 +43,7 @@
_ -> MultiPart (Extension s)
(t, s) -> Other t s
where
- paired s = let (a,b) = (T.break (== '/') . T.toLower . TE.decodeLatin1) s in
+ paired s = let (a,b) = (T.break (== '/') . T.toLower . TE.decodeUtf8) s in
(a, T.drop 1 b)
-- Parse headers and map them to a MimeValue
@@ -53,8 +53,8 @@
let mv = L.foldl f nullMimeValue eh
return mv
where
- bs2t = M.fromList . Prelude.map (TE.decodeLatin1 *** TE.decodeLatin1) . M.toList
- hVal = TE.decodeLatin1 . hValue
+ bs2t = M.fromList . Prelude.map (TE.decodeUtf8 *** TE.decodeUtf8) . M.toList
+ hVal = TE.decodeUtf8 . hValue
f z x =
case hType x of
IdH -> z { mvHeaders = M.insert IdH (hVal x) (mvHeaders z) }

20
patching/patches/incremental-parser-0.2.3.2.patch
View File

@ -1,20 +0,0 @@
diff -ru orig/incremental-parser.cabal new/incremental-parser.cabal
--- orig/incremental-parser.cabal 2014-06-15 10:20:01.864931460 +0300
+++ new/incremental-parser.cabal 2014-06-15 10:20:01.000000000 +0300
@@ -29,15 +29,3 @@
GHC-prof-options: -auto-all
if impl(ghc >= 7.0.0)
default-language: Haskell2010
-
-test-suite Main
- Type: exitcode-stdio-1.0
- x-uses-tf: true
- Build-Depends: base < 5, monoid-subclasses < 0.4,
- QuickCheck >= 2 && < 3, checkers >= 0.2 && < 0.4,
- test-framework >= 0.4.1, test-framework-quickcheck2
- Main-is: Test/TestIncrementalParser.hs
- Other-Modules: Text.ParserCombinators.Incremental,
- Text.ParserCombinators.Incremental.LeftBiasedLocal, Text.ParserCombinators.Incremental.Symmetric,
- Control.Applicative.Monoid
- default-language: Haskell2010
Only in orig: Test

12
patching/patches/network-transport-tests-0.1.0.1.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/network-transport-tests.cabal new/network-transport-tests.cabal
--- orig/network-transport-tests.cabal 2014-03-25 06:24:53.648644213 +0200
+++ new/network-transport-tests.cabal 2014-03-25 06:24:53.000000000 +0200
@@ -24,7 +24,7 @@
bytestring >= 0.9 && < 0.11,
random >= 1.0 && < 1.1,
mtl >= 2.1 && < 2.2,
- ansi-terminal >= 0.5 && < 0.6
+ ansi-terminal >= 0.5
hs-source-dirs: src
ghc-options: -Wall -fno-warn-unused-do-bind
extensions: CPP,

62
patching/patches/primitive-0.5.3.0.patch
View File

@ -1,62 +0,0 @@
diff -ruN orig/Control/Monad/Primitive.hs new/Control/Monad/Primitive.hs
--- orig/Control/Monad/Primitive.hs 2014-08-01 14:49:04.175318972 +0300
+++ new/Control/Monad/Primitive.hs 2014-08-01 14:49:03.000000000 +0300
@@ -44,7 +44,9 @@
primitive_ :: PrimMonad m
=> (State# (PrimState m) -> State# (PrimState m)) -> m ()
{-# INLINE primitive_ #-}
-primitive_ f = primitive (\s# -> (# f s#, () #))
+primitive_ f = primitive (\s# ->
+ case f s# of
+ s'# -> (# s'#, () #))
instance PrimMonad IO where
type PrimState IO = RealWorld
diff -ruN orig/primitive.cabal new/primitive.cabal
--- orig/primitive.cabal 2014-08-01 14:49:04.175318972 +0300
+++ new/primitive.cabal 2014-08-01 14:49:03.000000000 +0300
@@ -50,6 +50,16 @@
if arch(i386) || arch(x86_64)
cc-options: -msse2
+test-suite test
+ Default-Language: Haskell2010
+ hs-source-dirs: test
+ main-is: main.hs
+ type: exitcode-stdio-1.0
+ build-depends: base
+ , ghc-prim
+ , primitive
+ ghc-options: -O2
+
source-repository head
type: git
location: https://github.com/haskell/primitive
diff -ruN orig/test/main.hs new/test/main.hs
--- orig/test/main.hs 1970-01-01 02:00:00.000000000 +0200
+++ new/test/main.hs 2014-08-01 14:49:03.000000000 +0300
@@ -0,0 +1,24 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+import Control.Monad.Primitive
+import Data.Primitive.Array
+import GHC.IO
+import GHC.Prim
+
+-- Since we only have a single test case right now, I'm going to avoid the
+-- issue of choosing a test framework for the moment. This also keeps the
+-- package as a whole light on dependencies.
+
+main :: IO ()
+main = do
+ arr <- newArray 1 'A'
+ let unit =
+ case writeArray arr 0 'B' of
+ IO f ->
+ case f realWorld# of
+ _ -> ()
+ c1 <- readArray arr 0
+ return $! unit
+ c2 <- readArray arr 0
+ if c1 == 'A' && c2 == 'B'
+ then return ()
+ else error $ "Expected AB, got: " ++ show (c1, c2)

12
patching/patches/process-conduit-1.0.0.1.patch
View File

@ -1,12 +0,0 @@
Only in new: dist
diff -ru orig/process-conduit.cabal new/process-conduit.cabal
--- orig/process-conduit.cabal 2014-03-30 12:27:40.781431440 +0300
+++ new/process-conduit.cabal 2014-03-30 12:27:40.000000000 +0300
@@ -35,6 +35,7 @@
, process >= 1.0
, conduit == 1.0.*
, shakespeare-text >= 1.0
+ , shakespeare
ghc-options: -Wall

62
patching/patches/process-conduit-1.0.0.2.patch
View File

@ -1,62 +0,0 @@
diff -ru orig/Data/Conduit/Process.hs new/Data/Conduit/Process.hs
--- orig/Data/Conduit/Process.hs 2014-04-03 08:26:07.254383579 +0300
+++ new/Data/Conduit/Process.hs 2014-04-03 08:26:06.000000000 +0300
@@ -21,6 +21,7 @@
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Loop
+import Control.Monad.Trans.Resource (MonadResource, monadThrow)
import qualified Data.ByteString as S
import Data.Conduit
import qualified Data.Conduit.List as CL
diff -ru orig/process-conduit.cabal new/process-conduit.cabal
--- orig/process-conduit.cabal 2014-04-03 08:26:07.258383579 +0300
+++ new/process-conduit.cabal 2014-04-03 08:26:06.000000000 +0300
@@ -33,7 +33,8 @@
, bytestring >= 0.9
, text >= 0.11
, process >= 1.0
- , conduit == 1.0.*
+ , conduit >= 1.0 && < 1.2
+ , resourcet >= 0.4 && < 1.2
, shakespeare-text >= 1.0
, shakespeare
@@ -47,4 +48,6 @@
, bytestring
, hspec >= 1.3
, conduit
+ , conduit-extra
+ , resourcet
, process-conduit
diff -ru orig/System/Process/QQ.hs new/System/Process/QQ.hs
--- orig/System/Process/QQ.hs 2014-04-03 08:26:07.254383579 +0300
+++ new/System/Process/QQ.hs 2014-04-03 08:26:06.000000000 +0300
@@ -14,6 +14,7 @@
import qualified Data.Text.Lazy as LT
import Language.Haskell.TH.Quote
import Text.Shakespeare.Text
+import Control.Monad.Trans.Resource (runResourceT)
import Data.Conduit.Process
@@ -28,7 +29,7 @@
-- | Command result of (Lazy) ByteString.
cmd :: QuasiQuoter
cmd = def { quoteExp = \str -> [|
- BL.fromChunks <$> C.runResourceT (sourceCmd (LT.unpack $(quoteExp lt str)) C.$$ CL.consume)
+ BL.fromChunks <$> runResourceT (sourceCmd (LT.unpack $(quoteExp lt str)) C.$$ CL.consume)
|] }
-- | Source of shell command
diff -ru orig/test.hs new/test.hs
--- orig/test.hs 2014-04-03 08:26:07.254383579 +0300
+++ new/test.hs 2014-04-03 08:26:06.000000000 +0300
@@ -7,6 +7,7 @@
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import Test.Hspec
+import Control.Monad.Trans.Resource (runResourceT)
main :: IO ()
main = hspec $ do

21
patching/patches/process-conduit-1.1.0.0.patch
View File

@ -1,21 +0,0 @@
diff -ru orig/process-conduit.cabal new/process-conduit.cabal
--- orig/process-conduit.cabal 2014-04-04 10:13:39.716407142 +0300
+++ new/process-conduit.cabal 2014-04-04 10:13:39.000000000 +0300
@@ -48,4 +48,6 @@
, bytestring
, hspec >= 1.3
, conduit
+ , conduit-extra
+ , resourcet
, process-conduit
diff -ru orig/test.hs new/test.hs
--- orig/test.hs 2014-04-04 10:13:39.692407142 +0300
+++ new/test.hs 2014-04-04 10:13:39.000000000 +0300
@@ -5,6 +5,7 @@
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Conduit
+import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.Conduit.Binary as CB
import Test.Hspec

12
patching/patches/retry-0.4.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/retry.cabal new/retry.cabal
--- orig/retry.cabal 2014-05-11 11:28:24.319992770 +0300
+++ new/retry.cabal 2014-05-11 11:28:24.000000000 +0300
@@ -30,7 +30,7 @@
exposed-modules: Control.Retry
build-depends:
base ==4.*,
- exceptions >= 0.5 && < 0.6,
+ exceptions >= 0.5 && < 0.7,
transformers,
data-default
hs-source-dirs: src

19
patching/patches/retry-0.5.patch
View File

@ -1,19 +0,0 @@
diff -ruN orig/retry.cabal new/retry.cabal
--- orig/retry.cabal 2014-08-05 09:28:48.350961123 +0300
+++ new/retry.cabal 2014-08-05 09:28:48.000000000 +0300
@@ -44,13 +44,13 @@
ghc-options: -threaded
build-depends:
base ==4.*
- , exceptions >= 0.5 && < 0.6
+ , exceptions >= 0.5
, transformers
, data-default-class
, time
, QuickCheck >= 2.7 && < 2.8
, HUnit >= 1.2.5.2 && < 1.3
- , hspec >= 1.9 && < 1.10
+ , hspec >= 1.9
default-language: Haskell2010

14
patching/patches/scientific-0.2.0.1.patch
View File

@ -1,14 +0,0 @@
diff -ru orig/scientific.cabal new/scientific.cabal
--- orig/scientific.cabal 2014-03-06 14:57:06.880706336 +0200
+++ new/scientific.cabal 2014-03-06 14:57:06.000000000 +0200
@@ -47,8 +47,8 @@
build-depends: scientific
, base >= 4.3 && < 4.8
- , tasty >= 0.3.1 && < 0.8
- , tasty-smallcheck >= 0.2 && < 0.3
+ , tasty >= 0.3.1 && < 0.9
+ , tasty-smallcheck >= 0.2 && < 0.9
, smallcheck >= 1.0 && < 1.2
, text >= 0.8 && < 1.2

12
patching/patches/snap-0.13.2.2.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/snap.cabal new/snap.cabal
--- orig/snap.cabal 2014-03-19 10:17:25.886213731 +0200
+++ new/snap.cabal 2014-03-19 10:17:25.000000000 +0200
@@ -154,7 +154,7 @@
containers >= 0.3 && < 0.6,
directory >= 1.0 && < 1.3,
directory-tree >= 0.11 && < 0.12,
- dlist >= 0.5 && < 0.7,
+ dlist >= 0.5 && < 0.8,
errors >= 1.4 && < 1.5,
filepath >= 1.1 && < 1.4,
-- Blacklist bad versions of hashable

12
patching/patches/sqlite-simple-0.4.5.1.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/Database/SQLite/Simple.hs new/Database/SQLite/Simple.hs
--- orig/Database/SQLite/Simple.hs 2014-02-14 14:38:24.411759783 +0200
+++ new/Database/SQLite/Simple.hs 2014-02-14 14:38:24.000000000 +0200
@@ -343,7 +343,7 @@
| otherwise -> errorColumnMismatch (ColumnOutOfBounds col)
Errors [] -> throwIO $ ConversionFailed "" "" "unknown error"
Errors [x] ->
- throw x `catch` (\e -> errorColumnMismatch (e :: ColumnOutOfBounds))
+ throw x `Control.Exception.catch` (\e -> errorColumnMismatch (e :: ColumnOutOfBounds))
Errors xs -> throwIO $ ManyErrors xs
where
errorColumnMismatch :: ColumnOutOfBounds -> IO r

705
patching/patches/statistics-0.10.5.2.patch
View File

@ -1,705 +0,0 @@
diff -ru orig/Statistics/Distribution/Beta.hs new/Statistics/Distribution/Beta.hs
--- orig/Statistics/Distribution/Beta.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Beta.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Statistics.Distribution.Beta
@@ -27,6 +27,10 @@
incompleteBeta, invIncompleteBeta, logBeta, digamma)
import Numeric.MathFunctions.Constants (m_NaN)
import qualified Statistics.Distribution as D
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<$>), (<*>))
+#endif
-- | The beta distribution
data BetaDistribution = BD
@@ -36,7 +40,11 @@
-- ^ Beta shape parameter
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary BetaDistribution
+instance Binary BetaDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put (BD x y) = put x >> put y
+ get = BD <$> get <*> get
+#endif
-- | Create beta distribution. Both shape parameters must be positive.
betaDistr :: Double -- ^ Shape parameter alpha
diff -ru orig/Statistics/Distribution/Binomial.hs new/Statistics/Distribution/Binomial.hs
--- orig/Statistics/Distribution/Binomial.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Binomial.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.Binomial
-- Copyright : (c) 2009 Bryan O'Sullivan
@@ -30,6 +30,10 @@
import qualified Statistics.Distribution.Poisson.Internal as I
import Numeric.SpecFunctions (choose,incompleteBeta)
import Numeric.MathFunctions.Constants (m_epsilon)
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<$>), (<*>))
+#endif
-- | The binomial distribution.
@@ -40,7 +44,11 @@
-- ^ Probability.
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary BinomialDistribution
+instance Binary BinomialDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put (BD x y) = put x >> put y
+ get = BD <$> get <*> get
+#endif
instance D.Distribution BinomialDistribution where
cumulative = cumulative
diff -ru orig/Statistics/Distribution/CauchyLorentz.hs new/Statistics/Distribution/CauchyLorentz.hs
--- orig/Statistics/Distribution/CauchyLorentz.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/CauchyLorentz.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.CauchyLorentz
-- Copyright : (c) 2011 Aleksey Khudyakov
@@ -25,6 +25,10 @@
import Data.Data (Data, Typeable)
import GHC.Generics (Generic)
import qualified Statistics.Distribution as D
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<$>), (<*>))
+#endif
-- | Cauchy-Lorentz distribution.
data CauchyDistribution = CD {
@@ -39,7 +43,11 @@
}
deriving (Eq, Show, Read, Typeable, Data, Generic)
-instance Binary CauchyDistribution
+instance Binary CauchyDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put (CD x y) = put x >> put y
+ get = CD <$> get <*> get
+#endif
-- | Cauchy distribution
cauchyDistribution :: Double -- ^ Central point
diff -ru orig/Statistics/Distribution/ChiSquared.hs new/Statistics/Distribution/ChiSquared.hs
--- orig/Statistics/Distribution/ChiSquared.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/ChiSquared.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.ChiSquared
-- Copyright : (c) 2010 Alexey Khudyakov
@@ -26,13 +26,20 @@
import qualified Statistics.Distribution as D
import qualified System.Random.MWC.Distributions as MWC
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+#endif
-- | Chi-squared distribution
newtype ChiSquared = ChiSquared Int
deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary ChiSquared
+instance Binary ChiSquared where
+#if !MIN_VERSION_binary(0, 6, 0)
+ get = fmap ChiSquared get
+ put (ChiSquared x) = put x
+#endif
-- | Get number of degrees of freedom
chiSquaredNDF :: ChiSquared -> Int
diff -ru orig/Statistics/Distribution/Exponential.hs new/Statistics/Distribution/Exponential.hs
--- orig/Statistics/Distribution/Exponential.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Exponential.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.Exponential
-- Copyright : (c) 2009 Bryan O'Sullivan
@@ -31,13 +31,20 @@
import qualified Statistics.Sample as S
import qualified System.Random.MWC.Distributions as MWC
import Statistics.Types (Sample)
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+#endif
newtype ExponentialDistribution = ED {
edLambda :: Double
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary ExponentialDistribution
+instance Binary ExponentialDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put = put . edLambda
+ get = fmap ED get
+#endif
instance D.Distribution ExponentialDistribution where
cumulative = cumulative
diff -ru orig/Statistics/Distribution/FDistribution.hs new/Statistics/Distribution/FDistribution.hs
--- orig/Statistics/Distribution/FDistribution.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/FDistribution.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.FDistribution
-- Copyright : (c) 2011 Aleksey Khudyakov
@@ -23,6 +23,10 @@
import qualified Statistics.Distribution as D
import Numeric.SpecFunctions (
logBeta, incompleteBeta, invIncompleteBeta, digamma)
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<$>), (<*>))
+#endif
@@ -33,7 +37,11 @@
}
deriving (Eq, Show, Read, Typeable, Data, Generic)
-instance Binary FDistribution
+instance Binary FDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ get = F <$> get <*> get <*> get
+ put (F x y z) = put x >> put y >> put z
+#endif
fDistribution :: Int -> Int -> FDistribution
fDistribution n m
diff -ru orig/Statistics/Distribution/Gamma.hs new/Statistics/Distribution/Gamma.hs
--- orig/Statistics/Distribution/Gamma.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Gamma.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.Gamma
-- Copyright : (c) 2009, 2011 Bryan O'Sullivan
@@ -34,6 +34,10 @@
import Statistics.Distribution.Poisson.Internal as Poisson
import qualified Statistics.Distribution as D
import qualified System.Random.MWC.Distributions as MWC
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<$>), (<*>))
+#endif
-- | The gamma distribution.
data GammaDistribution = GD {
@@ -41,7 +45,11 @@
, gdScale :: {-# UNPACK #-} !Double -- ^ Scale parameter, &#977;.
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary GammaDistribution
+instance Binary GammaDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put (GD x y) = put x >> put y
+ get = GD <$> get <*> get
+#endif
-- | Create gamma distribution. Both shape and scale parameters must
-- be positive.
diff -ru orig/Statistics/Distribution/Geometric.hs new/Statistics/Distribution/Geometric.hs
--- orig/Statistics/Distribution/Geometric.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Geometric.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.Geometric
-- Copyright : (c) 2009 Bryan O'Sullivan
@@ -37,6 +37,10 @@
import Numeric.MathFunctions.Constants(m_pos_inf,m_neg_inf)
import qualified Statistics.Distribution as D
import qualified System.Random.MWC.Distributions as MWC
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<$>))
+#endif
----------------------------------------------------------------
-- Distribution over [1..]
@@ -45,7 +49,11 @@
gdSuccess :: Double
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary GeometricDistribution
+instance Binary GeometricDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ get = GD <$> get
+ put (GD x) = put x
+#endif
instance D.Distribution GeometricDistribution where
cumulative = cumulative
@@ -115,7 +123,11 @@
gdSuccess0 :: Double
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary GeometricDistribution0
+instance Binary GeometricDistribution0 where
+#if !MIN_VERSION_binary(0, 6, 0)
+ get = GD0 <$> get
+ put (GD0 x) = put x
+#endif
instance D.Distribution GeometricDistribution0 where
cumulative (GD0 s) x = cumulative (GD s) (x + 1)
diff -ru orig/Statistics/Distribution/Hypergeometric.hs new/Statistics/Distribution/Hypergeometric.hs
--- orig/Statistics/Distribution/Hypergeometric.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Hypergeometric.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.Hypergeometric
-- Copyright : (c) 2009 Bryan O'Sullivan
@@ -33,6 +33,10 @@
import Numeric.MathFunctions.Constants (m_epsilon)
import Numeric.SpecFunctions (choose)
import qualified Statistics.Distribution as D
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<$>), (<*>))
+#endif
data HypergeometricDistribution = HD {
hdM :: {-# UNPACK #-} !Int
@@ -40,7 +44,11 @@
, hdK :: {-# UNPACK #-} !Int
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary HypergeometricDistribution
+instance Binary HypergeometricDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ get = HD <$> get <*> get <*> get
+ put (HD x y z) = put x >> put y >> put z
+#endif
instance D.Distribution HypergeometricDistribution where
cumulative = cumulative
diff -ru orig/Statistics/Distribution/Normal.hs new/Statistics/Distribution/Normal.hs
--- orig/Statistics/Distribution/Normal.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Normal.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.Normal
-- Copyright : (c) 2009 Bryan O'Sullivan
@@ -28,6 +28,8 @@
import qualified Statistics.Distribution as D
import qualified Statistics.Sample as S
import qualified System.Random.MWC.Distributions as MWC
+import Data.Binary (put, get)
+import Control.Applicative ((<$>), (<*>))
@@ -39,7 +41,9 @@
, ndCdfDenom :: {-# UNPACK #-} !Double
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary NormalDistribution
+instance Binary NormalDistribution where
+ put (ND w x y z) = put w >> put x >> put y >> put z
+ get = ND <$> get <*> get <*> get <*> get
instance D.Distribution NormalDistribution where
cumulative = cumulative
diff -ru orig/Statistics/Distribution/Poisson/Internal.hs new/Statistics/Distribution/Poisson/Internal.hs
--- orig/Statistics/Distribution/Poisson/Internal.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Poisson/Internal.hs 2014-04-14 09:04:31.000000000 +0300
@@ -36,8 +36,8 @@
-- | Compute entropy using Theorem 1 from "Sharp Bounds on the Entropy
-- of the Poisson Law". This function is unused because 'directEntorpy'
-- is just as accurate and is faster by about a factor of 4.
-alyThm1 :: Double -> Double
-alyThm1 lambda =
+_alyThm1 :: Double -> Double
+_alyThm1 lambda =
sum (takeWhile (\x -> abs x >= m_epsilon * lll) alySeries) + lll
where lll = lambda * (1 - log lambda)
alySeries =
@@ -175,4 +175,4 @@
| lambda <= 18 = alyThm2 lambda upperCoefficients6 lowerCoefficients6
| lambda <= 24 = alyThm2 lambda upperCoefficients8 lowerCoefficients8
| lambda <= 30 = alyThm2 lambda upperCoefficients10 lowerCoefficients10
- | otherwise = alyThm2 lambda upperCoefficients12 lowerCoefficients12
\ No newline at end of file
+ | otherwise = alyThm2 lambda upperCoefficients12 lowerCoefficients12
diff -ru orig/Statistics/Distribution/Poisson.hs new/Statistics/Distribution/Poisson.hs
--- orig/Statistics/Distribution/Poisson.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Poisson.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.Poisson
-- Copyright : (c) 2009, 2011 Bryan O'Sullivan
@@ -31,13 +31,20 @@
import qualified Statistics.Distribution.Poisson.Internal as I
import Numeric.SpecFunctions (incompleteGamma,logFactorial)
import Numeric.MathFunctions.Constants (m_neg_inf)
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+#endif
newtype PoissonDistribution = PD {
poissonLambda :: Double
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary PoissonDistribution
+instance Binary PoissonDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ get = fmap PD get
+ put = put . poissonLambda
+#endif
instance D.Distribution PoissonDistribution where
cumulative (PD lambda) x
@@ -78,8 +85,9 @@
poisson :: Double -> PoissonDistribution
poisson l
| l >= 0 = PD l
- | otherwise = error $ "Statistics.Distribution.Poisson.poisson:\
- \ lambda must be non-negative. Got " ++ show l
+ | otherwise = error $
+ "Statistics.Distribution.Poisson.poisson: lambda must be non-negative. Got "
+ ++ show l
{-# INLINE poisson #-}
-- $references
diff -ru orig/Statistics/Distribution/StudentT.hs new/Statistics/Distribution/StudentT.hs
--- orig/Statistics/Distribution/StudentT.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/StudentT.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.StudentT
-- Copyright : (c) 2011 Aleksey Khudyakov
@@ -23,12 +23,19 @@
import Statistics.Distribution.Transform (LinearTransform (..))
import Numeric.SpecFunctions (
logBeta, incompleteBeta, invIncompleteBeta, digamma)
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+#endif
-- | Student-T distribution
newtype StudentT = StudentT { studentTndf :: Double }
deriving (Eq, Show, Read, Typeable, Data, Generic)
-instance Binary StudentT
+instance Binary StudentT where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put = put . studentTndf
+ get = fmap StudentT get
+#endif
-- | Create Student-T distribution. Number of parameters must be positive.
studentT :: Double -> StudentT
diff -ru orig/Statistics/Distribution/Transform.hs new/Statistics/Distribution/Transform.hs
--- orig/Statistics/Distribution/Transform.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Transform.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,5 +1,5 @@
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts,
- FlexibleInstances, UndecidableInstances #-}
+ FlexibleInstances, UndecidableInstances, CPP #-}
-- |
-- Module : Statistics.Distribution.Transform
-- Copyright : (c) 2013 John McDonnell;
@@ -21,6 +21,10 @@
import GHC.Generics (Generic)
import Data.Functor ((<$>))
import qualified Statistics.Distribution as D
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<*>))
+#endif
-- | Linear transformation applied to distribution.
--
@@ -35,7 +39,11 @@
-- ^ Distribution being transformed.
} deriving (Eq, Show, Read, Typeable, Data, Generic)
-instance (Binary d) => Binary (LinearTransform d)
+instance (Binary d) => Binary (LinearTransform d) where
+#if !MIN_VERSION_binary(0, 6, 0)
+ get = LinearTransform <$> get <*> get <*> get
+ put (LinearTransform x y z) = put x >> put y >> put z
+#endif
-- | Apply linear transformation to distribution.
scaleAround :: Double -- ^ Fixed point
diff -ru orig/Statistics/Distribution/Uniform.hs new/Statistics/Distribution/Uniform.hs
--- orig/Statistics/Distribution/Uniform.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Distribution/Uniform.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Distribution.Uniform
-- Copyright : (c) 2011 Aleksey Khudyakov
@@ -24,6 +24,10 @@
import GHC.Generics (Generic)
import qualified Statistics.Distribution as D
import qualified System.Random.MWC as MWC
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<$>), (<*>))
+#endif
-- | Uniform distribution from A to B
@@ -32,7 +36,11 @@
, uniformB :: {-# UNPACK #-} !Double -- ^ Upper boundary of distribution
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary UniformDistribution
+instance Binary UniformDistribution where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put (UniformDistribution x y) = put x >> put y
+ get = UniformDistribution <$> get <*> get
+#endif
-- | Create uniform distribution.
uniformDistr :: Double -> Double -> UniformDistribution
diff -ru orig/Statistics/Math/RootFinding.hs new/Statistics/Math/RootFinding.hs
--- orig/Statistics/Math/RootFinding.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Math/RootFinding.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Math.RootFinding
@@ -27,6 +27,11 @@
import Control.Monad (MonadPlus(..), ap)
import Data.Data (Data, Typeable)
import GHC.Generics (Generic)
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Data.Binary.Put (putWord8)
+import Data.Binary.Get (getWord8)
+#endif
-- | The result of searching for a root of a mathematical function.
@@ -40,7 +45,20 @@
-- ^ A root was successfully found.
deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance (Binary a) => Binary (Root a)
+instance (Binary a) => Binary (Root a) where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put NotBracketed = putWord8 0
+ put SearchFailed = putWord8 1
+ put (Root a) = putWord8 2 >> put a
+
+ get = do
+ i <- getWord8
+ case i of
+ 0 -> return NotBracketed
+ 1 -> return SearchFailed
+ 2 -> fmap Root get
+ _ -> fail $ "Root.get: Invalid value: " ++ show i
+#endif
instance Functor Root where
fmap _ NotBracketed = NotBracketed
diff -ru orig/Statistics/Resampling/Bootstrap.hs new/Statistics/Resampling/Bootstrap.hs
--- orig/Statistics/Resampling/Bootstrap.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Resampling/Bootstrap.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,5 +1,5 @@
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings,
- RecordWildCards #-}
+ RecordWildCards, CPP #-}
-- |
-- Module : Statistics.Resampling.Bootstrap
@@ -35,6 +35,10 @@
import Statistics.Sample (mean)
import Statistics.Types (Estimator, Sample)
import qualified Data.Vector.Unboxed as U
+#if !MIN_VERSION_binary(0, 6, 0)
+import Data.Binary (put, get)
+import Control.Applicative ((<$>), (<*>))
+#endif
-- | A point and interval estimate computed via an 'Estimator'.
data Estimate = Estimate {
@@ -50,7 +54,11 @@
-- ^ Confidence level of the confidence intervals.
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary Estimate
+instance Binary Estimate where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put (Estimate w x y z) = put w >> put x >> put y >> put z
+ get = Estimate <$> get <*> get <*> get <*> get
+#endif
instance NFData Estimate
-- | Multiply the point, lower bound, and upper bound in an 'Estimate'
diff -ru orig/Statistics/Resampling.hs new/Statistics/Resampling.hs
--- orig/Statistics/Resampling.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Resampling.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, CPP #-}
-- |
-- Module : Statistics.Resampling
@@ -42,7 +42,11 @@
fromResample :: U.Vector Double
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary Resample
+instance Binary Resample where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put = put . fromResample
+ get = fmap Resample get
+#endif
-- | /O(e*r*s)/ Resample a data set repeatedly, with replacement,
-- computing each estimate over the resampled data.
diff -ru orig/Statistics/Sample/KernelDensity/Simple.hs new/Statistics/Sample/KernelDensity/Simple.hs
--- orig/Statistics/Sample/KernelDensity/Simple.hs 2014-04-14 09:04:31.425509375 +0300
+++ new/Statistics/Sample/KernelDensity/Simple.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts, CPP #-}
-- |
-- Module : Statistics.Sample.KernelDensity.Simple
-- Copyright : (c) 2009 Bryan O'Sullivan
@@ -61,7 +61,11 @@
fromPoints :: U.Vector Double
} deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary Points
+instance Binary Points where
+#if !MIN_VERSION_binary(0, 6, 0)
+ get = fmap Points get
+ put = put . fromPoints
+#endif
-- | Bandwidth estimator for an Epanechnikov kernel.
epanechnikovBW :: Double -> Bandwidth
diff -ru orig/Statistics/Sample/Powers.hs new/Statistics/Sample/Powers.hs
--- orig/Statistics/Sample/Powers.hs 2014-04-14 09:04:31.421509375 +0300
+++ new/Statistics/Sample/Powers.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,5 +1,5 @@
{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric,
- FlexibleContexts #-}
+ FlexibleContexts, CPP #-}
-- |
-- Module : Statistics.Sample.Powers
-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
@@ -65,7 +65,11 @@
newtype Powers = Powers (U.Vector Double)
deriving (Eq, Read, Show, Typeable, Data, Generic)
-instance Binary Powers
+instance Binary Powers where
+#if !MIN_VERSION_binary(0, 6, 0)
+ put (Powers v) = put v
+ get = fmap Powers get
+#endif
-- | O(/n/) Collect the /n/ simple powers of a sample.
--
diff -ru orig/statistics.cabal new/statistics.cabal
--- orig/statistics.cabal 2014-04-14 09:04:31.429509375 +0300
+++ new/statistics.cabal 2014-04-14 09:04:31.000000000 +0300
@@ -90,7 +90,7 @@
Statistics.Test.Internal
build-depends:
base < 5,
- binary >= 0.6.3.0,
+ binary >= 0.5.1.0,
deepseq >= 1.1.0.2,
erf,
monad-par >= 0.3.4,
diff -ru orig/tests/Tests/Distribution.hs new/tests/Tests/Distribution.hs
--- orig/tests/Tests/Distribution.hs 2014-04-14 09:04:31.425509375 +0300
+++ new/tests/Tests/Distribution.hs 2014-04-14 09:04:31.000000000 +0300
@@ -188,7 +188,7 @@
-- Quantile is inverse of CDF
quantileIsInvCDF :: (Param d, ContDistr d) => T d -> d -> Double -> Property
-quantileIsInvCDF _ d (snd . properFraction -> p) =
+quantileIsInvCDF _ d ((snd :: (Int, y) -> y) . properFraction -> p) =
p > 0 && p < 1 ==> ( printTestCase (printf "Quantile = %g" q )
$ printTestCase (printf "Probability = %g" p )
$ printTestCase (printf "Probability' = %g" p')
@@ -203,8 +203,8 @@
quantileShouldFail :: (ContDistr d) => T d -> d -> Double -> Property
quantileShouldFail _ d p =
p < 0 || p > 1 ==> QC.monadicIO $ do r <- QC.run $ catch
- (do { return $! quantile d p; return False })
- (\(e :: SomeException) -> return True)
+ (do { _ <- return $! quantile d p; return False })
+ (\(_e :: SomeException) -> return True)
QC.assert r
diff -ru orig/tests/Tests/Function.hs new/tests/Tests/Function.hs
--- orig/tests/Tests/Function.hs 2014-04-14 09:04:31.425509375 +0300
+++ new/tests/Tests/Function.hs 2014-04-14 09:04:31.000000000 +0300
@@ -1,7 +1,6 @@
module Tests.Function ( tests ) where
import qualified Data.Vector.Unboxed as U
-import Data.Vector.Unboxed ((!))
import Test.QuickCheck
import Test.Framework
@@ -29,5 +28,5 @@
p_nextHighestPowerOfTwo
= all (\(good, is) -> all ((==good) . nextHighestPowerOfTwo) is) lists
where
- pows = [1 .. 17]
+ pows = [1 .. 17 :: Int]
lists = [ (2^m, [2^n+1 .. 2^m]) | (n,m) <- pows `zip` tail pows ]
diff -ru orig/tests/Tests/Transform.hs new/tests/Tests/Transform.hs
--- orig/tests/Tests/Transform.hs 2014-04-14 09:04:31.425509375 +0300
+++ new/tests/Tests/Transform.hs 2014-04-14 09:04:31.000000000 +0300
@@ -15,7 +15,7 @@
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck (Positive(..),Property,Arbitrary(..),Gen,choose,vectorOf,
- printTestCase, quickCheck)
+ printTestCase)
import Text.Printf

16
patching/patches/stm-conduit-2.3.0.patch
View File

@ -1,16 +0,0 @@
diff -ru orig/stm-conduit.cabal new/stm-conduit.cabal
--- orig/stm-conduit.cabal 2014-04-03 08:22:14.310388538 +0300
+++ new/stm-conduit.cabal 2014-04-03 08:22:14.000000000 +0300
@@ -29,9 +29,10 @@
, stm-chans >= 2.0 && < 3.1
, cereal >= 0.4.0.1
, cereal-conduit >= 0.7.2
- , conduit == 1.0.*
+ , conduit >= 1.0 && < 1.2
+ , conduit-extra >= 1.0 && < 1.2
, directory >= 1.1
- , resourcet >= 0.3 && < 0.5
+ , resourcet >= 0.3 && < 1.2
, async >= 2.0.1
, monad-control >= 0.3.2
, monad-loops >= 0.4.2

201
patching/patches/stm-conduit-2.5.1.patch
View File

@ -1,201 +0,0 @@
diff -ruN orig/Data/Conduit/TMChan.hs new/Data/Conduit/TMChan.hs
--- orig/Data/Conduit/TMChan.hs 2014-08-27 18:36:44.141176333 +0300
+++ new/Data/Conduit/TMChan.hs 2014-08-27 18:36:43.000000000 +0300
@@ -63,22 +63,23 @@
import Control.Concurrent.STM.TMChan
import Data.Conduit
-import Data.Conduit.Internal (Pipe (..), ConduitM (..))
+import qualified Data.Conduit.List as CL
-chanSource
+chanSource
:: MonadIO m
=> chan -- ^ The channel.
-> (chan -> STM (Maybe a)) -- ^ The 'read' function.
-> (chan -> STM ()) -- ^ The 'close' function.
-> Source m a
-chanSource ch reader closer = ConduitM src
- where
- src = PipeM pull
- pull = do a <- liftSTM $ reader ch
- case a of
- Just x -> return $ HaveOutput src close x
- Nothing -> return $ Done ()
- close = liftSTM $ closer ch
+chanSource ch reader closer =
+ loop
+ where
+ loop = do
+ a <- liftSTM $ reader ch
+ case a of
+ Just x -> yieldOr x close >> loop
+ Nothing -> return ()
+ close = liftSTM $ closer ch
{-# INLINE chanSource #-}
chanSink
@@ -87,13 +88,9 @@
-> (chan -> a -> STM ()) -- ^ The 'write' function.
-> (chan -> STM ()) -- ^ The 'close' function.
-> Sink a m ()
-chanSink ch writer closer = ConduitM sink
- where
- sink = NeedInput push close
-
- push input = PipeM ((liftIO . atomically $ writer ch input)
- >> (return $ NeedInput push close))
- close = const . liftSTM $ closer ch
+chanSink ch writer closer = do
+ CL.mapM_ $ liftIO . atomically . writer ch
+ liftSTM $ closer ch
{-# INLINE chanSink #-}
-- | A simple wrapper around a TBMChan. As data is pushed into the channel, the
diff -ruN orig/Data/Conduit/TQueue.hs new/Data/Conduit/TQueue.hs
--- orig/Data/Conduit/TQueue.hs 2014-08-27 18:36:44.141176333 +0300
+++ new/Data/Conduit/TQueue.hs 2014-08-27 18:36:43.000000000 +0300
@@ -58,46 +58,28 @@
import Control.Monad
import Control.Monad.IO.Class
import Data.Conduit
-import Data.Conduit.Internal
+import qualified Data.Conduit.List as CL
-- | A simple wrapper around a "TQueue". As data is pushed into the queue, the
-- source will read it and pass it down the conduit pipeline.
sourceTQueue :: MonadIO m => TQueue a -> Source m a
-sourceTQueue q = ConduitM src
- where src = PipeM pull
- pull = do x <- liftSTM $ readTQueue q
- return $ HaveOutput src close x
- close = return ()
+sourceTQueue q = forever $ liftSTM (readTQueue q) >>= yield
-- | A simple wrapper around a "TQueue". As data is pushed into this sink, it
-- will magically begin to appear in the queue.
sinkTQueue :: MonadIO m => TQueue a -> Sink a m ()
-sinkTQueue q = ConduitM src
- where src = sink
- sink = NeedInput push close
- push input = PipeM ((liftSTM $ writeTQueue q input)
- >> (return $ NeedInput push close))
- close _ = return ()
+sinkTQueue q = CL.mapM_ (liftSTM . writeTQueue q)
-- | A simple wrapper around a "TBQueue". As data is pushed into the queue, the
-- source will read it and pass it down the conduit pipeline.
sourceTBQueue :: MonadIO m => TBQueue a -> Source m a
-sourceTBQueue q = ConduitM src
- where src = PipeM pull
- pull = do x <- liftSTM $ readTBQueue q
- return $ HaveOutput src close x
- close = return ()
+sourceTBQueue q = forever $ liftSTM (readTBQueue q) >>= yield
-- | A simple wrapper around a "TBQueue". As data is pushed into this sink, it
-- will magically begin to appear in the queue. Boolean argument is used
-- to specify if queue should be closed when the sink is closed.
sinkTBQueue :: MonadIO m => TBQueue a -> Sink a m ()
-sinkTBQueue q = ConduitM src
- where src = sink
- sink = NeedInput push close
- push input = PipeM ((liftSTM $ writeTBQueue q input)
- >> (return $ NeedInput push close))
- close _ = return ()
+sinkTBQueue q = CL.mapM_ (liftSTM . writeTBQueue q)
-- | A convenience wrapper for creating a source and sink TBQueue of the given
-- size at once, without exposing the underlying queue.
@@ -109,14 +91,15 @@
-- source will read it and pass it down the conduit pipeline. When the
-- queue is closed, the source will close also.
sourceTMQueue :: MonadIO m => TMQueue a -> Source m a
-sourceTMQueue q = ConduitM src
- where src = PipeM pull
- pull = do mx <- liftSTM $ readTMQueue q
- case mx of
- Nothing -> return $ Done ()
- Just x -> return $ HaveOutput src close x
- close = do liftSTM $ closeTMQueue q
- return ()
+sourceTMQueue q =
+ loop
+ where
+ loop = do
+ mx <- liftSTM $ readTMQueue q
+ case mx of
+ Nothing -> return ()
+ Just x -> yieldOr x close >> loop
+ close = liftSTM $ closeTMQueue q
-- | A simple wrapper around a "TMQueue". As data is pushed into this sink, it
-- will magically begin to appear in the queue.
@@ -124,26 +107,23 @@
=> TMQueue a
-> Bool -- ^ Should the queue be closed when the sink is closed?
-> Sink a m ()
-sinkTMQueue q shouldClose = ConduitM src
- where src = sink
- sink = NeedInput push close
- push input = PipeM ((liftSTM $ writeTMQueue q input)
- >> (return $ NeedInput push close))
- close _ = do when shouldClose (liftSTM $ closeTMQueue q)
- return ()
+sinkTMQueue q shouldClose = do
+ CL.mapM_ (liftSTM . writeTMQueue q)
+ when shouldClose (liftSTM $ closeTMQueue q)
-- | A simple wrapper around a "TBMQueue". As data is pushed into the queue, the
-- source will read it and pass it down the conduit pipeline. When the
-- queue is closed, the source will close also.
sourceTBMQueue :: MonadIO m => TBMQueue a -> Source m a
-sourceTBMQueue q = ConduitM src
- where src = PipeM pull
- pull = do mx <- liftSTM $ readTBMQueue q
- case mx of
- Nothing -> return $ Done ()
- Just x -> return $ HaveOutput src close x
- close = do liftSTM $ closeTBMQueue q
- return ()
+sourceTBMQueue q =
+ loop
+ where
+ loop = do
+ mx <- liftSTM $ readTBMQueue q
+ case mx of
+ Nothing -> return ()
+ Just x -> yieldOr x close >> loop
+ close = liftSTM $ closeTBMQueue q
-- | A simple wrapper around a "TBMQueue". As data is pushed into this sink, it
-- will magically begin to appear in the queue.
@@ -151,13 +131,9 @@
=> TBMQueue a
-> Bool -- ^ Should the queue be closed when the sink is closed?
-> Sink a m ()
-sinkTBMQueue q shouldClose = ConduitM src
- where src = sink
- sink = NeedInput push close
- push input = PipeM ((liftSTM $ writeTBMQueue q input)
- >> (return $ NeedInput push close))
- close _ = do when shouldClose (liftSTM $ closeTBMQueue q)
- return ()
+sinkTBMQueue q shouldClose = do
+ CL.mapM_ (liftSTM . writeTBMQueue q)
+ when shouldClose (liftSTM $ closeTBMQueue q)
liftSTM :: forall (m :: * -> *) a. MonadIO m => STM a -> m a
diff -ruN orig/stm-conduit.cabal new/stm-conduit.cabal
--- orig/stm-conduit.cabal 2014-08-27 18:36:44.145176333 +0300
+++ new/stm-conduit.cabal 2014-08-27 18:36:43.000000000 +0300
@@ -29,7 +29,7 @@
, stm-chans >= 2.0 && < 3.1
, cereal >= 0.4.0.1
, cereal-conduit >= 0.7.2
- , conduit >= 1.0 && < 1.2
+ , conduit >= 1.0 && < 1.3
, conduit-extra >= 1.0 && < 1.2
, directory >= 1.1
, resourcet >= 0.3 && < 1.2

12
patching/patches/temporary-1.2.0.1.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/temporary.cabal new/temporary.cabal
--- orig/temporary.cabal 2014-04-03 08:17:21.902394760 +0300
+++ new/temporary.cabal 2014-04-03 08:17:21.000000000 +0300
@@ -23,7 +23,7 @@
other-modules: Distribution.Compat.Exception
Distribution.Compat.TempFile
build-depends: base >= 3 && < 6, filepath >= 1.1 && < 1.4, directory >= 1.0 && < 1.3,
- transformers >= 0.2.0.0 && < 0.4, exceptions >= 0.1.1 && < 0.4
+ transformers >= 0.2.0.0 && < 0.4, exceptions >= 0.1.1 && < 0.6
if !os(windows)
build-depends: unix >= 2.3 && < 2.8

39
patching/patches/temporary-1.2.0.2.patch
View File

@ -1,39 +0,0 @@
diff -ru orig/System/IO/Temp.hs new/System/IO/Temp.hs
--- orig/System/IO/Temp.hs 2014-05-11 15:04:23.887266736 +0300
+++ new/System/IO/Temp.hs 2014-05-11 15:04:23.000000000 +0300
@@ -24,7 +24,7 @@
--
-- Behaves exactly the same as 'withTempFile', except that the parent temporary directory
-- will be that returned by 'getTemporaryDirectory'.
-withSystemTempFile :: (MonadIO m, MonadCatch m) =>
+withSystemTempFile :: (MonadIO m, MonadMask m) =>
String -- ^ File name template. See 'openTempFile'.
-> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
-> m a
@@ -34,7 +34,7 @@
--
-- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory
-- will be that returned by 'getTemporaryDirectory'.
-withSystemTempDirectory :: (MonadIO m, MonadCatch m) =>
+withSystemTempDirectory :: (MonadIO m, MonadMask m) =>
String -- ^ Directory name template. See 'openTempFile'.
-> (FilePath -> m a) -- ^ Callback that can use the directory
-> m a
@@ -50,7 +50,7 @@
--
-- The @tmpFlie@ will be file in the given directory, e.g.
-- @src/sdist.342@.
-withTempFile :: (MonadIO m, MonadCatch m) =>
+withTempFile :: (MonadIO m, MonadMask m) =>
FilePath -- ^ Temp dir to create the file in
-> String -- ^ File name template. See 'openTempFile'.
-> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
@@ -70,7 +70,7 @@
--
-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.
-- @src/sdist.342@.
-withTempDirectory :: (MonadCatch m, MonadIO m) =>
+withTempDirectory :: (MonadMask m, MonadIO m) =>
FilePath -- ^ Temp directory to create the directory in
-> String -- ^ Directory name template. See 'openTempFile'.
-> (FilePath -> m a) -- ^ Callback that can use the directory

20
patching/patches/th-desugar-1.4.2.patch
View File

@ -1,20 +0,0 @@
diff -ruN orig/Test/Run.hs new/Test/Run.hs
--- orig/Test/Run.hs 2014-08-19 09:57:25.537902164 +0300
+++ new/Test/Run.hs 2014-08-19 09:57:25.000000000 +0300
@@ -27,6 +27,7 @@
import Language.Haskell.TH.Desugar.Expand
import Language.Haskell.TH.Desugar.Sweeten
import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (qRunIO)
import Control.Monad
@@ -121,7 +122,7 @@
case (resK, lhs) of
(DStarK, [DVarT _]) -> [| True |]
_ -> do
- runIO $ do
+ qRunIO $ do
putStrLn "Failed bug8884 test:"
putStrLn $ show dinfo
[| False |] )

47
patching/patches/threepenny-gui-0.4.1.0.patch
View File

@ -1,47 +0,0 @@
diff -ru orig/src/Graphics/UI/Threepenny/Internal/Driver.hs new/src/Graphics/UI/Threepenny/Internal/Driver.hs
--- orig/src/Graphics/UI/Threepenny/Internal/Driver.hs 2014-03-13 10:29:00.049732639 +0200
+++ new/src/Graphics/UI/Threepenny/Internal/Driver.hs 2014-03-13 10:28:59.000000000 +0200
@@ -248,7 +248,7 @@
signal Session{..} = do
input <- getParam "signal"
let err = error $ "Unable to parse " ++ show input
- case JSON.decode . LBS.fromStrict =<< input of
+ case JSON.decode . LBS.fromChunks . return =<< input of
Just signal -> liftIO $ writeChan sSignals signal
Nothing -> err
diff -ru orig/src/Graphics/UI/Threepenny/Internal/Types.hs new/src/Graphics/UI/Threepenny/Internal/Types.hs
--- orig/src/Graphics/UI/Threepenny/Internal/Types.hs 2014-03-13 10:29:00.049732639 +0200
+++ new/src/Graphics/UI/Threepenny/Internal/Types.hs 2014-03-13 10:28:59.000000000 +0200
@@ -17,6 +17,7 @@
import Data.Map (Map)
import Data.String (fromString)
import Data.Time
+import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Network.URI
import Data.Data
@@ -62,9 +63,9 @@
-- Marshalling ElementId
instance ToJSON ElementId where
- toJSON (ElementId o) = toJSON o
+ toJSON (ElementId o) = toJSON $ decodeUtf8 o
instance FromJSON ElementId where
- parseJSON (Object v) = ElementId <$> v .: "Element"
+ parseJSON (Object v) = (ElementId . encodeUtf8) <$> v .: "Element"
parseJSON _ = mzero
diff -ru orig/threepenny-gui.cabal new/threepenny-gui.cabal
--- orig/threepenny-gui.cabal 2014-03-13 10:29:00.057732639 +0200
+++ new/threepenny-gui.cabal 2014-03-13 10:28:59.000000000 +0200
@@ -92,7 +92,7 @@
cpp-options: -DREBUG
ghc-options: -O2
build-depends: base >= 4 && < 5
- ,aeson == 0.6.*
+ ,aeson >= 0.6
,attoparsec-enumerator == 0.3.*
,bytestring >= 0.9.2 && < 0.11
,containers >= 0.4.2 && < 0.6

50
patching/patches/transformers-compat-0.3.3.4.patch
View File

@ -1,50 +0,0 @@
Only in orig: 0.2
diff -ru orig/transformers-compat.cabal new/transformers-compat.cabal
--- orig/transformers-compat.cabal 2014-06-20 06:30:48.534077053 +0300
+++ new/transformers-compat.cabal 2014-06-20 06:30:48.000000000 +0300
@@ -38,17 +38,6 @@
type: git
location: git://github.com/ekmett/transformers-compat.git
-flag two
- default: False
- description: Use transformers 0.2. This must be selected manually and should
- probably only be used on older GHCs around 7.0.x.
- manual: True
-
-flag three
- default: False
- manual: True
- description: Use transformers 0.3. This should toggle on/off automatically.
-
library
build-depends:
base >= 4.3 && < 5
@@ -56,24 +45,10 @@
other-modules:
Paths_transformers_compat
- if flag(three)
- hs-source-dirs: 0.3
- build-depends: transformers >= 0.3 && < 0.4
- else
- if flag(two)
- hs-source-dirs: 0.2 0.3
- build-depends: transformers >= 0.2 && < 0.3
- else
- build-depends: transformers >= 0.4.1 && < 0.5
-
- if flag(two)
- exposed-modules:
- Control.Applicative.Backwards
- Control.Applicative.Lift
- Data.Functor.Reverse
+ hs-source-dirs: 0.3
+ build-depends: transformers >= 0.3 && < 0.4
- if flag(two) || flag(three)
- exposed-modules:
+ exposed-modules:
Control.Monad.Trans.Except
Control.Monad.Signatures
Data.Functor.Classes

100
patching/patches/uniqueid-0.1.1.patch
View File

@ -1,100 +0,0 @@
diff -ru orig/Data/Unique/Id.hs new/Data/Unique/Id.hs
--- orig/Data/Unique/Id.hs 2014-04-14 09:11:35.637516354 +0300
+++ new/Data/Unique/Id.hs 2014-04-14 09:11:35.000000000 +0300
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
-- | This module provides splittable supplies for unique identifiers.
@@ -13,6 +14,86 @@
) where
+#if MIN_VERSION_base(4,7,0)
+
+import GHC.Exts
+import GHC.IO ( unsafeDupableInterleaveIO )
+
+import Data.IORef
+import System.IO.Unsafe ( unsafePerformIO )
+
+-- | Unique identifiers are of type 'Id' and can be hashed to an 'Int'
+-- usning the function 'hashedId'.
+newtype Id = Id { hashedId :: Int }
+
+-- | Supplies for unique identifiers are of type 'IdSupply' and can be
+-- split into two new supplies or yield a unique identifier.
+data IdSupply = IdSupply Int# IdSupply IdSupply
+
+-- | Generates a new supply of unique identifiers. The given character
+-- is prepended to generated numbers.
+initIdSupply :: Char -> IO IdSupply
+initIdSupply (C# c) =
+ case uncheckedIShiftL# (ord# c) (unboxedInt 24) of
+ mask ->
+ let mkSupply =
+ unsafeDupableInterleaveIO (
+ nextInt >>= \ (I# u) ->
+ mkSupply >>= \ l ->
+ mkSupply >>= \ r ->
+ return (IdSupply (word2Int# (or# (int2Word# mask) (int2Word# u))) l r))
+ in mkSupply
+
+-- | Splits a supply of unique identifiers to yield two of them.
+splitIdSupply :: IdSupply -> (IdSupply,IdSupply)
+splitIdSupply (IdSupply _ l r) = (l,r)
+
+-- | Splits a supply of unique identifiers to yield an infinite list of them.
+splitIdSupplyL :: IdSupply -> [IdSupply]
+splitIdSupplyL ids = ids1 : splitIdSupplyL ids2
+ where
+ (ids1, ids2) = splitIdSupply ids
+
+-- | Yields the unique identifier from a supply.
+idFromSupply :: IdSupply -> Id
+idFromSupply (IdSupply n _ _) = Id (I# n)
+
+instance Eq Id where Id (I# x) == Id (I# y) = I# (x ==# y) /= 0
+
+instance Ord Id
+ where
+ Id (I# x) < Id (I# y) = I# (x <# y) /= 0
+ Id (I# x) <= Id (I# y) = I# (x <=# y) /= 0
+
+ compare (Id (I# x)) (Id (I# y)) =
+ if I# (x ==# y) /= 0 then EQ else if I# (x <# y) /= 0 then LT else GT
+
+instance Show Id
+ where
+ showsPrec _ i s = case unpackId i of (c,n) -> c:show n++s
+
+
+
+
+unboxedInt :: Int -> Int#
+unboxedInt (I# x) = x
+
+global :: IORef Int
+global = unsafePerformIO (newIORef 0)
+
+nextInt :: IO Int
+nextInt = do
+ n <- readIORef global
+ writeIORef global (succ n)
+ return n
+
+unpackId :: Id -> (Char,Int)
+unpackId (Id (I# i)) =
+ let tag = C# (chr# (uncheckedIShiftRL# i (unboxedInt 24)))
+ num = I# (word2Int# (and# (int2Word# i)
+ (int2Word# (unboxedInt 16777215))))
+ in (tag, num)
+#else
import GHC.Exts
import GHC.IOBase ( unsafeDupableInterleaveIO )
@@ -90,3 +171,4 @@
num = I# (word2Int# (and# (int2Word# i)
(int2Word# (unboxedInt 16777215))))
in (tag, num)
+#endif

21
patching/patches/websockets-0.8.2.0.patch
View File

@ -1,21 +0,0 @@
diff -ru orig/websockets.cabal new/websockets.cabal
--- orig/websockets.cabal 2014-04-03 08:32:53.818374925 +0300
+++ new/websockets.cabal 2014-04-03 08:32:53.000000000 +0300
@@ -69,7 +69,7 @@
binary >= 0.5 && < 0.8,
blaze-builder >= 0.3 && < 0.4,
bytestring >= 0.9 && < 0.11,
- case-insensitive >= 0.3 && < 1.2,
+ case-insensitive >= 0.3 && < 1.3,
containers >= 0.3 && < 0.6,
io-streams >= 1.1 && < 1.2,
mtl >= 2.0 && < 2.2,
@@ -105,7 +105,7 @@
binary >= 0.5 && < 0.8,
blaze-builder >= 0.3 && < 0.4,
bytestring >= 0.9 && < 0.11,
- case-insensitive >= 0.3 && < 1.2,
+ case-insensitive >= 0.3 && < 1.3,
containers >= 0.3 && < 0.6,
io-streams >= 1.1 && < 1.2,
mtl >= 2.0 && < 2.2,

77
patching/patches/yesod-auth-fb-1.6.1.patch
View File

@ -1,77 +0,0 @@
diff -ru orig/demo/clientside.hs new/demo/clientside.hs
--- orig/demo/clientside.hs 2014-03-30 12:27:40.941431437 +0300
+++ new/demo/clientside.hs 2014-03-30 12:27:40.000000000 +0300
@@ -27,7 +27,7 @@
instance Yesod Test where
- approot = ApprootStatic "http://dev.whonodes.org:3000"
+ approot = FIXME -- FIXME: Put your approot here
instance RenderMessage Test FormMessage where
renderMessage _ _ = englishFormMessage
diff -ru orig/src/Yesod/Auth/Facebook/ClientSide.hs new/src/Yesod/Auth/Facebook/ClientSide.hs
--- orig/src/Yesod/Auth/Facebook/ClientSide.hs 2014-03-30 12:27:40.941431437 +0300
+++ new/src/Yesod/Auth/Facebook/ClientSide.hs 2014-03-30 12:27:40.000000000 +0300
@@ -364,7 +364,7 @@
AuthPlugin "fbcs" dispatch login
where
dispatch :: YesodAuthFbClientSide site =>
- Text -> [Text] -> HandlerT Auth (HandlerT site IO) ()
+ Text -> [Text] -> HandlerT Auth (HandlerT site IO) TypedContent
-- Login route used when successfully logging in. Called via
-- AJAX by JavaScript code on 'facebookJSSDK'.
dispatch "GET" ["login"] = do
@@ -372,7 +372,7 @@
when (redirectToReferer y) (lift setUltDestReferer)
etoken <- lift getUserAccessTokenFromFbCookie
case etoken of
- Right token -> lift $ setCreds True (createCreds token)
+ Right token -> lift $ setCredsRedirect (createCreds token)
Left msg -> fail msg
-- Login routes used to forcefully require the user to login.
@@ -406,7 +406,7 @@
token <- lift $
YF.runYesodFbT $
FB.getUserAccessTokenStep2 proceedUrl query'
- lift $ setCreds True (createCreds token)
+ lift $ setCredsRedirect (createCreds token)
-- Everything else gives 404
dispatch _ _ = notFound
diff -ru orig/src/Yesod/Auth/Facebook/ServerSide.hs new/src/Yesod/Auth/Facebook/ServerSide.hs
--- orig/src/Yesod/Auth/Facebook/ServerSide.hs 2014-03-30 12:27:40.941431437 +0300
+++ new/src/Yesod/Auth/Facebook/ServerSide.hs 2014-03-30 12:27:40.000000000 +0300
@@ -56,7 +56,7 @@
proceedR = PluginR "fb" ["proceed"]
dispatch :: (YesodAuth site, YF.YesodFacebook site) =>
- Text -> [Text] -> HandlerT Auth (HandlerT site IO) ()
+ Text -> [Text] -> HandlerT Auth (HandlerT site IO) TypedContent
-- Redirect the user to Facebook.
dispatch "GET" ["login"] = do
ur <- getUrlRender
@@ -73,7 +73,7 @@
lift $ do
token <- YF.runYesodFbT $ FB.getUserAccessTokenStep2 proceedUrl query'
setUserAccessToken token
- setCreds True (createCreds token)
+ setCredsRedirect (createCreds token)
-- Logout the user from our site and from Facebook.
dispatch "GET" ["logout"] = do
y <- lift getYesod
diff -ru orig/yesod-auth-fb.cabal new/yesod-auth-fb.cabal
--- orig/yesod-auth-fb.cabal 2014-03-30 12:27:40.945431436 +0300
+++ new/yesod-auth-fb.cabal 2014-03-30 12:27:40.000000000 +0300
@@ -43,8 +43,9 @@
Build-depends: base >= 4.3 && < 5
, lifted-base >= 0.1 && < 0.3
, yesod-core == 1.2.*
- , yesod-auth == 1.2.*
+ , yesod-auth == 1.3.*
, hamlet
+ , shakespeare
, shakespeare-js >= 1.0.2
, wai
, http-conduit >= 1.9

26
patching/patches/yesod-auth-oauth-1.2.0.patch
View File

@ -1,26 +0,0 @@
diff -ru orig/Yesod/Auth/OAuth.hs new/Yesod/Auth/OAuth.hs
--- orig/Yesod/Auth/OAuth.hs 2014-03-30 12:34:43.941422434 +0300
+++ new/Yesod/Auth/OAuth.hs 2014-03-30 12:34:43.000000000 +0300
@@ -72,7 +72,7 @@
master <- getYesod
accTok <- getAccessToken oauth reqTok (authHttpManager master)
creds <- liftIO $ mkCreds accTok
- setCreds True creds
+ setCredsRedirect creds
dispatch _ _ = notFound
login tm = do
render <- getUrlRender
diff -ru orig/yesod-auth-oauth.cabal new/yesod-auth-oauth.cabal
--- orig/yesod-auth-oauth.cabal 2014-03-30 12:34:43.941422434 +0300
+++ new/yesod-auth-oauth.cabal 2014-03-30 12:34:43.000000000 +0300
@@ -23,8 +23,8 @@
build-depends: authenticate-oauth >= 1.4 && < 1.5
, bytestring >= 0.9.1.4
, yesod-core >= 1.2 && < 1.3
- , yesod-auth >= 1.2 && < 1.3
- , text >= 0.7 && < 0.12
+ , yesod-auth >= 1.3 && < 1.4
+ , text >= 0.7 && < 1.2
, yesod-form >= 1.3 && < 1.4
, transformers >= 0.2.2 && < 0.4
, lifted-base >= 0.2 && < 0.3