{-# 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 <oleg.grenrus@iki.fi>
--
-- 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 { BinaryTagged v a -> a
unBinaryTagged :: a }
  deriving (BinaryTagged v a -> BinaryTagged v a -> Bool
(BinaryTagged v a -> BinaryTagged v a -> Bool)
-> (BinaryTagged v a -> BinaryTagged v a -> Bool)
-> Eq (BinaryTagged v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (v :: k) a.
Eq a =>
BinaryTagged v a -> BinaryTagged v a -> Bool
/= :: BinaryTagged v a -> BinaryTagged v a -> Bool
$c/= :: forall k (v :: k) a.
Eq a =>
BinaryTagged v a -> BinaryTagged v a -> Bool
== :: BinaryTagged v a -> BinaryTagged v a -> Bool
$c== :: forall k (v :: k) a.
Eq a =>
BinaryTagged v a -> BinaryTagged v a -> Bool
Eq, Eq (BinaryTagged v a)
Eq (BinaryTagged v a) =>
(BinaryTagged v a -> BinaryTagged v a -> Ordering)
-> (BinaryTagged v a -> BinaryTagged v a -> Bool)
-> (BinaryTagged v a -> BinaryTagged v a -> Bool)
-> (BinaryTagged v a -> BinaryTagged v a -> Bool)
-> (BinaryTagged v a -> BinaryTagged v a -> Bool)
-> (BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a)
-> (BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a)
-> Ord (BinaryTagged v a)
BinaryTagged v a -> BinaryTagged v a -> Bool
BinaryTagged v a -> BinaryTagged v a -> Ordering
BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (v :: k) a. Ord a => Eq (BinaryTagged v a)
forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> Bool
forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> Ordering
forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
min :: BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
$cmin :: forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
max :: BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
$cmax :: forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
>= :: BinaryTagged v a -> BinaryTagged v a -> Bool
$c>= :: forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> Bool
> :: BinaryTagged v a -> BinaryTagged v a -> Bool
$c> :: forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> Bool
<= :: BinaryTagged v a -> BinaryTagged v a -> Bool
$c<= :: forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> Bool
< :: BinaryTagged v a -> BinaryTagged v a -> Bool
$c< :: forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> Bool
compare :: BinaryTagged v a -> BinaryTagged v a -> Ordering
$ccompare :: forall k (v :: k) a.
Ord a =>
BinaryTagged v a -> BinaryTagged v a -> Ordering
$cp1Ord :: forall k (v :: k) a. Ord a => Eq (BinaryTagged v a)
Ord, Int -> BinaryTagged v a -> ShowS
[BinaryTagged v a] -> ShowS
BinaryTagged v a -> String
(Int -> BinaryTagged v a -> ShowS)
-> (BinaryTagged v a -> String)
-> ([BinaryTagged v a] -> ShowS)
-> Show (BinaryTagged v a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (v :: k) a. Show a => Int -> BinaryTagged v a -> ShowS
forall k (v :: k) a. Show a => [BinaryTagged v a] -> ShowS
forall k (v :: k) a. Show a => BinaryTagged v a -> String
showList :: [BinaryTagged v a] -> ShowS
$cshowList :: forall k (v :: k) a. Show a => [BinaryTagged v a] -> ShowS
show :: BinaryTagged v a -> String
$cshow :: forall k (v :: k) a. Show a => BinaryTagged v a -> String
showsPrec :: Int -> BinaryTagged v a -> ShowS
$cshowsPrec :: forall k (v :: k) a. Show a => Int -> BinaryTagged v a -> ShowS
Show, ReadPrec [BinaryTagged v a]
ReadPrec (BinaryTagged v a)
Int -> ReadS (BinaryTagged v a)
ReadS [BinaryTagged v a]
(Int -> ReadS (BinaryTagged v a))
-> ReadS [BinaryTagged v a]
-> ReadPrec (BinaryTagged v a)
-> ReadPrec [BinaryTagged v a]
-> Read (BinaryTagged v a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (v :: k) a. Read a => ReadPrec [BinaryTagged v a]
forall k (v :: k) a. Read a => ReadPrec (BinaryTagged v a)
forall k (v :: k) a. Read a => Int -> ReadS (BinaryTagged v a)
forall k (v :: k) a. Read a => ReadS [BinaryTagged v a]
readListPrec :: ReadPrec [BinaryTagged v a]
$creadListPrec :: forall k (v :: k) a. Read a => ReadPrec [BinaryTagged v a]
readPrec :: ReadPrec (BinaryTagged v a)
$creadPrec :: forall k (v :: k) a. Read a => ReadPrec (BinaryTagged v a)
readList :: ReadS [BinaryTagged v a]
$creadList :: forall k (v :: k) a. Read a => ReadS [BinaryTagged v a]
readsPrec :: Int -> ReadS (BinaryTagged v a)
$creadsPrec :: forall k (v :: k) a. Read a => Int -> ReadS (BinaryTagged v a)
Read, a -> BinaryTagged v b -> BinaryTagged v a
(a -> b) -> BinaryTagged v a -> BinaryTagged v b
(forall a b. (a -> b) -> BinaryTagged v a -> BinaryTagged v b)
-> (forall a b. a -> BinaryTagged v b -> BinaryTagged v a)
-> Functor (BinaryTagged v)
forall k (v :: k) a b. a -> BinaryTagged v b -> BinaryTagged v a
forall k (v :: k) a b.
(a -> b) -> BinaryTagged v a -> BinaryTagged v b
forall a b. a -> BinaryTagged v b -> BinaryTagged v a
forall a b. (a -> b) -> BinaryTagged v a -> BinaryTagged v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BinaryTagged v b -> BinaryTagged v a
$c<$ :: forall k (v :: k) a b. a -> BinaryTagged v b -> BinaryTagged v a
fmap :: (a -> b) -> BinaryTagged v a -> BinaryTagged v b
$cfmap :: forall k (v :: k) a b.
(a -> b) -> BinaryTagged v a -> BinaryTagged v b
Functor, BinaryTagged v a -> Bool
(a -> m) -> BinaryTagged v a -> m
(a -> b -> b) -> b -> BinaryTagged v a -> b
(forall m. Monoid m => BinaryTagged v m -> m)
-> (forall m a. Monoid m => (a -> m) -> BinaryTagged v a -> m)
-> (forall m a. Monoid m => (a -> m) -> BinaryTagged v a -> m)
-> (forall a b. (a -> b -> b) -> b -> BinaryTagged v a -> b)
-> (forall a b. (a -> b -> b) -> b -> BinaryTagged v a -> b)
-> (forall b a. (b -> a -> b) -> b -> BinaryTagged v a -> b)
-> (forall b a. (b -> a -> b) -> b -> BinaryTagged v a -> b)
-> (forall a. (a -> a -> a) -> BinaryTagged v a -> a)
-> (forall a. (a -> a -> a) -> BinaryTagged v a -> a)
-> (forall a. BinaryTagged v a -> [a])
-> (forall a. BinaryTagged v a -> Bool)
-> (forall a. BinaryTagged v a -> Int)
-> (forall a. Eq a => a -> BinaryTagged v a -> Bool)
-> (forall a. Ord a => BinaryTagged v a -> a)
-> (forall a. Ord a => BinaryTagged v a -> a)
-> (forall a. Num a => BinaryTagged v a -> a)
-> (forall a. Num a => BinaryTagged v a -> a)
-> Foldable (BinaryTagged v)
forall a. Eq a => a -> BinaryTagged v a -> Bool
forall a. Num a => BinaryTagged v a -> a
forall a. Ord a => BinaryTagged v a -> a
forall m. Monoid m => BinaryTagged v m -> m
forall a. BinaryTagged v a -> Bool
forall a. BinaryTagged v a -> Int
forall a. BinaryTagged v a -> [a]
forall a. (a -> a -> a) -> BinaryTagged v a -> a
forall k (v :: k) a. Eq a => a -> BinaryTagged v a -> Bool
forall k (v :: k) a. Num a => BinaryTagged v a -> a
forall k (v :: k) a. Ord a => BinaryTagged v a -> a
forall k (v :: k) m. Monoid m => BinaryTagged v m -> m
forall k (v :: k) a. BinaryTagged v a -> Bool
forall k (v :: k) a. BinaryTagged v a -> Int
forall k (v :: k) a. BinaryTagged v a -> [a]
forall k (v :: k) a. (a -> a -> a) -> BinaryTagged v a -> a
forall k (v :: k) m a.
Monoid m =>
(a -> m) -> BinaryTagged v a -> m
forall k (v :: k) b a. (b -> a -> b) -> b -> BinaryTagged v a -> b
forall k (v :: k) a b. (a -> b -> b) -> b -> BinaryTagged v a -> b
forall m a. Monoid m => (a -> m) -> BinaryTagged v a -> m
forall b a. (b -> a -> b) -> b -> BinaryTagged v a -> b
forall a b. (a -> b -> b) -> b -> BinaryTagged v a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: BinaryTagged v a -> a
$cproduct :: forall k (v :: k) a. Num a => BinaryTagged v a -> a
sum :: BinaryTagged v a -> a
$csum :: forall k (v :: k) a. Num a => BinaryTagged v a -> a
minimum :: BinaryTagged v a -> a
$cminimum :: forall k (v :: k) a. Ord a => BinaryTagged v a -> a
maximum :: BinaryTagged v a -> a
$cmaximum :: forall k (v :: k) a. Ord a => BinaryTagged v a -> a
elem :: a -> BinaryTagged v a -> Bool
$celem :: forall k (v :: k) a. Eq a => a -> BinaryTagged v a -> Bool
length :: BinaryTagged v a -> Int
$clength :: forall k (v :: k) a. BinaryTagged v a -> Int
null :: BinaryTagged v a -> Bool
$cnull :: forall k (v :: k) a. BinaryTagged v a -> Bool
toList :: BinaryTagged v a -> [a]
$ctoList :: forall k (v :: k) a. BinaryTagged v a -> [a]
foldl1 :: (a -> a -> a) -> BinaryTagged v a -> a
$cfoldl1 :: forall k (v :: k) a. (a -> a -> a) -> BinaryTagged v a -> a
foldr1 :: (a -> a -> a) -> BinaryTagged v a -> a
$cfoldr1 :: forall k (v :: k) a. (a -> a -> a) -> BinaryTagged v a -> a
foldl' :: (b -> a -> b) -> b -> BinaryTagged v a -> b
$cfoldl' :: forall k (v :: k) b a. (b -> a -> b) -> b -> BinaryTagged v a -> b
foldl :: (b -> a -> b) -> b -> BinaryTagged v a -> b
$cfoldl :: forall k (v :: k) b a. (b -> a -> b) -> b -> BinaryTagged v a -> b
foldr' :: (a -> b -> b) -> b -> BinaryTagged v a -> b
$cfoldr' :: forall k (v :: k) a b. (a -> b -> b) -> b -> BinaryTagged v a -> b
foldr :: (a -> b -> b) -> b -> BinaryTagged v a -> b
$cfoldr :: forall k (v :: k) a b. (a -> b -> b) -> b -> BinaryTagged v a -> b
foldMap' :: (a -> m) -> BinaryTagged v a -> m
$cfoldMap' :: forall k (v :: k) m a.
Monoid m =>
(a -> m) -> BinaryTagged v a -> m
foldMap :: (a -> m) -> BinaryTagged v a -> m
$cfoldMap :: forall k (v :: k) m a.
Monoid m =>
(a -> m) -> BinaryTagged v a -> m
fold :: BinaryTagged v m -> m
$cfold :: forall k (v :: k) m. Monoid m => BinaryTagged v m -> m
Foldable, Functor (BinaryTagged v)
Foldable (BinaryTagged v)
(Functor (BinaryTagged v), Foldable (BinaryTagged v)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> BinaryTagged v a -> f (BinaryTagged v b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    BinaryTagged v (f a) -> f (BinaryTagged v a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> BinaryTagged v a -> m (BinaryTagged v b))
-> (forall (m :: * -> *) a.
    Monad m =>
    BinaryTagged v (m a) -> m (BinaryTagged v a))
-> Traversable (BinaryTagged v)
(a -> f b) -> BinaryTagged v a -> f (BinaryTagged v b)
forall k (v :: k). Functor (BinaryTagged v)
forall k (v :: k). Foldable (BinaryTagged v)
forall k (v :: k) (m :: * -> *) a.
Monad m =>
BinaryTagged v (m a) -> m (BinaryTagged v a)
forall k (v :: k) (f :: * -> *) a.
Applicative f =>
BinaryTagged v (f a) -> f (BinaryTagged v a)
forall k (v :: k) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinaryTagged v a -> m (BinaryTagged v b)
forall k (v :: k) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinaryTagged v a -> f (BinaryTagged v b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
BinaryTagged v (m a) -> m (BinaryTagged v a)
forall (f :: * -> *) a.
Applicative f =>
BinaryTagged v (f a) -> f (BinaryTagged v a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinaryTagged v a -> m (BinaryTagged v b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinaryTagged v a -> f (BinaryTagged v b)
sequence :: BinaryTagged v (m a) -> m (BinaryTagged v a)
$csequence :: forall k (v :: k) (m :: * -> *) a.
Monad m =>
BinaryTagged v (m a) -> m (BinaryTagged v a)
mapM :: (a -> m b) -> BinaryTagged v a -> m (BinaryTagged v b)
$cmapM :: forall k (v :: k) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinaryTagged v a -> m (BinaryTagged v b)
sequenceA :: BinaryTagged v (f a) -> f (BinaryTagged v a)
$csequenceA :: forall k (v :: k) (f :: * -> *) a.
Applicative f =>
BinaryTagged v (f a) -> f (BinaryTagged v a)
traverse :: (a -> f b) -> BinaryTagged v a -> f (BinaryTagged v b)
$ctraverse :: forall k (v :: k) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinaryTagged v a -> f (BinaryTagged v b)
$cp2Traversable :: forall k (v :: k). Foldable (BinaryTagged v)
$cp1Traversable :: forall k (v :: k). Functor (BinaryTagged v)
Traversable, (forall x. BinaryTagged v a -> Rep (BinaryTagged v a) x)
-> (forall x. Rep (BinaryTagged v a) x -> BinaryTagged v a)
-> Generic (BinaryTagged v a)
forall x. Rep (BinaryTagged v a) x -> BinaryTagged v a
forall x. BinaryTagged v a -> Rep (BinaryTagged v a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (v :: k) a x. Rep (BinaryTagged v a) x -> BinaryTagged v a
forall k (v :: k) a x. BinaryTagged v a -> Rep (BinaryTagged v a) x
$cto :: forall k (v :: k) a x. Rep (BinaryTagged v a) x -> BinaryTagged v a
$cfrom :: forall k (v :: k) a x. BinaryTagged v a -> Rep (BinaryTagged v a) x
GHC.Generic, (forall a. BinaryTagged v a -> Rep1 (BinaryTagged v) a)
-> (forall a. Rep1 (BinaryTagged v) a -> BinaryTagged v a)
-> Generic1 (BinaryTagged v)
forall a. Rep1 (BinaryTagged v) a -> BinaryTagged v a
forall a. BinaryTagged v a -> Rep1 (BinaryTagged v) a
forall k (v :: k) a. Rep1 (BinaryTagged v) a -> BinaryTagged v a
forall k (v :: k) a. BinaryTagged v a -> Rep1 (BinaryTagged v) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall k (v :: k) a. Rep1 (BinaryTagged v) a -> BinaryTagged v a
$cfrom1 :: forall k (v :: k) a. BinaryTagged v a -> Rep1 (BinaryTagged v) a
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 :: Proxy v -> a -> BinaryTagged v a
binaryTag _ = a -> BinaryTagged v a
forall k (v :: k) a. a -> BinaryTagged v a
BinaryTagged

binaryTag' :: HasSemanticVersion a => a -> BinaryTagged' a
binaryTag' :: a -> BinaryTagged' a
binaryTag' = a -> BinaryTagged' a
forall k (v :: k) a. a -> BinaryTagged v a
BinaryTagged

binaryUntag :: Proxy v -> BinaryTagged v a -> a
binaryUntag :: Proxy v -> BinaryTagged v a -> a
binaryUntag _ = BinaryTagged v a -> a
forall k (v :: k) a. BinaryTagged v a -> a
unBinaryTagged

binaryUntag' :: HasSemanticVersion a => BinaryTagged' a -> a
binaryUntag' :: BinaryTagged' a -> a
binaryUntag' = BinaryTagged' a -> a
forall k (v :: k) a. BinaryTagged v a -> a
unBinaryTagged

-- | Tagged version of 'encode'
taggedEncode ::  forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => a -> LBS.ByteString
taggedEncode :: a -> ByteString
taggedEncode = BinaryTagged (SemanticVersion a) a -> ByteString
forall a. Binary a => a -> ByteString
encode (BinaryTagged (SemanticVersion a) a -> ByteString)
-> (a -> BinaryTagged (SemanticVersion a) a) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (SemanticVersion a)
-> a -> BinaryTagged (SemanticVersion a) a
forall k (v :: k) a. Proxy v -> a -> BinaryTagged v a
binaryTag (Proxy (SemanticVersion a)
forall k (t :: k). Proxy t
Proxy :: Proxy (SemanticVersion a))

-- | Tagged version of 'decode'
taggedDecode :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => LBS.ByteString -> a
taggedDecode :: ByteString -> a
taggedDecode = Proxy (SemanticVersion a)
-> BinaryTagged (SemanticVersion a) a -> a
forall k (v :: k) a. Proxy v -> BinaryTagged v a -> a
binaryUntag (Proxy (SemanticVersion a)
forall k (t :: k). Proxy t
Proxy :: Proxy (SemanticVersion a)) (BinaryTagged (SemanticVersion a) a -> a)
-> (ByteString -> BinaryTagged (SemanticVersion a) a)
-> ByteString
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryTagged (SemanticVersion a) a
forall a. Binary a => ByteString -> 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 :: ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
taggedDecodeOrFail = (BinaryTagged (SemanticVersion a) a -> a)
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, BinaryTagged (SemanticVersion a) a)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall (f :: * -> *) t c a b.
Functor f =>
(t -> c) -> f (a, b, t) -> f (a, b, c)
fmap3 (Proxy (SemanticVersion a)
-> BinaryTagged (SemanticVersion a) a -> a
forall k (v :: k) a. Proxy v -> BinaryTagged v a -> a
binaryUntag (Proxy (SemanticVersion a)
forall k (t :: k). Proxy t
Proxy :: Proxy (SemanticVersion a))) (Either
   (ByteString, ByteOffset, String)
   (ByteString, ByteOffset, BinaryTagged (SemanticVersion a) a)
 -> Either
      (ByteString, ByteOffset, String) (ByteString, ByteOffset, a))
-> (ByteString
    -> Either
         (ByteString, ByteOffset, String)
         (ByteString, ByteOffset, BinaryTagged (SemanticVersion a) a))
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, BinaryTagged (SemanticVersion a) a)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail
  where fmap3 :: (t -> c) -> f (a, b, t) -> f (a, b, c)
fmap3 f :: t -> c
f = ((a, b, t) -> (a, b, c)) -> f (a, b, t) -> f (a, b, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a :: a
a, b :: b
b, c :: t
c) -> (a
a, b
b, t -> c
f t
c))

-- | Tagged version of 'encodeFile'
taggedEncodeFile :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> a -> IO ()
taggedEncodeFile :: String -> a -> IO ()
taggedEncodeFile filepath :: String
filepath = String -> BinaryTagged (SemanticVersion a) a -> IO ()
forall a. Binary a => String -> a -> IO ()
encodeFile String
filepath (BinaryTagged (SemanticVersion a) a -> IO ())
-> (a -> BinaryTagged (SemanticVersion a) a) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (SemanticVersion a)
-> a -> BinaryTagged (SemanticVersion a) a
forall k (v :: k) a. Proxy v -> a -> BinaryTagged v a
binaryTag (Proxy (SemanticVersion a)
forall k (t :: k). Proxy t
Proxy :: Proxy (SemanticVersion a))

-- | Tagged version of 'decodeFile'
taggedDecodeFile :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> IO a
taggedDecodeFile :: String -> IO a
taggedDecodeFile = (BinaryTagged (SemanticVersion a) a -> a)
-> IO (BinaryTagged (SemanticVersion a) a) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy (SemanticVersion a)
-> BinaryTagged (SemanticVersion a) a -> a
forall k (v :: k) a. Proxy v -> BinaryTagged v a -> a
binaryUntag (Proxy (SemanticVersion a)
forall k (t :: k). Proxy t
Proxy :: Proxy (SemanticVersion a))) (IO (BinaryTagged (SemanticVersion a) a) -> IO a)
-> (String -> IO (BinaryTagged (SemanticVersion a) a))
-> String
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (BinaryTagged (SemanticVersion a) a)
forall a. Binary a => String -> IO a
decodeFile

-- | Tagged version of 'decodeFileOrFail'
taggedDecodeFileOrFail :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> IO (Either (ByteOffset, String) a)
taggedDecodeFileOrFail :: String -> IO (Either (ByteOffset, String) a)
taggedDecodeFileOrFail = ((Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a)
 -> Either (ByteOffset, String) a)
-> IO
     (Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a))
-> IO (Either (ByteOffset, String) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a)
  -> Either (ByteOffset, String) a)
 -> IO
      (Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a))
 -> IO (Either (ByteOffset, String) a))
-> ((BinaryTagged (SemanticVersion a) a -> a)
    -> Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a)
    -> Either (ByteOffset, String) a)
-> (BinaryTagged (SemanticVersion a) a -> a)
-> IO
     (Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a))
-> IO (Either (ByteOffset, String) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BinaryTagged (SemanticVersion a) a -> a)
-> Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a)
-> Either (ByteOffset, String) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Proxy (SemanticVersion a)
-> BinaryTagged (SemanticVersion a) a -> a
forall k (v :: k) a. Proxy v -> BinaryTagged v a -> a
binaryUntag (Proxy (SemanticVersion a)
forall k (t :: k). Proxy t
Proxy :: Proxy (SemanticVersion a))) (IO
   (Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a))
 -> IO (Either (ByteOffset, String) a))
