diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog +## 0.4.3.2 + +* Buildable with GHC 8.2 + ## 0.4.3.1 * Fixed compilation on GHC 7.8 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -15,7 +15,7 @@ the default, so that the most common endianness has no overhead. * Instead of implementing lazy serialization / deserialization involving - multiple input / output buffers, `peek` an `poke` always work with a single + multiple input / output buffers, `peek` and `poke` always work with a single buffer. This buffer is allocated by asking the value for its size before encoding. This simplifies the encoding logic, and allows for highly optimized tight loops. diff --git a/src/Data/Store/Internal.hs b/src/Data/Store/Internal.hs --- a/src/Data/Store/Internal.hs +++ b/src/Data/Store/Internal.hs @@ -107,13 +107,14 @@ import qualified Data.Text.Foreign as T import qualified Data.Text.Internal as T import qualified Data.Time as Time -import Data.Typeable.Internal (Typeable) +import Data.Typeable (Typeable) import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Storable as SV import qualified Data.Vector.Storable.Mutable as MSV import Data.Void import Data.Word +import Foreign.C.Types () import Foreign.Ptr (plusPtr, minusPtr) import Foreign.Storable (Storable, sizeOf) import GHC.Generics (Generic) @@ -126,6 +127,7 @@ import Language.Haskell.TH.Instances () import Language.Haskell.TH.ReifyMany import Language.Haskell.TH.Syntax +import Network.Socket (AddrInfo) import Prelude import TH.Derive @@ -707,7 +709,28 @@ $(deriveManyStoreUnboxVector) -$(deriveManyStoreFromStorable (\_ -> True)) +$(deriveManyStoreFromStorable + -- TODO: Figure out why on GHC-8.2.1 this internal datatype is visible + -- in the instances of Storable. Here's a gist of an attempt at + -- debugging the issue: + -- + -- https://gist.github.com/mgsloan/a7c416b961015949d3b5674ce053bbf6 + -- + -- The mysterious thing is why this is happening despite not having a + -- direct import of Data.Text.Encoding. + (\ty -> + case ty of + ConT n | nameModule n == Just "Data.Text.Encoding" + && nameBase n == "DecoderState" -> False + ConT n | nameModule n == Just "Data.Text.Encoding" + && nameBase n == "CodePoint" -> False + ConT n | nameModule n == Just "Network.Socket.Types" + && nameBase n == "In6Addr" -> False + -- AddrInfo's Storable instance is lossy, so avoid having a Store + -- instance for it. + ConT n | n == ''AddrInfo -> False + _ -> True + )) $(deriveManyStorePrimVector) diff --git a/src/Data/Store/TH.hs b/src/Data/Store/TH.hs --- a/src/Data/Store/TH.hs +++ b/src/Data/Store/TH.hs @@ -7,17 +7,17 @@ -- do not, then instead use "TH.Derive" like this: -- -- @ --- {-# LANGUAGE TemplateHaskell #-} --- {-# LANGUAGE ScopedTypeVariables #-} +-- \{\-\# LANGUAGE TemplateHaskell \#\-\} +-- \{\-\# LANGUAGE ScopedTypeVariables \#\-\} -- --- import TH.Derive --- import Data.Store +-- import TH.Derive +-- import Data.Store -- --- data Foo a = Foo a | Bar Int +-- data Foo a = Foo a | Bar Int -- --- $($(derive [d| --- instance Store a => Deriving (Store (Foo a)) --- |])) +-- \$($(derive [d| +-- instance Store a => Deriving (Store (Foo a)) +-- |])) -- @ -- -- Note that when used with datatypes that require type variables, the diff --git a/src/Data/Store/TypeHash/Internal.hs b/src/Data/Store/TypeHash/Internal.hs --- a/src/Data/Store/TypeHash/Internal.hs +++ b/src/Data/Store/TypeHash/Internal.hs @@ -78,6 +78,9 @@ go (_, ClassOpI{}) = return (False, []) go (_, VarI{}) = return (False, []) go (_, TyVarI{}) = return (False, []) +#if MIN_VERSION_template_haskell(2,12,0) + go (_, PatSynI{}) = return (False, []) +#endif -- | At compiletime, this yields a hash of the specified datatypes. -- Not only does this cover the datatypes themselves, but also all diff --git a/src/Data/Store/Version.hs b/src/Data/Store/Version.hs --- a/src/Data/Store/Version.hs +++ b/src/Data/Store/Version.hs @@ -44,7 +44,6 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.IO as T -import Data.Typeable.Internal (TypeRep(..)) import Data.Word (Word32) import GHC.Generics (Generic) import Language.Haskell.TH @@ -230,12 +229,9 @@ return (error "unexpected evaluation") showsQualTypeRep :: M.Map String String -> Int -> TypeRep -> ShowS -#if MIN_VERSION_base(4,8,0) -showsQualTypeRep renames p (TypeRep _ tycon _ tys) = -#else -showsQualTypeRep renames p (TypeRep _ tycon tys) = -#endif - case tys of +showsQualTypeRep renames p tyrep = + let (tycon, tys) = splitTyConApp tyrep + in case tys of [] -> showsQualTyCon renames tycon [x] | tycon == tcList -> showChar '[' . showsQualTypeRep renames 0 x . showChar ']' where diff --git a/store.cabal b/store.cabal --- a/store.cabal +++ b/store.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.17.0. +-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack name: store -version: 0.4.3.1 +version: 0.4.3.2 synopsis: Fast binary serialization category: Serialization, Data homepage: https://github.com/fpco/store#readme diff --git a/test/Data/Store/StreamingSpec.hs b/test/Data/Store/StreamingSpec.hs --- a/test/Data/Store/StreamingSpec.hs +++ b/test/Data/Store/StreamingSpec.hs @@ -8,17 +8,15 @@ import Control.Concurrent.Async (race, concurrently) import Control.Concurrent.MVar import Control.Exception (try) -import Control.Monad (void, (<=<), forM_, unless) +import Control.Monad (void, (<=<), forM_) import Control.Monad.Trans.Free (runFreeT, FreeF(..)) import Control.Monad.Trans.Free.Church (fromFT) import Control.Monad.Trans.Resource import qualified Data.ByteString as BS import Data.Conduit ((=$=), ($$)) import qualified Data.Conduit.List as C -import Data.Int import Data.List (unfoldr) import Data.Monoid -import Data.Store.Core (unsafeEncodeWith) import Data.Store.Internal import Data.Store.Streaming import Data.Store.Streaming.Internal @@ -164,8 +162,8 @@ return x decodeTricklingMessageFd :: Integer -> Property IO -decodeTricklingMessageFd x = monadic $ do - let bs = encodeMessage (Message x) +decodeTricklingMessageFd v = monadic $ do + let bs = encodeMessage (Message v) BB.with Nothing $ \bb -> withServer $ \sock1 sock2 -> do let generateChunks :: [Int] -> BS.ByteString -> [BS.ByteString] @@ -175,12 +173,12 @@ then [] else BS.take x bs_ : generateChunks xs (BS.drop x bs_) let chunks = generateChunks [] bs - ((), Message x') <- concurrently + ((), Message v') <- concurrently (forM_ chunks $ \chunk -> do void (send sock1 chunk) threadDelay (10 * 1000)) (decodeMessageFd bb (socketFd sock2)) - return (x == x') + return (v == v') #endif diff --git a/test/Data/StoreSpec.hs b/test/Data/StoreSpec.hs --- a/test/Data/StoreSpec.hs +++ b/test/Data/StoreSpec.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} @@ -10,6 +10,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MonoLocalBinds #-} module Data.StoreSpec where import Control.Applicative @@ -32,7 +33,6 @@ import Data.Monoid import Data.Primitive.Types (Addr) import Data.Proxy (Proxy(..)) -import Data.Ratio (numerator, denominator) import Data.Sequence (Seq) import Data.Sequences (fromList) import Data.Set (Set) @@ -61,6 +61,7 @@ import Language.Haskell.TH import Language.Haskell.TH.ReifyMany import Language.Haskell.TH.Syntax +import Network.Socket import Prelude import System.Posix.Types import Test.Hspec hiding (runIO) @@ -82,12 +83,21 @@ -- Serial instances for (Num a, Bounded a) types. Only really -- appropriate for the use here. +instance Bounded PortNumber where + minBound = 0 + maxBound = 65535 + $(do let ns = [ ''CWchar, ''CUShort, ''CULong, ''CULLong, ''CIntMax , ''CUIntMax, ''CPtrdiff, ''CSChar, ''CShort, ''CUInt, ''CLLong , ''CLong, ''CInt, ''CChar, ''CSsize, ''CPid , ''COff, ''CMode, ''CIno, ''CDev , ''Word8, ''Word16, ''Word32, ''Word64, ''Word , ''Int8, ''Int16, ''Int32, ''Int64 + , ''PortNumber +#if MIN_VERSION_base(4,10,0) + , ''CBool, ''CClockId, ''CKey, ''CId + , ''CBlkSize, ''CFsBlkCnt, ''CFsFilCnt, ''CBlkCnt +#endif ] ++ #ifdef mingw32_HOST_OS [] @@ -279,6 +289,9 @@ , [t| TypeHash |] , [t| Fd |] , [t| NameFlavour |] +#if MIN_VERSION_base(4,10,0) + , [t| CTimer |] +#endif ] let f ty = isMonoType ty && ty `notElem` omitTys smallcheckManyStore verbose 2 . map return . filter f $ insts)