diff --git a/Data/PrimitiveArray/Dense.hs b/Data/PrimitiveArray/Dense.hs index 5908598..6496ac0 100644 --- a/Data/PrimitiveArray/Dense.hs +++ b/Data/PrimitiveArray/Dense.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} -- | Dense primitive arrays where the lower index is zero (or the -- equivalent of zero for newtypes and enumerations). @@ -24,11 +27,11 @@ import Control.DeepSeq import Control.Exception (assert) import Control.Monad (liftM, forM_, zipWithM_, when) import Control.Monad.Primitive (PrimState) -import Data.Aeson (ToJSON,FromJSON) -import Data.Binary (Binary) +import Data.Aeson (ToJSON,FromJSON,ToJSON(..),FromJSON(..), withObject, (.:), object) +import Data.Binary (Binary,Binary(..)) import Data.Data -import Data.Hashable (Hashable) -import Data.Serialize (Serialize) +import Data.Hashable (Hashable,Hashable(..)) +import Data.Serialize (Serialize,Serialize(..)) import Data.Typeable (Typeable) import Data.Vector.Binary import Data.Vector.Generic.Mutable as GM hiding (length) @@ -43,7 +46,7 @@ import qualified Data.Vector.Unboxed as VU import Data.PrimitiveArray.Class import Data.PrimitiveArray.Index.Class - +import qualified Data.Serialize as Data data Dense v sh e = Dense { _denseLimit :: !(LimitType sh), _denseV :: !(v e) } @@ -58,7 +61,7 @@ type Boxed sh e = Dense V.Vector sh e deriving instance (Eq (LimitType sh), Eq (v e) ) => Eq (Dense v sh e) -deriving instance (Generic (LimitType sh), Generic (v e)) => Generic (Dense v sh e) +-- deriving instance (Generic (LimitType sh), Generic (v e)) => Generic (Dense v sh e) deriving instance (Read (LimitType sh), Read (v e) ) => Read (Dense v sh e) deriving instance (Show (LimitType sh), Show (v e) ) => Show (Dense v sh e) deriving instance (Functor v) => Functor (Dense v sh) @@ -67,15 +70,34 @@ deriving instance Typeable (Dense v sh e) deriving instance (Data (v e), Data (LimitType sh), Data e, Data sh, Typeable sh, Typeable e, Typeable v) => Data (Dense v sh e) -instance (Binary (LimitType sh), Binary (v e), Generic (LimitType sh), Generic (v e)) => Binary (Dense v sh e) -instance (Serialize (LimitType sh), Serialize (v e), Generic (LimitType sh), Generic (v e)) => Serialize (Dense v sh e) -instance (ToJSON (LimitType sh), ToJSON (v e), Generic (LimitType sh), Generic (v e)) => ToJSON (Dense v sh e) -instance (FromJSON (LimitType sh), FromJSON (v e), Generic (LimitType sh), Generic (v e)) => FromJSON (Dense v sh e) -instance (Hashable (LimitType sh), Hashable (v e), Generic (LimitType sh), Generic (v e)) => Hashable (Dense v sh e) - -instance (NFData (LimitType sh), NFData (v e)) ⇒ NFData (Dense v sh e) where - rnf (Dense h xs) = rnf h `seq` rnf xs - {-# Inline rnf #-} +deriving instance (Generic (LimitType sh), Generic (v e), Generic e, VG.Vector v e) => Generic (Dense v sh e) +-- Binary instance for Dense using GHC.Generics +instance (Binary (LimitType sh), Binary e, VG.Vector v e, Generic (Dense v sh e)) => Binary (Dense v sh e) where + put (Dense limit v) = Data.Binary.put limit >> Data.Binary.put (VG.toList v) + get = Dense <$> Data.Binary.get <*> (VG.fromList <$> Data.Binary.get) + +-- Serialize instance for Dense +instance (Serialize (LimitType sh), Serialize e, VG.Vector v e) => Serialize (Dense v sh e) where + put (Dense limit v) = Data.Serialize.put limit >> Data.Serialize.put (VG.toList v) + get = Dense <$> Data.Serialize.get <*> (VG.fromList <$> Data.Serialize.get) + +-- ToJSON instance for Dense +instance (ToJSON (LimitType sh), ToJSON e, VG.Vector v e) => ToJSON (Dense v sh e) where + toJSON (Dense limit v) = object [("limit", toJSON limit), ("vector", toJSON (VG.toList v))] + +-- FromJSON instance for Dense +instance (FromJSON (LimitType sh), FromJSON e, VG.Vector v e) => FromJSON (Dense v sh e) where + parseJSON = withObject "Dense" $ \o -> Dense + <$> o .: "limit" + <*> (VG.fromList <$> o .: "vector") + +-- Hashable instance for Dense +instance (Hashable (LimitType sh), Hashable e, VG.Vector v e, Eq (v e)) => Hashable (Dense v sh e) where + hashWithSalt salt (Dense limit v) = salt `hashWithSalt` limit `hashWithSalt` VG.toList v + +-- NFData instance for Dense +instance (NFData (LimitType sh), NFData e, VG.Vector v e) => NFData (Dense v sh e) where + rnf (Dense limit v) = rnf limit `seq` VG.foldl' (\_ x -> rnf x) () v diff --git a/Data/PrimitiveArray/Index/BitSet0.hs b/Data/PrimitiveArray/Index/BitSet0.hs index e287694..0e3642d 100644 --- a/Data/PrimitiveArray/Index/BitSet0.hs +++ b/Data/PrimitiveArray/Index/BitSet0.hs @@ -76,6 +76,18 @@ instance Index (BitSet t) where showBound (LtBitSet b) = ["LtBitSet " ++ show b] showIndex (BitSet b) = ["BitSet " ++ show b] +deriving instance Show (LimitType (BitSet t)) +deriving instance Read (LimitType (BitSet t)) +deriving instance Eq (LimitType (BitSet t)) +deriving instance Generic (LimitType (BitSet t)) +instance Binary (LimitType (BitSet t)) +instance Serialize (LimitType (BitSet t)) +instance ToJSON (LimitType (BitSet t)) +instance ToJSONKey (LimitType (BitSet t)) +instance FromJSON (LimitType (BitSet t)) +instance FromJSONKey (LimitType (BitSet t)) +instance Hashable (LimitType (BitSet t)) + instance SetPredSucc (BitSet t) where setSucc l h s | cs > ch = Nothing diff --git a/Data/PrimitiveArray/Index/BitSet1.hs b/Data/PrimitiveArray/Index/BitSet1.hs index 2fee68c..bc9cd3d 100644 --- a/Data/PrimitiveArray/Index/BitSet1.hs +++ b/Data/PrimitiveArray/Index/BitSet1.hs @@ -81,7 +81,10 @@ instance Index (BitSet1 bnd ioc) where showBound = error "implement me" showIndex = error "implement me" -deriving instance Show (LimitType (BitSet1 bnd ioc)) +deriving instance Show (LimitType (BitSet1 bnd ioc)) +deriving instance Read (LimitType (BitSet1 bnd ioc)) +deriving instance Eq (LimitType (BitSet1 bnd ioc)) +deriving instance Generic (LimitType (BitSet1 bnd ioc)) instance IndexStream z ⇒ IndexStream (z:.BitSet1 i I) where streamUp (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamUpMk l h) (streamUpStep l h) $ streamUp ls hs diff --git a/Data/PrimitiveArray/Index/BitSetClasses.hs b/Data/PrimitiveArray/Index/BitSetClasses.hs index 5a1cd74..e017668 100644 --- a/Data/PrimitiveArray/Index/BitSetClasses.hs +++ b/Data/PrimitiveArray/Index/BitSetClasses.hs @@ -76,6 +76,16 @@ instance Index (Boundary i t) where showBound (LtBoundary b) = ["LtBoundary " ++ show b] showIndex (Boundary b) = ["Boundary " ++ show b] +deriving instance Eq (LimitType (Boundary i t)) +deriving instance Generic (LimitType (Boundary i t)) +deriving instance Read (LimitType (Boundary i t)) +deriving instance Show (LimitType (Boundary i t)) +instance Binary (LimitType (Boundary i t)) +instance Serialize (LimitType (Boundary i t)) +instance ToJSON (LimitType (Boundary i t)) +instance FromJSON (LimitType (Boundary i t)) +instance Hashable (LimitType (Boundary i t)) + instance IndexStream z ⇒ IndexStream (z:.Boundary k I) where streamUp (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamUpBndMk l h) (streamUpBndStep l h) $ streamUp ls hs streamDown (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamDownBndMk l h) (streamDownBndStep l h) $ streamDown ls hs diff --git a/Data/PrimitiveArray/Index/Class.hs b/Data/PrimitiveArray/Index/Class.hs index 847c988..977156e 100644 --- a/Data/PrimitiveArray/Index/Class.hs +++ b/Data/PrimitiveArray/Index/Class.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE InstanceSigs #-} module Data.PrimitiveArray.Index.Class where @@ -16,7 +17,7 @@ import Data.Typeable import Data.Vector.Fusion.Stream.Monadic (Stream) import Data.Vector.Unboxed.Deriving import Data.Vector.Unboxed (Unbox(..)) -import GHC.Base (quotRemInt) +import GHC.Base (quotRemInt, when) import GHC.Generics import GHC.TypeNats import qualified Data.Vector.Fusion.Stream.Monadic as SM @@ -24,8 +25,6 @@ import Test.QuickCheck import Text.Printf import Data.Type.Equality - - infixl 3 :. -- | Strict pairs -- as in @repa@. @@ -233,6 +232,15 @@ deriving instance Show (LimitType Z) deriving instance Data (LimitType Z) deriving instance Typeable (LimitType Z) deriving instance Bounded (LimitType Z) +instance Binary (LimitType Z) +instance Serialize (LimitType Z) +instance ToJSON (LimitType Z) +instance FromJSON (LimitType Z) +instance Hashable (LimitType Z) +instance NFData (LimitType Z) where + rnf ZZ = () + {-# Inline rnf #-} + instance (Index zs, Index z) => Index (zs:.z) where data LimitType (zs:.z) = !(LimitType zs) :.. !(LimitType z) @@ -266,6 +274,11 @@ deriving instance , Data z , Data (LimitType z) , Typeable z ) => Data (LimitType (zs:.z)) deriving instance (Bounded (LimitType zs), Bounded (LimitType z)) => Bounded (LimitType (zs:.z)) +instance (Generic (LimitType zs), Generic (LimitType z), Binary (LimitType zs), Binary (LimitType z)) => Binary (LimitType (zs:.z)) +instance (Generic (LimitType zs), Generic (LimitType z), Serialize (LimitType zs), Serialize (LimitType z)) => Serialize (LimitType (zs:.z)) +instance (Generic (LimitType zs), Generic (LimitType z), ToJSON (LimitType zs), ToJSON (LimitType z)) => ToJSON (LimitType (zs:.z)) +instance (Generic (LimitType zs), Generic (LimitType z), FromJSON (LimitType zs), FromJSON (LimitType z)) => FromJSON (LimitType (zs:.z)) +instance (Generic (LimitType zs), Generic (LimitType z), Hashable (LimitType zs), Hashable (LimitType z)) => Hashable (LimitType (zs:.z)) --instance (Index zs, Index z) => Index (zs:>z) where -- type LimitType (zs:>z) = LimitType zs:>LimitType z @@ -342,3 +355,8 @@ instance (SparseBucket i, SparseBucket is) => SparseBucket (is:.i) where {-# Inline manhattanMax #-} manhattanMax (zz:..z) = manhattanMax zz + manhattanMax z + +-- Catch-all serialization and deep evaluation instances for LimitType. +instance (NFData z, Generic (LimitType z)) => NFData (LimitType z) where + rnf = rnf + {-# Inline rnf #-} diff --git a/Data/PrimitiveArray/Index/Int.hs b/Data/PrimitiveArray/Index/Int.hs index ebd7b3d..e8b3bf7 100644 --- a/Data/PrimitiveArray/Index/Int.hs +++ b/Data/PrimitiveArray/Index/Int.hs @@ -4,6 +4,13 @@ module Data.PrimitiveArray.Index.Int where import qualified Data.Vector.Fusion.Stream.Monadic as SM import Data.PrimitiveArray.Index.Class +import Data.Aeson +import Data.Binary +import Data.Data +import Data.Hashable (Hashable) +import Data.Proxy +import Data.Serialize +import GHC.Generics @@ -27,6 +34,13 @@ instance Index Int where showIndex i = ["Int " ++ show i] deriving instance Show (LimitType Int) +deriving instance Generic (LimitType Int) +deriving instance Eq (LimitType Int) +instance Binary (LimitType Int) +instance Serialize (LimitType Int) +instance ToJSON (LimitType Int) +instance FromJSON (LimitType Int) +instance Hashable (LimitType Int) instance IndexStream z => IndexStream (z:.Int) where streamUp (ls:.. LtInt l) (hs:.. LtInt h) = SM.flatten mk step $ streamUp ls hs diff --git a/Data/PrimitiveArray/Index/PhantomInt.hs b/Data/PrimitiveArray/Index/PhantomInt.hs index 7c3f08a..5a87b4a 100644 --- a/Data/PrimitiveArray/Index/PhantomInt.hs +++ b/Data/PrimitiveArray/Index/PhantomInt.hs @@ -72,6 +72,11 @@ deriving instance Show (LimitType (PInt t p)) deriving instance Read (LimitType (PInt t p)) deriving instance Eq (LimitType (PInt t p)) deriving instance Generic (LimitType (PInt t p)) +instance Binary (LimitType (PInt t p)) +instance Serialize (LimitType (PInt t p)) +instance ToJSON (LimitType (PInt t p)) +instance FromJSON (LimitType (PInt t p)) +instance Hashable (LimitType (PInt t p)) instance IndexStream z => IndexStream (z:.PInt I p) where streamUp (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamUpMk l h) (streamUpStep l h) $ streamUp ls hs diff --git a/Data/PrimitiveArray/Index/Point.hs b/Data/PrimitiveArray/Index/Point.hs index 9000f38..6bab893 100644 --- a/Data/PrimitiveArray/Index/Point.hs +++ b/Data/PrimitiveArray/Index/Point.hs @@ -90,6 +90,12 @@ deriving instance Eq (LimitType (PointL t)) deriving instance Generic (LimitType (PointL t)) deriving instance Read (LimitType (PointL t)) deriving instance Show (LimitType (PointL t)) +instance Binary (LimitType (PointL t)) +instance Serialize (LimitType (PointL t)) +instance ToJSON (LimitType (PointL t)) +instance FromJSON (LimitType (PointL t)) +instance Hashable (LimitType (PointL t)) + instance IndexStream z => IndexStream (z:.PointL I) where streamUp (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamUpMk lf) (streamUpStep PointL ht) $ streamUp ls hs diff --git a/Data/PrimitiveArray/Index/Subword.hs b/Data/PrimitiveArray/Index/Subword.hs index 14cdd13..5c4b74e 100644 --- a/Data/PrimitiveArray/Index/Subword.hs +++ b/Data/PrimitiveArray/Index/Subword.hs @@ -103,6 +103,11 @@ deriving instance Eq (LimitType (Subword t)) deriving instance Generic (LimitType (Subword t)) deriving instance Read (LimitType (Subword t)) deriving instance Show (LimitType (Subword t)) +instance Binary (LimitType (Subword t)) +instance Serialize (LimitType (Subword t)) +instance ToJSON (LimitType (Subword t)) +instance FromJSON (LimitType (Subword t)) +instance Hashable (LimitType (Subword t)) -- | @Subword I@ (inside)