-> (String
    -> IO
         (Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a)))
-> String
-> IO (Either (ByteOffset, String) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> IO
     (Either (ByteOffset, String) (BinaryTagged (SemanticVersion a) a))
forall a. Binary a => String -> IO (Either (ByteOffset, String) a)
decodeFileOrFail

instance Applicative (BinaryTagged v) where
  pure :: a -> BinaryTagged v a
pure = a -> BinaryTagged v a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: BinaryTagged v (a -> b) -> BinaryTagged v a -> BinaryTagged v b
(<*>) = BinaryTagged v (a -> b) -> BinaryTagged v a -> BinaryTagged v b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (BinaryTagged v) where
  return :: a -> BinaryTagged v a
return = a -> BinaryTagged v a
forall k (v :: k) a. a -> BinaryTagged v a
BinaryTagged
  BinaryTagged m :: a
m >>= :: BinaryTagged v a -> (a -> BinaryTagged v b) -> BinaryTagged v b
>>= k :: a -> BinaryTagged v b
k = a -> BinaryTagged v b
k a
m

instance Semigroup.Semigroup a => Semigroup.Semigroup (BinaryTagged v a) where
  <> :: BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
(<>) = (a -> a -> a)
-> BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)

instance Monoid.Monoid a => Monoid.Monoid (BinaryTagged v a) where
  mempty :: BinaryTagged v a
