{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -- We need this for Interleave {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Binary.Tagged -- Copyright : (C) 2015 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- -- Structurally tag binary serialisation stream. -- -- Say you have: -- -- > data Record = Record -- > { _recordFields :: HM.HashMap Text (Integer, ByteString) -- > , _recordEnabled :: Bool -- > } -- > deriving (Eq, Show, Generic) -- > -- > instance Binary Record -- > instance HasStructuralInfo Record -- > instance HasSemanticVersion Record -- -- then you can serialise and deserialise @Record@ values with a structure tag by simply -- -- > encodeTaggedFile "cachefile" record -- > decodeTaggedFile "cachefile" :: IO Record -- -- If structure of @Record@ changes in between, deserialisation will fail early. module Data.Binary.Tagged ( -- * Data BinaryTagged(..), BinaryTagged', binaryTag, binaryTag', binaryUntag, binaryUntag', StructuralInfo(..), -- * Serialisation taggedEncode, taggedDecode, taggedDecodeOrFail, -- * IO functions for serialisation taggedEncodeFile, taggedDecodeFile, taggedDecodeFileOrFail, -- * Class HasStructuralInfo(..), HasSemanticVersion(..), Version, -- ** Type level calculations Interleave, SumUpTo, Div2, -- * Generic derivation -- ** GHC ghcStructuralInfo, ghcNominalType, ghcStructuralInfo1, -- ** SOP sopStructuralInfo, sopNominalType, sopStructuralInfo1, -- ** SOP direct sopStructuralInfoS, sopNominalTypeS, sopStructuralInfo1S, -- * Hash structuralInfoSha1Digest, structuralInfoSha1ByteStringDigest, ) where import Control.Applicative import Control.Monad import qualified Crypto.Hash.SHA1 as SHA1 import Data.Binary import Data.Binary.Get (ByteOffset) import Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 import Data.ByteString.Lazy as LBS import Data.Monoid ((<>)) import Data.Typeable (Typeable) import Generics.SOP as SOP import Generics.SOP.Constraint as SOP import Generics.SOP.GGP as SOP #if !MIN_VERSION_base(4,8,0) import Data.Foldable (Foldable) import Data.Traversable (Traversable) #endif import qualified GHC.Generics as GHC import GHC.TypeLits -- Instances import qualified Data.Array.IArray as Array import qualified Data.Array.Unboxed as Array import qualified Data.Fixed as Fixed import qualified Data.HashMap.Lazy as HML import qualified Data.HashSet as HS import Data.Int import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Monoid as Monoid import qualified Data.Ratio as Ratio import qualified Data.Semigroup as Semigroup import qualified Data.Sequence as Seq import qualified Data.Set as Set import qualified Data.Text as S import qualified Data.Text.Lazy as L import qualified Data.Time as Time import qualified Data.Vector as V import qualified Data.Vector.Storable as S import qualified Data.Vector.Unboxed as U import qualified Data.Version as Version import qualified Numeric.Natural as Natural #ifdef MIN_VERSION_aeson import qualified Data.Aeson as Aeson #endif -- | 'Binary' serialisable class, which tries to be less error-prone to data structure changes. -- -- Values are serialised with header consisting of version @v@ and hash of 'structuralInfo'. newtype BinaryTagged (v :: k) a = BinaryTagged { unBinaryTagged :: a } deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable, GHC.Generic, GHC.Generic1, Typeable) -- TODO: Derive Enum, Bounded, Typeable, Data, Hashable, NFData, Numeric classes? type BinaryTagged' a = BinaryTagged (SemanticVersion a) a binaryTag :: Proxy v -> a -> BinaryTagged v a binaryTag _ = BinaryTagged binaryTag' :: HasSemanticVersion a => a -> BinaryTagged' a binaryTag' = BinaryTagged binaryUntag :: Proxy v -> BinaryTagged v a -> a binaryUntag _ = unBinaryTagged binaryUntag' :: HasSemanticVersion a => BinaryTagged' a -> a binaryUntag' = unBinaryTagged -- | Tagged version of 'encode' taggedEncode :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => a -> LBS.ByteString taggedEncode = encode . binaryTag (Proxy :: Proxy (SemanticVersion a)) -- | Tagged version of 'decode' taggedDecode :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => LBS.ByteString -> a taggedDecode = binaryUntag (Proxy :: Proxy (SemanticVersion a)) . decode -- | Tagged version of 'decodeOrFail' taggedDecodeOrFail :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => LBS.ByteString -> Either (LBS.ByteString, ByteOffset, String) (LBS.ByteString, ByteOffset, a) taggedDecodeOrFail = fmap3 (binaryUntag (Proxy :: Proxy (SemanticVersion a))) . decodeOrFail where fmap3 f = fmap (\(a, b, c) -> (a, b, f c)) -- | Tagged version of 'encodeFile' taggedEncodeFile :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> a -> IO () taggedEncodeFile filepath = encodeFile filepath . binaryTag (Proxy :: Proxy (SemanticVersion a)) -- | Tagged version of 'decodeFile' taggedDecodeFile :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> IO a taggedDecodeFile = fmap (binaryUntag (Proxy :: Proxy (SemanticVersion a))) . decodeFile -- | Tagged version of 'decodeFileOrFail' taggedDecodeFileOrFail :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> IO (Either (ByteOffset, String) a) taggedDecodeFileOrFail = (fmap . fmap) (binaryUntag (Proxy :: Proxy (SemanticVersion a))) . decodeFileOrFail instance Applicative (BinaryTagged v) where pure = return (<*>) = ap instance Monad (BinaryTagged v) where return = BinaryTagged BinaryTagged m >>= k = k m instance Semigroup.Semigroup a => Semigroup.Semigroup (BinaryTagged v a) where (<>) = liftA2 (Semigroup.<>) instance Monoid.Monoid a => Monoid.Monoid (BinaryTagged v a) where mempty = pure Monoid.mempty mappend = liftA2 Monoid.mappend -- | Type the semantic version is serialised with. type Version = Word32 -- | Version and structure hash are prepended to serialised stream instance (Binary a, HasStructuralInfo a, KnownNat v) => Binary (BinaryTagged v a) where put (BinaryTagged x) = put ver' >> put hash' >> put x where proxyV = Proxy :: Proxy v proxyA = Proxy :: Proxy a ver' = fromIntegral (natVal proxyV) :: Version hash' = structuralInfoSha1ByteStringDigest . structuralInfo $ proxyA get = do ver <- get if ver == ver' then do hash <- get if hash == hash' then fmap BinaryTagged get else fail $ "Non matching structure hashes: got" <> show (Base16.encode hash) <> "; expected: " <> show (Base16.encode hash') else fail $ "Non matching versions: got " <> show ver <> "; expected: " <> show ver' where proxyV = Proxy :: Proxy v proxyA = Proxy :: Proxy a ver' = fromIntegral (natVal proxyV) :: Version hash' = structuralInfoSha1Digest . structuralInfo $ proxyA -- | Data type structure, with (some) nominal information. data StructuralInfo = NominalType String | NominalNewtype String StructuralInfo | StructuralInfo String [[StructuralInfo]] deriving (Eq, Ord, Show, GHC.Generic, Typeable) instance Binary StructuralInfo -- | Type class providing `StructuralInfo` for each data type. -- -- For regular non-recursive ADTs 'HasStructuralInfo' can be derived generically. -- -- > data Record = Record { a :: Int, b :: Bool, c :: [Char] } deriving (Generic) -- > instance hasStructuralInfo Record -- -- For stable types, you can provide only type name -- -- > instance HasStructuralInfo Int where structuralInfo = ghcNominalType -- infer name from Generic information -- > instance HasStructuralInfo Integer where structuralInfo _ = NominalType "Integer" -- -- Recursive type story is a bit sad atm. If the type structure is stable, you can do: -- -- > instance HasStructuralInfo a => HasStructuralInfo [a] where structuralInfo = ghcStructuralInfo1 class HasStructuralInfo a where structuralInfo :: Proxy a -> StructuralInfo default structuralInfo :: ( GHC.Generic a , All2 HasStructuralInfo (GCode a) , GDatatypeInfo a , SListI2 (GCode a) ) => Proxy a -> StructuralInfo structuralInfo = ghcStructuralInfo -- | A helper type family for 'encodeTaggedFile' and 'decodeTaggedFile'. -- -- The default definition is @'SemanticVersion' a = 0@ class KnownNat (SemanticVersion a) => HasSemanticVersion (a :: *) where type SemanticVersion a :: Nat type SemanticVersion a = 0 instance HasStructuralInfo StructuralInfo instance HasSemanticVersion StructuralInfo structuralInfoSha1Digest :: StructuralInfo -> BS.ByteString structuralInfoSha1Digest = SHA1.hashlazy . encode {-# DEPRECATED structuralInfoSha1ByteStringDigest "Use structuralInfoSha1Digest directly" #-} structuralInfoSha1ByteStringDigest :: StructuralInfo -> BS.ByteString structuralInfoSha1ByteStringDigest = structuralInfoSha1Digest ------------------------------------------------------------------------------- -- Generics ------------------------------------------------------------------------------- ghcStructuralInfo :: ( GHC.Generic a , All2 HasStructuralInfo (GCode a) , GDatatypeInfo a , SListI2 (GCode a) ) => Proxy a -> StructuralInfo ghcStructuralInfo proxy = sopStructuralInfoS (gdatatypeInfo proxy) ghcNominalType :: (GHC.Generic a, GDatatypeInfo a) => Proxy a -> StructuralInfo ghcNominalType proxy = sopNominalTypeS (gdatatypeInfo proxy) ghcStructuralInfo1 :: forall f a. (GHC.Generic1 f, GDatatypeInfo (f a), HasStructuralInfo a) => Proxy (f a) -> StructuralInfo ghcStructuralInfo1 proxy = sopStructuralInfo1S (structuralInfo (Proxy :: Proxy a)) (gdatatypeInfo proxy) -- SOP derivation sopStructuralInfo :: forall a. (Generic a, HasDatatypeInfo a, All2 HasStructuralInfo (Code a)) => Proxy a -> StructuralInfo sopStructuralInfo proxy = sopStructuralInfoS (datatypeInfo proxy) sopStructuralInfoS :: forall xss. ( All2 HasStructuralInfo xss , SListI2 xss ) => DatatypeInfo xss -> StructuralInfo sopStructuralInfoS di@(Newtype _ _ ci) = NominalNewtype (datatypeName di) (sopNominalNewtype ci) sopStructuralInfoS di@ADT {} = StructuralInfo (datatypeName di) (sopNominalAdtPOP (hpure Proxy :: POP Proxy xss)) sopNominalNewtype :: forall x. HasStructuralInfo x => ConstructorInfo '[x] -> StructuralInfo sopNominalNewtype _ = structuralInfo (Proxy :: Proxy x) sopNominalAdtPOP :: (All2 HasStructuralInfo xss) => POP Proxy xss -> [[StructuralInfo]] sopNominalAdtPOP (POP np2) = sopNominalAdt np2 sopNominalAdt :: (All2 HasStructuralInfo xss) => NP (NP Proxy) xss -> [[StructuralInfo]] sopNominalAdt Nil = [] sopNominalAdt (p :* ps) = sopStructuralInfoP p : sopNominalAdt ps sopStructuralInfoP :: (All HasStructuralInfo xs) => NP Proxy xs -> [StructuralInfo] sopStructuralInfoP Nil = [] sopStructuralInfoP (proxy :* rest) = structuralInfo proxy : sopStructuralInfoP rest sopNominalType :: forall a. (Generic a, HasDatatypeInfo a) => Proxy a -> StructuralInfo sopNominalType proxy = sopNominalTypeS (datatypeInfo proxy) sopNominalTypeS :: DatatypeInfo xss -> StructuralInfo sopNominalTypeS di = NominalType (datatypeName di) sopStructuralInfo1 :: forall f a. (Generic (f a), HasDatatypeInfo (f a), HasStructuralInfo a) => Proxy (f a) -> StructuralInfo sopStructuralInfo1 proxy = sopStructuralInfo1S (structuralInfo (Proxy :: Proxy a)) (datatypeInfo proxy) sopStructuralInfo1S :: StructuralInfo -> DatatypeInfo xss -> StructuralInfo sopStructuralInfo1S nsop di = NominalNewtype (datatypeName di) nsop ------------------------------------------------------------------------------- -- SOP helpers ------------------------------------------------------------------------------- -- | Interleaving -- -- > 3 | 9 . . . . -- > 2 | 5 8 . . . -- > 1 | 2 4 7 11 . -- > 0 | 0 1 3 6 10 -- > ----------------- -- > 0 1 2 3 4 -- -- This can be calculated by @f x y = sum ([0..x+y]) + y@ type Interleave (n :: Nat) (m :: Nat) = SumUpTo (n + m) + m type SumUpTo (n :: Nat) = Div2 (n GHC.TypeLits.* (n + 1)) type family Div2 (n :: Nat) :: Nat where Div2 0 = 0 Div2 1 = 0 Div2 n = 1 + Div2 (n - 2) ------------------------------------------------------------------------------- -- Instances ------------------------------------------------------------------------------- instance HasStructuralInfo Bool where structuralInfo = ghcNominalType instance HasStructuralInfo Char where structuralInfo _ = NominalType "Char" instance HasStructuralInfo Int where structuralInfo _ = NominalType "Int" instance HasStructuralInfo Word where structuralInfo _ = NominalType "Word" instance HasStructuralInfo Integer where structuralInfo _ = NominalType "Integer" instance HasStructuralInfo Int8 where structuralInfo _ = NominalType "Int8" instance HasStructuralInfo Int16 where structuralInfo _ = NominalType "Int16" instance HasStructuralInfo Int32 where structuralInfo _ = NominalType "Int32" instance HasStructuralInfo Int64 where structuralInfo _ = NominalType "Int64" instance HasStructuralInfo Word8 where structuralInfo _ = NominalType "Word8" instance HasStructuralInfo Word16 where structuralInfo _ = NominalType "Word16" instance HasStructuralInfo Word32 where structuralInfo _ = NominalType "Word32" instance HasStructuralInfo Word64 where structuralInfo _ = NominalType "Word64" instance HasSemanticVersion Bool instance HasSemanticVersion Char instance HasSemanticVersion Int instance HasSemanticVersion Word instance HasSemanticVersion Integer instance HasSemanticVersion Int8 instance HasSemanticVersion Int16 instance HasSemanticVersion Int32 instance HasSemanticVersion Int64 instance HasSemanticVersion Word8 instance HasSemanticVersion Word16 instance HasSemanticVersion Word32 instance HasSemanticVersion Word64 -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo Ordering where structuralInfo = ghcNominalType -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion Ordering -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo Float where structuralInfo _ = NominalType "Float" -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo Double where structuralInfo _ = NominalType "Double" -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion Float -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion Double ------------------------------------------------------------------------------- -- Recursive types: List, NonEmpty ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo [a] where structuralInfo = ghcStructuralInfo1 instance HasSemanticVersion a => HasSemanticVersion [a] where type SemanticVersion [a] = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (NE.NonEmpty a) where structuralInfo = ghcStructuralInfo1 instance HasSemanticVersion a => HasSemanticVersion (NE.NonEmpty a) where type SemanticVersion (NE.NonEmpty a) = SemanticVersion a ------------------------------------------------------------------------------- -- Basic types ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo (Maybe a) instance HasSemanticVersion a => HasSemanticVersion (Maybe a) where type SemanticVersion (Maybe a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (Ratio.Ratio a) where structuralInfo _ = NominalNewtype "Ratio" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (Ratio.Ratio a) where type SemanticVersion (Ratio.Ratio a) = SemanticVersion a instance (HasStructuralInfo a, HasStructuralInfo b) => HasStructuralInfo (Either a b) instance (HasSemanticVersion a, HasSemanticVersion b, KnownNat (SemanticVersion (Either a b))) => HasSemanticVersion (Either a b) where type SemanticVersion (Either a b) = Interleave (SemanticVersion a) (SemanticVersion b) ------------------------------------------------------------------------------- -- tuples ------------------------------------------------------------------------------- instance (HasStructuralInfo a, HasStructuralInfo b) => HasStructuralInfo (a, b) instance (HasStructuralInfo a, HasStructuralInfo b, HasStructuralInfo c) => HasStructuralInfo (a, b, c) instance (HasStructuralInfo a, HasStructuralInfo b, HasStructuralInfo c, HasStructuralInfo d) => HasStructuralInfo (a, b, c, d) instance (HasSemanticVersion a ,HasSemanticVersion b ,KnownNat (SemanticVersion (a, b))) => HasSemanticVersion (a, b) where type SemanticVersion (a, b) = Interleave (SemanticVersion a) (SemanticVersion b) -- | /Since binary-tagged-0.1.3.0/ instance (HasSemanticVersion a ,HasSemanticVersion b ,HasSemanticVersion c ,KnownNat (SemanticVersion (a, b, c))) => HasSemanticVersion (a, b, c) where type SemanticVersion (a, b, c) = Interleave (SemanticVersion a) (SemanticVersion (b, c)) -- | /Since binary-tagged-0.1.3.0/ instance (HasSemanticVersion a ,HasSemanticVersion b ,HasSemanticVersion c ,HasSemanticVersion d ,KnownNat (SemanticVersion (a, b, c, d))) => HasSemanticVersion (a, b, c, d) where type SemanticVersion (a, b, c, d) = Interleave (SemanticVersion a) (SemanticVersion (b, c, d)) ------------------------------------------------------------------------------- -- Unit ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo () where structuralInfo _ = NominalType "()" -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion () ------------------------------------------------------------------------------- -- Data.Fixed ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo a => HasStructuralInfo (Fixed.Fixed a) where structuralInfo _ = StructuralInfo "Fixed" [[ structuralInfo (Proxy :: Proxy a) ]] instance HasStructuralInfo Fixed.E0 where structuralInfo _ = NominalType "E0" instance HasStructuralInfo Fixed.E1 where structuralInfo _ = NominalType "E1" instance HasStructuralInfo Fixed.E2 where structuralInfo _ = NominalType "E2" instance HasStructuralInfo Fixed.E3 where structuralInfo _ = NominalType "E3" instance HasStructuralInfo Fixed.E6 where structuralInfo _ = NominalType "E6" instance HasStructuralInfo Fixed.E9 where structuralInfo _ = NominalType "E9" instance HasStructuralInfo Fixed.E12 where structuralInfo _ = NominalType "E12" -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion (Fixed.Fixed a) ------------------------------------------------------------------------------- -- Data.Version ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo Version.Version where structuralInfo _ = StructuralInfo "Version" [[ structuralInfo (Proxy :: Proxy [Int]) , structuralInfo (Proxy :: Proxy [String]) ]] -- Version has no Generic instance :( -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion Version.Version ------------------------------------------------------------------------------- -- Data.Monoid ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo (Monoid.Sum a) instance HasSemanticVersion a => HasSemanticVersion (Monoid.Sum a) where type SemanticVersion (Monoid.Sum a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (Monoid.Product a) instance HasSemanticVersion a => HasSemanticVersion (Monoid.Product a) where type SemanticVersion (Monoid.Product a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Monoid.Dual a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Monoid.Dual a) where type SemanticVersion (Monoid.Dual a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Monoid.First a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Monoid.First a) where type SemanticVersion (Monoid.First a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Monoid.Last a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Monoid.Last a) where type SemanticVersion (Monoid.Last a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo Monoid.All -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion Monoid.All -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo Monoid.Any -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion Monoid.Any ------------------------------------------------------------------------------- -- semigroups ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.Min a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.Min a) where type SemanticVersion (Semigroup.Min a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.Max a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.Max a) where type SemanticVersion (Semigroup.Max a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.First a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.First a) where type SemanticVersion (Semigroup.First a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.Last a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.Last a) where type SemanticVersion (Semigroup.Last a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.WrappedMonoid a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.WrappedMonoid a) where type SemanticVersion (Semigroup.WrappedMonoid a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.Option a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.Option a) where type SemanticVersion (Semigroup.Option a) = SemanticVersion a ------------------------------------------------------------------------------- -- bytestring ------------------------------------------------------------------------------- instance HasStructuralInfo BS.ByteString where structuralInfo _ = NominalType "ByteString.Strict" instance HasStructuralInfo LBS.ByteString where structuralInfo _ = NominalType "ByteString.Lazy" instance HasSemanticVersion BS.ByteString instance HasSemanticVersion LBS.ByteString ------------------------------------------------------------------------------- -- nats ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo Natural.Natural where structuralInfo _ = NominalType "Numeric.Natural" -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion Natural.Natural ------------------------------------------------------------------------------- -- text ------------------------------------------------------------------------------- instance HasStructuralInfo S.Text where structuralInfo _ = NominalType "Text.Strict" instance HasStructuralInfo L.Text where structuralInfo _ = NominalType "Text.Lazy" instance HasSemanticVersion S.Text instance HasSemanticVersion L.Text ------------------------------------------------------------------------------- -- containers ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo (IntMap.IntMap a) where structuralInfo _ = NominalNewtype "IntMap" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (IntMap.IntMap a) where type SemanticVersion (IntMap.IntMap a) = SemanticVersion a instance HasStructuralInfo IntSet.IntSet where structuralInfo _ = NominalType "IntSet" instance HasSemanticVersion IntSet.IntSet instance (HasStructuralInfo k, HasStructuralInfo v) => HasStructuralInfo (Map.Map k v) where structuralInfo _ = StructuralInfo "Map" [[ structuralInfo (Proxy :: Proxy k), structuralInfo (Proxy :: Proxy v) ]] instance (HasSemanticVersion k, HasSemanticVersion v, KnownNat (SemanticVersion (Map.Map k v))) => HasSemanticVersion (Map.Map k v) where type SemanticVersion (Map.Map k v) = Interleave (SemanticVersion k) (SemanticVersion v) instance HasStructuralInfo a => HasStructuralInfo (Seq.Seq a) where structuralInfo _ = NominalNewtype "Seq" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (Seq.Seq a) where type SemanticVersion (Seq.Seq a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (Set.Set a) where structuralInfo _ = NominalNewtype "Set" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (Set.Set a) where type SemanticVersion (Set.Set a) = SemanticVersion a ------------------------------------------------------------------------------- -- unordered-containers ------------------------------------------------------------------------------- instance (HasStructuralInfo k, HasStructuralInfo v) => HasStructuralInfo (HML.HashMap k v) where structuralInfo _ = StructuralInfo "HashMap" [[ structuralInfo (Proxy :: Proxy k), structuralInfo (Proxy :: Proxy v) ]] instance (HasSemanticVersion k, HasSemanticVersion v, KnownNat (SemanticVersion (HML.HashMap k v))) => HasSemanticVersion (HML.HashMap k v) where type SemanticVersion (HML.HashMap k v) = Interleave (SemanticVersion k) (SemanticVersion v) instance HasStructuralInfo a => HasStructuralInfo (HS.HashSet a) where structuralInfo _ = NominalNewtype "HashSet" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (HS.HashSet a) where type SemanticVersion (HS.HashSet a) = SemanticVersion a ------------------------------------------------------------------------------- -- array ------------------------------------------------------------------------------- instance (HasStructuralInfo i, HasStructuralInfo e) => HasStructuralInfo (Array.Array i e) where structuralInfo _ = StructuralInfo "Array" [[ structuralInfo (Proxy :: Proxy i), structuralInfo (Proxy :: Proxy e) ]] instance (HasSemanticVersion i, HasSemanticVersion e, KnownNat (SemanticVersion (Array.Array i e))) => HasSemanticVersion (Array.Array i e) where type SemanticVersion (Array.Array i e) = Interleave (SemanticVersion i) (SemanticVersion e) instance (HasStructuralInfo i, HasStructuralInfo e) => HasStructuralInfo (Array.UArray i e) where structuralInfo _ = StructuralInfo "UArray" [[ structuralInfo (Proxy :: Proxy i), structuralInfo (Proxy :: Proxy e) ]] instance (HasSemanticVersion i, HasSemanticVersion e, KnownNat (SemanticVersion (Array.UArray i e))) => HasSemanticVersion (Array.UArray i e) where type SemanticVersion (Array.UArray i e) = Interleave (SemanticVersion i) (SemanticVersion e) ------------------------------------------------------------------------------- -- vector ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo (V.Vector a) where structuralInfo _ = NominalNewtype "Vector" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (V.Vector a) where type SemanticVersion (V.Vector a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (U.Vector a) where structuralInfo _ = NominalNewtype "Vector.Unboxed" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (U.Vector a) where type SemanticVersion (U.Vector a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (S.Vector a) where structuralInfo _ = NominalNewtype "Vector.Storable" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (S.Vector a) where type SemanticVersion (S.Vector a) = SemanticVersion a ------------------------------------------------------------------------------- -- time ------------------------------------------------------------------------------- instance HasStructuralInfo Time.UTCTime where structuralInfo _ = NominalType "UTCTime" instance HasStructuralInfo Time.DiffTime where structuralInfo _ = NominalType "DiffTime" instance HasStructuralInfo Time.UniversalTime where structuralInfo _ = NominalType "UniversalTime" instance HasStructuralInfo Time.NominalDiffTime where structuralInfo _ = NominalType "NominalDiffTime" instance HasStructuralInfo Time.Day where structuralInfo _ = NominalType "Day" instance HasStructuralInfo Time.TimeZone where structuralInfo _ = NominalType "TimeZone" instance HasStructuralInfo Time.TimeOfDay where structuralInfo _ = NominalType "TimeOfDay" instance HasStructuralInfo Time.LocalTime where structuralInfo _ = NominalType "LocalTime" instance HasSemanticVersion Time.UTCTime instance HasSemanticVersion Time.DiffTime instance HasSemanticVersion Time.UniversalTime instance HasSemanticVersion Time.NominalDiffTime instance HasSemanticVersion Time.Day instance HasSemanticVersion Time.TimeZone instance HasSemanticVersion Time.TimeOfDay instance HasSemanticVersion Time.LocalTime ------------------------------------------------------------------------------- -- aeson ------------------------------------------------------------------------------- #ifdef MIN_VERSION_aeson -- TODO: derive sop instance HasStructuralInfo Aeson.Value where structuralInfo _ = NominalType "Aeson.Value" instance HasSemanticVersion Aeson.Value #endif