mempty   = a -> BinaryTagged v a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
Monoid.mempty
  mappend :: BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
mappend  = (a -> a -> a)
-> BinaryTagged v a -> BinaryTagged v a -> BinaryTagged v a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
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 v a -> Put
put (BinaryTagged x :: a
x) = Version -> Put
forall t. Binary t => t -> Put
put Version
ver' Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
hash' Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
x
    where
      proxyV :: Proxy v
proxyV = Proxy v
forall k (t :: k). Proxy t
Proxy :: Proxy v
      proxyA :: Proxy a
proxyA = Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a
      ver' :: Version
ver' = Integer -> Version
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy v -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy v
proxyV) :: Version
      hash' :: ByteString
hash' = StructuralInfo -> ByteString
structuralInfoSha1ByteStringDigest (StructuralInfo -> ByteString)
-> (Proxy a -> StructuralInfo) -> Proxy a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a -> ByteString) -> Proxy a -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy a
proxyA

  get :: Get (BinaryTagged v a)
get = do
      Version
ver <- Get Version
forall t. Binary t => Get t
get
      if Version
ver Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
ver'
         then do ByteString
hash <- Get ByteString
forall t. Binary t => Get t
get
                 if ByteString
hash ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
hash'
                    then (a -> BinaryTagged v a) -> Get a -> Get (BinaryTagged v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> BinaryTagged v a
forall k (v :: k) a. a -> BinaryTagged v a
BinaryTagged Get a
forall t. Binary t => Get t
get
                    else String -> Get (BinaryTagged v a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (BinaryTagged v a))
-> String -> Get (BinaryTagged v a)
forall a b. (a -> b) -> a -> b
$ "Non matching structure hashes: got" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show (ByteString -> ByteString
Base16.encode ByteString
hash) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "; expected: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show (ByteString -> ByteString
Base16.encode ByteString
hash')
         else String -> Get (BinaryTagged v a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (BinaryTagged v a))
-> String -> Get (BinaryTagged v a)
forall a b. (a -> b) -> a -> b
$ "Non matching versions: got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> String
forall a. Show a => a -> String
show Version
ver String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "; expected: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> String
forall a. Show a => a -> String
show Version
ver'
    where
      proxyV :: Proxy v
proxyV = Proxy v
forall k (t :: k). Proxy t
Proxy :: Proxy v
      proxyA :: Proxy a
proxyA = Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a
      ver' :: Version
ver' = Integer -> Version
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy v -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy v
proxyV) :: Version
      hash' :: ByteString
hash' = StructuralInfo -> ByteString
structuralInfoSha1Digest (StructuralInfo -> ByteString)
-> (Proxy a -> StructuralInfo) -> Proxy a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a -> ByteString) -> Proxy a -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy a
proxyA

-- | Data type structure, with (some) nominal information.
data StructuralInfo = NominalType String
                | NominalNewtype String StructuralInfo
                | StructuralInfo String [[StructuralInfo]]
  deriving (StructuralInfo -> StructuralInfo -> Bool
(StructuralInfo -> StructuralInfo -> Bool)
-> (StructuralInfo -> StructuralInfo -> Bool) -> Eq StructuralInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StructuralInfo -> StructuralInfo -> Bool
$c/= :: StructuralInfo -> StructuralInfo -> Bool
== :: StructuralInfo -> StructuralInfo -> Bool
$c== :: StructuralInfo -> StructuralInfo -> Bool
Eq, Eq StructuralInfo
Eq StructuralInfo =>
(StructuralInfo -> StructuralInfo -> Ordering)
-> (StructuralInfo -> StructuralInfo -> Bool)
-> (StructuralInfo -> StructuralInfo -> Bool)
-> (StructuralInfo -> StructuralInfo -> Bool)
-> (StructuralInfo -> StructuralInfo -> Bool)
-> (StructuralInfo -> StructuralInfo -> StructuralInfo)
-> (StructuralInfo -> StructuralInfo -> StructuralInfo)
-> Ord StructuralInfo
StructuralInfo -> StructuralInfo -> Bool
StructuralInfo -> StructuralInfo -> Ordering
StructuralInfo -> StructuralInfo -> StructuralInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StructuralInfo -> StructuralInfo -> StructuralInfo
$cmin :: StructuralInfo -> StructuralInfo -> StructuralInfo
max :: StructuralInfo -> StructuralInfo -> StructuralInfo
$cmax :: StructuralInfo -> StructuralInfo -> StructuralInfo
>= :: StructuralInfo -> StructuralInfo -> Bool
$c>= :: StructuralInfo -> StructuralInfo -> Bool
> :: StructuralInfo -> StructuralInfo -> Bool
$c> :: StructuralInfo -> StructuralInfo -> Bool
<= :: StructuralInfo -> StructuralInfo -> Bool
$c<= :: StructuralInfo -> StructuralInfo -> Bool
< :: StructuralInfo -> StructuralInfo -> Bool
$c< :: StructuralInfo -> StructuralInfo -> Bool
compare :: StructuralInfo -> StructuralInfo -> Ordering
$ccompare :: StructuralInfo -> StructuralInfo -> Ordering
$cp1Ord :: Eq StructuralInfo
Ord, Int -> StructuralInfo -> ShowS
[StructuralInfo] -> ShowS
StructuralInfo -> String
(Int -> StructuralInfo -> ShowS)
-> (StructuralInfo -> String)
-> ([StructuralInfo] -> ShowS)
-> Show StructuralInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructuralInfo] -> ShowS
$cshowList :: [StructuralInfo] -> ShowS
show :: StructuralInfo -> String
$cshow :: StructuralInfo -> String
showsPrec :: Int -> StructuralInfo -> ShowS
$cshowsPrec :: Int -> StructuralInfo -> ShowS
Show, (forall x. StructuralInfo -> Rep StructuralInfo x)
-> (forall x. Rep StructuralInfo x -> StructuralInfo)
-> Generic StructuralInfo
forall x. Rep StructuralInfo x -> StructuralInfo
forall x. StructuralInfo -> Rep StructuralInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StructuralInfo x -> StructuralInfo
$cfrom :: forall x. StructuralInfo -> Rep StructuralInfo x
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 = Proxy a -> StructuralInfo
forall a.
(Generic a, All2 HasStructuralInfo (GCode a), GDatatypeInfo a,
 SListI2 (GCode a)) =>
Proxy a -> 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 :: StructuralInfo -> ByteString
structuralInfoSha1Digest = ByteString -> ByteString
SHA1.hashlazy (ByteString -> ByteString)
-> (StructuralInfo -> ByteString) -> StructuralInfo -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuralInfo -> ByteString
forall a. Binary a => a -> ByteString
encode

{-# DEPRECATED structuralInfoSha1ByteStringDigest "Use structuralInfoSha1Digest directly" #-}
structuralInfoSha1ByteStringDigest :: StructuralInfo -> BS.ByteString
structuralInfoSha1ByteStringDigest :: StructuralInfo -> ByteString
structuralInfoSha1ByteStringDigest = StructuralInfo -> ByteString
structuralInfoSha1Digest

-------------------------------------------------------------------------------
-- Generics
-------------------------------------------------------------------------------

ghcStructuralInfo :: ( GHC.Generic a
                     , All2 HasStructuralInfo (GCode a)
                     , GDatatypeInfo a
                     , SListI2 (GCode a)
                     )
                  => Proxy a
                  -> StructuralInfo
ghcStructuralInfo :: Proxy a -> StructuralInfo
ghcStructuralInfo proxy :: Proxy a
proxy = DatatypeInfo (ToSumCode (Rep a) '[]) -> StructuralInfo
forall (xss :: [[*]]).
(All2 HasStructuralInfo xss, SListI2 xss) =>
DatatypeInfo xss -> StructuralInfo
sopStructuralInfoS (Proxy a -> DatatypeInfo (ToSumCode (Rep a) '[])
forall (proxy :: * -> *) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo Proxy a
proxy)

ghcNominalType ::  (GHC.Generic a,  GDatatypeInfo a) => Proxy a -> StructuralInfo
ghcNominalType :: Proxy a -> StructuralInfo
ghcNominalType proxy :: Proxy a
proxy = DatatypeInfo (ToSumCode (Rep a) '[]) -> StructuralInfo
forall (xss :: [[*]]). DatatypeInfo xss -> StructuralInfo
sopNominalTypeS (Proxy a -> DatatypeInfo (ToSumCode (Rep a) '[])
forall (proxy :: * -> *) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo Proxy a
proxy)

ghcStructuralInfo1 :: forall f a. (GHC.Generic1 f, GDatatypeInfo (f a), HasStructuralInfo a) => Proxy (f a) -> StructuralInfo
ghcStructuralInfo1 :: Proxy (f a) -> StructuralInfo
ghcStructuralInfo1 proxy :: Proxy (f a)
proxy = StructuralInfo
-> DatatypeInfo (ToSumCode (Rep (f a)) '[]) -> StructuralInfo
forall (xss :: [[*]]).
StructuralInfo -> DatatypeInfo xss -> StructuralInfo
sopStructuralInfo1S (Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) (Proxy (f a) -> DatatypeInfo (ToSumCode (Rep (f a)) '[])
forall (proxy :: * -> *) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo Proxy (f a)
proxy)

-- SOP derivation

sopStructuralInfo :: forall a. (Generic a, HasDatatypeInfo a, All2 HasStructuralInfo (Code a)) => Proxy a -> StructuralInfo
sopStructuralInfo :: Proxy a -> StructuralInfo
sopStructuralInfo proxy :: Proxy a
proxy = DatatypeInfo (Code a) -> StructuralInfo
forall (xss :: [[*]]).
(All2 HasStructuralInfo xss, SListI2 xss) =>
DatatypeInfo xss -> StructuralInfo
sopStructuralInfoS (Proxy a -> DatatypeInfo (Code a)
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
datatypeInfo Proxy a
proxy)

sopStructuralInfoS :: forall xss. ( All2 HasStructuralInfo xss
                                  , SListI2 xss
                                  )
                   => DatatypeInfo xss
                   -> StructuralInfo
sopStructuralInfoS :: DatatypeInfo xss -> StructuralInfo
sopStructuralInfoS di :: DatatypeInfo xss
di@(Newtype _ _ ci :: ConstructorInfo '[x]
ci)  = String -> StructuralInfo -> StructuralInfo
NominalNewtype (DatatypeInfo xss -> String
forall (xss :: [[*]]). DatatypeInfo xss -> String
datatypeName DatatypeInfo xss
di) (ConstructorInfo '[x] -> StructuralInfo
forall x.
HasStructuralInfo x =>
ConstructorInfo '[x] -> StructuralInfo
sopNominalNewtype ConstructorInfo '[x]
ci)
sopStructuralInfoS di :: DatatypeInfo xss
di@ADT {}            = String -> [[StructuralInfo]] -> StructuralInfo
StructuralInfo (DatatypeInfo xss -> String
forall (xss :: [[*]]). DatatypeInfo xss -> String
datatypeName DatatypeInfo xss
di) (POP Proxy xss -> [[StructuralInfo]]
forall (xss :: [[*]]).
All2 HasStructuralInfo xss =>
POP Proxy xss -> [[StructuralInfo]]
sopNominalAdtPOP ((forall a. Proxy a) -> POP Proxy xss
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure forall a. Proxy a
forall k (t :: k). Proxy t
Proxy :: POP Proxy xss))

sopNominalNewtype :: forall x. HasStructuralInfo x => ConstructorInfo '[x] -> StructuralInfo
sopNominalNewtype :: ConstructorInfo '[x] -> StructuralInfo
sopNominalNewtype _ = Proxy x -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x)

sopNominalAdtPOP :: (All2 HasStructuralInfo xss) => POP Proxy xss -> [[StructuralInfo]]
sopNominalAdtPOP :: POP Proxy xss -> [[StructuralInfo]]
sopNominalAdtPOP (POP np2 :: NP (NP Proxy) xss
np2) = NP (NP Proxy) xss -> [[StructuralInfo]]
forall (xss :: [[*]]).
All2 HasStructuralInfo xss =>
NP (NP Proxy) xss -> [[StructuralInfo]]
sopNominalAdt NP (NP Proxy) xss
np2

sopNominalAdt :: (All2 HasStructuralInfo xss) => NP (NP Proxy) xss -> [[StructuralInfo]]
sopNominalAdt :: NP (NP Proxy) xss -> [[StructuralInfo]]
sopNominalAdt Nil       = []
sopNominalAdt (p :: NP Proxy x
p :* ps :: NP (NP Proxy) xs
ps) = NP Proxy x -> [StructuralInfo]
forall (xs :: [*]).
All HasStructuralInfo xs =>
NP Proxy xs -> [StructuralInfo]
sopStructuralInfoP NP Proxy x
p [StructuralInfo] -> [[StructuralInfo]] -> [[StructuralInfo]]
forall a. a -> [a] -> [a]
: NP (NP Proxy) xs -> [[StructuralInfo]]
forall (xss :: [[*]]).
All2 HasStructuralInfo xss =>
NP (NP Proxy) xss -> [[StructuralInfo]]
sopNominalAdt NP (NP Proxy) xs
ps

sopStructuralInfoP :: (All HasStructuralInfo xs) => NP Proxy xs -> [StructuralInfo]
sopStructuralInfoP :: NP Proxy xs -> [StructuralInfo]
sopStructuralInfoP Nil = []
sopStructuralInfoP (proxy :: Proxy x
proxy :* rest :: NP Proxy xs
rest) =  Proxy x -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo Proxy x
proxy StructuralInfo -> [StructuralInfo] -> [StructuralInfo]
forall a. a -> [a] -> [a]
: NP Proxy xs -> [StructuralInfo]
forall (xs :: [*]).
All HasStructuralInfo xs =>
NP Proxy xs -> [StructuralInfo]
sopStructuralInfoP NP Proxy xs
rest

sopNominalType :: forall a. (Generic a, HasDatatypeInfo a) => Proxy a -> StructuralInfo
sopNominalType :: Proxy a -> StructuralInfo
sopNominalType proxy :: Proxy a
proxy = DatatypeInfo (Code a) -> StructuralInfo
forall (xss :: [[*]]). DatatypeInfo xss -> StructuralInfo
sopNominalTypeS (Proxy a -> DatatypeInfo (Code a)
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
datatypeInfo Proxy a
proxy)

sopNominalTypeS :: DatatypeInfo xss -> StructuralInfo
sopNominalTypeS :: DatatypeInfo xss -> StructuralInfo
sopNominalTypeS di :: DatatypeInfo xss
di = String -> StructuralInfo
NominalType (DatatypeInfo xss -> String
forall (xss :: [[*]]). DatatypeInfo xss -> String
datatypeName DatatypeInfo xss
di)

sopStructuralInfo1 :: forall f a. (Generic (f a), HasDatatypeInfo (f a), HasStructuralInfo a) => Proxy (f a) -> StructuralInfo
sopStructuralInfo1 :: Proxy (f a) -> StructuralInfo
sopStructuralInfo1 proxy :: Proxy (f a)
proxy = StructuralInfo -> DatatypeInfo (Code (f a)) -> StructuralInfo
forall (xss :: [[*]]).
StructuralInfo -> DatatypeInfo xss -> StructuralInfo
sopStructuralInfo1S (Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) (Proxy (f a) -> DatatypeInfo (Code (f a))
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
datatypeInfo Proxy (f a)
proxy)

sopStructuralInfo1S :: StructuralInfo -> DatatypeInfo xss -> StructuralInfo
sopStructuralInfo1S :: StructuralInfo -> DatatypeInfo xss -> StructuralInfo
sopStructuralInfo1S nsop :: StructuralInfo
nsop di :: DatatypeInfo xss
di = String -> StructuralInfo -> StructuralInfo
NominalNewtype (DatatypeInfo xss -> String
forall (xss :: [[*]]). DatatypeInfo xss -> String
datatypeName DatatypeInfo xss
di) StructuralInfo
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 :: Proxy Bool -> StructuralInfo
structuralInfo = Proxy Bool -> StructuralInfo
forall a. (Generic a, GDatatypeInfo a) => Proxy a -> StructuralInfo
ghcNominalType
instance HasStructuralInfo Char where structuralInfo :: Proxy Char -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Char"
instance HasStructuralInfo Int where structuralInfo :: Proxy Int -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Int"
instance HasStructuralInfo Word where structuralInfo :: Proxy Word -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Word"
instance HasStructuralInfo Integer where structuralInfo :: Proxy Integer -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Integer"

instance HasStructuralInfo Int8 where structuralInfo :: Proxy Int8 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Int8"
instance HasStructuralInfo Int16 where structuralInfo :: Proxy Int16 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Int16"
instance HasStructuralInfo Int32 where structuralInfo :: Proxy Int32 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Int32"
instance HasStructuralInfo Int64 where structuralInfo :: Proxy ByteOffset -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Int64"

instance HasStructuralInfo Word8 where structuralInfo :: Proxy Word8 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Word8"
instance HasStructuralInfo Word16 where structuralInfo :: Proxy Word16 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Word16"
instance HasStructuralInfo Word32 where structuralInfo :: Proxy Version -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Word32"
instance HasStructuralInfo Word64 where structuralInfo :: Proxy Word64 -> StructuralInfo
structuralInfo _ = String -> 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 :: Proxy Ordering -> StructuralInfo
structuralInfo = Proxy Ordering -> StructuralInfo
forall a. (Generic a, GDatatypeInfo a) => Proxy a -> StructuralInfo
ghcNominalType

-- | /Since binary-tagged-0.1.3.0/
instance HasSemanticVersion Ordering

-- | /Since binary-tagged-0.1.3.0/
instance HasStructuralInfo Float where structuralInfo :: Proxy Float -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Float"

-- | /Since binary-tagged-0.1.3.0/
instance HasStructuralInfo Double where structuralInfo :: Proxy Double -> StructuralInfo
structuralInfo _ = String -> 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 :: Proxy [a] -> StructuralInfo
structuralInfo = Proxy [a] -> StructuralInfo
forall (f :: * -> *) a.
(Generic1 f, GDatatypeInfo (f a), HasStructuralInfo a) =>
Proxy (f a) -> StructuralInfo
ghcStructuralInfo1
instance HasSemanticVersion a => HasSemanticVersion [a] where
  type SemanticVersion [a] = SemanticVersion a

instance HasStructuralInfo a => HasStructuralInfo (NE.NonEmpty a) where structuralInfo :: Proxy (NonEmpty a) -> StructuralInfo
structuralInfo = Proxy (NonEmpty a) -> StructuralInfo
forall (f :: * -> *) a.
(Generic1 f, GDatatypeInfo (f a), HasStructuralInfo a) =>
Proxy (f a) -> 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 :: Proxy (Ratio a) -> StructuralInfo
structuralInfo _ = String -> StructuralInfo -> StructuralInfo
NominalNewtype "Ratio" (StructuralInfo -> StructuralInfo)
-> StructuralInfo -> StructuralInfo
forall a b. (a -> b) -> a -> b
$ Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
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 :: Proxy () -> StructuralInfo
structuralInfo _ = String -> 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 :: Proxy (Fixed a) -> StructuralInfo
structuralInfo _ = String -> [[StructuralInfo]] -> StructuralInfo
StructuralInfo "Fixed" [[ Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) ]]

instance HasStructuralInfo Fixed.E0 where structuralInfo :: Proxy E0 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "E0"
instance HasStructuralInfo Fixed.E1 where structuralInfo :: Proxy E1 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "E1"
instance HasStructuralInfo Fixed.E2 where structuralInfo :: Proxy E2 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "E2"
instance HasStructuralInfo Fixed.E3 where structuralInfo :: Proxy E3 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "E3"
instance HasStructuralInfo Fixed.E6 where structuralInfo :: Proxy E6 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "E6"
instance HasStructuralInfo Fixed.E9 where structuralInfo :: Proxy E9 -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "E9"
instance HasStructuralInfo Fixed.E12 where structuralInfo :: Proxy E12 -> StructuralInfo
structuralInfo _ = String -> 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 :: Proxy Version -> StructuralInfo
structuralInfo _ = String -> [[StructuralInfo]] -> StructuralInfo
StructuralInfo "Version" [[ Proxy [Int] -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy [Int]
forall k (t :: k). Proxy t
Proxy :: Proxy [Int])
                                               , Proxy [String] -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy [String]
forall k (t :: k). Proxy t
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 :: Proxy ByteString -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "ByteString.Strict"
instance HasStructuralInfo LBS.ByteString where structuralInfo :: Proxy ByteString -> StructuralInfo
structuralInfo _ = String -> 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 :: Proxy Natural -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Numeric.Natural"
-- | /Since binary-tagged-0.1.4.0/
instance HasSemanticVersion Natural.Natural

-------------------------------------------------------------------------------
-- text
-------------------------------------------------------------------------------

instance HasStructuralInfo S.Text where structuralInfo :: Proxy Text -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Text.Strict"
instance HasStructuralInfo L.Text where structuralInfo :: Proxy Text -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Text.Lazy"

instance HasSemanticVersion S.Text
instance HasSemanticVersion L.Text

-------------------------------------------------------------------------------
-- containers
-------------------------------------------------------------------------------

instance HasStructuralInfo a => HasStructuralInfo (IntMap.IntMap a) where
  structuralInfo :: Proxy (IntMap a) -> StructuralInfo
structuralInfo _ = String -> StructuralInfo -> StructuralInfo
NominalNewtype "IntMap" (StructuralInfo -> StructuralInfo)
-> StructuralInfo -> StructuralInfo
forall a b. (a -> b) -> a -> b
$ Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance HasSemanticVersion a => HasSemanticVersion (IntMap.IntMap a) where
  type SemanticVersion (IntMap.IntMap a) = SemanticVersion a

instance HasStructuralInfo IntSet.IntSet where
  structuralInfo :: Proxy IntSet -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "IntSet"
instance HasSemanticVersion IntSet.IntSet

instance (HasStructuralInfo k, HasStructuralInfo v) => HasStructuralInfo (Map.Map k v) where
  structuralInfo :: Proxy (Map k v) -> StructuralInfo
structuralInfo _ = String -> [[StructuralInfo]] -> StructuralInfo
StructuralInfo "Map" [[ Proxy k -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy k
forall k (t :: k). Proxy t
Proxy :: Proxy k), Proxy v -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy v
forall k (t :: k). Proxy t
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 :: Proxy (Seq a) -> StructuralInfo
structuralInfo _ = String -> StructuralInfo -> StructuralInfo
NominalNewtype "Seq" (StructuralInfo -> StructuralInfo)
-> StructuralInfo -> StructuralInfo
forall a b. (a -> b) -> a -> b
$ Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
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 :: Proxy (Set a) -> StructuralInfo
structuralInfo _ = String -> StructuralInfo -> StructuralInfo
NominalNewtype "Set" (StructuralInfo -> StructuralInfo)
-> StructuralInfo -> StructuralInfo
forall a b. (a -> b) -> a -> b
$ Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
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 :: Proxy (HashMap k v) -> StructuralInfo
structuralInfo _ = String -> [[StructuralInfo]] -> StructuralInfo
StructuralInfo "HashMap" [[ Proxy k -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy k
forall k (t :: k). Proxy t
Proxy :: Proxy k), Proxy v -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy v
forall k (t :: k). Proxy t
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 :: Proxy (HashSet a) -> StructuralInfo
structuralInfo _ = String -> StructuralInfo -> StructuralInfo
NominalNewtype "HashSet" (StructuralInfo -> StructuralInfo)
-> StructuralInfo -> StructuralInfo
forall a b. (a -> b) -> a -> b
$ Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
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 :: Proxy (Array i e) -> StructuralInfo
structuralInfo _ = String -> [[StructuralInfo]] -> StructuralInfo
StructuralInfo "Array" [[ Proxy i -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy i
forall k (t :: k). Proxy t
Proxy :: Proxy i), Proxy e -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy e
forall k (t :: k). Proxy t
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 :: Proxy (UArray i e) -> StructuralInfo
structuralInfo _ = String -> [[StructuralInfo]] -> StructuralInfo
StructuralInfo "UArray" [[ Proxy i -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy i
forall k (t :: k). Proxy t
Proxy :: Proxy i), Proxy e -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy e
forall k (t :: k). Proxy t
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 :: Proxy (Vector a) -> StructuralInfo
structuralInfo _ = String -> StructuralInfo -> StructuralInfo
NominalNewtype "Vector" (StructuralInfo -> StructuralInfo)
-> StructuralInfo -> StructuralInfo
forall a b. (a -> b) -> a -> b
$ Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
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 :: Proxy (Vector a) -> StructuralInfo
structuralInfo _ = String -> StructuralInfo -> StructuralInfo
NominalNewtype "Vector.Unboxed" (StructuralInfo -> StructuralInfo)
-> StructuralInfo -> StructuralInfo
forall a b. (a -> b) -> a -> b
$ Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
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 :: Proxy (Vector a) -> StructuralInfo
structuralInfo _ = String -> StructuralInfo -> StructuralInfo
NominalNewtype "Vector.Storable" (StructuralInfo -> StructuralInfo)
-> StructuralInfo -> StructuralInfo
forall a b. (a -> b) -> a -> b
$ Proxy a -> StructuralInfo
forall a. HasStructuralInfo a => Proxy a -> StructuralInfo
structuralInfo (Proxy a
forall k (t :: k). Proxy t
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 :: Proxy UTCTime -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "UTCTime"
instance HasStructuralInfo Time.DiffTime where structuralInfo :: Proxy DiffTime -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "DiffTime"
instance HasStructuralInfo Time.UniversalTime where structuralInfo :: Proxy UniversalTime -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "UniversalTime"
instance HasStructuralInfo Time.NominalDiffTime where structuralInfo :: Proxy NominalDiffTime -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "NominalDiffTime"
instance HasStructuralInfo Time.Day where structuralInfo :: Proxy Day -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Day"
instance HasStructuralInfo Time.TimeZone where structuralInfo :: Proxy TimeZone -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "TimeZone"
instance HasStructuralInfo Time.TimeOfDay where structuralInfo :: Proxy TimeOfDay -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "TimeOfDay"
instance HasStructuralInfo Time.LocalTime where structuralInfo :: Proxy LocalTime -> StructuralInfo
structuralInfo _ = String -> 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 :: Proxy Value -> StructuralInfo
structuralInfo _ = String -> StructuralInfo
NominalType "Aeson.Value"
instance HasSemanticVersion Aeson.Value
#endif