{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- |
--
-- Copyright: (c) 2019 Oleg Grenrus
--
-- Structurally tag binary serialisation stream.
-- Useful when most 'Binary' instances are 'Generic' derived.
--
-- Say you have a data type
--
-- @
-- data Record = Record
--   { _recordFields  :: HM.HashMap Text (Integer, ByteString)
--   , _recordEnabled :: Bool
--   }
--   deriving (Eq, Show, Generic)
--
-- instance 'Binary' Record
-- instance 'Structured' Record
-- @
--
-- then you can serialise and deserialise @Record@ values with a structure tag by simply
--
-- @
-- 'structuredEncode' record :: 'LBS.ByteString'
-- 'structuredDecode' lbs :: IO Record
-- @
--
-- If structure of @Record@ changes in between, deserialisation will fail early.
--
-- Technically, 'Structured' is not related to 'Binary', and may
-- be useful in other uses.
module Distribution.Utils.Structured
  ( -- * Encoding and decoding

    -- | These functions operate like @binary@'s counterparts,
    -- but the serialised version has a structure hash in front.
    structuredEncode
  , structuredEncodeFile
  , structuredDecode
  , structuredDecodeOrFailIO
  , structuredDecodeFileOrFail

    -- * Structured class
  , Structured (structure)
  , MD5
  , structureHash
  , structureBuilder
  , genericStructure
  , GStructured
  , nominalStructure
  , containerStructure

    -- * Structure type
  , Structure (..)
  , Tag (..)
  , TypeName
  , ConstructorName
  , TypeVersion
  , SopStructure
  , hashStructure
  , typeVersion
  , typeName
  ) where

import Data.Int (Int16, Int32, Int64, Int8)
import Data.List.NonEmpty (NonEmpty)
import Data.Proxy (Proxy (..))
import Data.Ratio (Ratio)
import Data.Word (Word, Word16, Word32, Word64, Word8)

import qualified Control.Monad.Trans.State.Strict as State

import Control.Exception (ErrorCall (..), catch, evaluate)

import GHC.Generics

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
#if MIN_VERSION_bytestring(0,10,4)
import qualified Data.ByteString.Builder      as Builder
#else
import qualified Data.ByteString.Lazy.Builder as Builder
#endif
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Time as Time
import qualified Distribution.Compat.Binary as Binary

#ifdef MIN_VERSION_aeson
import qualified Data.Aeson as Aeson
#endif

import Data.Kind (Type)
import Data.Typeable (TypeRep, Typeable, typeRep)

import Distribution.Utils.MD5

import Data.Monoid (Last, mconcat)

import qualified Data.Foldable
import qualified Data.Semigroup

-------------------------------------------------------------------------------
-- Types
-------------------------------------------------------------------------------

type TypeName = String
type ConstructorName = String

-- | A semantic version of a data type. Usually 0.
type TypeVersion = Word32

-- | Structure of a datatype.
--
-- It can be infinite, as far as 'TypeRep's involved are finite.
-- (e.g. polymorphic recursion might cause troubles).
data Structure
  = -- | nominal, yet can be parametrised by other structures.
    Nominal !TypeRep !TypeVersion TypeName [Structure]
  | -- | a newtype wrapper
    Newtype !TypeRep !TypeVersion TypeName Structure
  | -- | sum-of-products structure
    Structure !TypeRep !TypeVersion TypeName SopStructure
  deriving (Structure -> Structure -> Bool
(Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool) -> Eq Structure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Structure -> Structure -> Bool
== :: Structure -> Structure -> Bool
$c/= :: Structure -> Structure -> Bool
/= :: Structure -> Structure -> Bool
Eq, Eq Structure
Eq Structure =>
(Structure -> Structure -> Ordering)
-> (Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool)
-> (Structure -> Structure -> Structure)
-> (Structure -> Structure -> Structure)
-> Ord Structure
Structure -> Structure -> Bool
Structure -> Structure -> Ordering
Structure -> Structure -> Structure
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
$ccompare :: Structure -> Structure -> Ordering
compare :: Structure -> Structure -> Ordering
$c< :: Structure -> Structure -> Bool
< :: Structure -> Structure -> Bool
$c<= :: Structure -> Structure -> Bool
<= :: Structure -> Structure -> Bool
$c> :: Structure -> Structure -> Bool
> :: Structure -> Structure -> Bool
$c>= :: Structure -> Structure -> Bool
>= :: Structure -> Structure -> Bool
$cmax :: Structure -> Structure -> Structure
max :: Structure -> Structure -> Structure
$cmin :: Structure -> Structure -> Structure
min :: Structure -> Structure -> Structure
Ord, Int -> Structure -> ShowS
[Structure] -> ShowS
Structure -> [Char]
(Int -> Structure -> ShowS)
-> (Structure -> [Char])
-> ([Structure] -> ShowS)
-> Show Structure
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Structure -> ShowS
showsPrec :: Int -> Structure -> ShowS
$cshow :: Structure -> [Char]
show :: Structure -> [Char]
$cshowList :: [Structure] -> ShowS
showList :: [Structure] -> ShowS
Show, (forall x. Structure -> Rep Structure x)
-> (forall x. Rep Structure x -> Structure) -> Generic Structure
forall x. Rep Structure x -> Structure
forall x. Structure -> Rep Structure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Structure -> Rep Structure x
from :: forall x. Structure -> Rep Structure x
$cto :: forall x. Rep Structure x -> Structure
to :: forall x. Rep Structure x -> Structure
Generic)

type SopStructure = [(ConstructorName, [Structure])]

-- | A MD5 hash digest of 'Structure'.
hashStructure :: Structure -> MD5
hashStructure :: Structure -> MD5
hashStructure = ByteString -> MD5
md5 (ByteString -> MD5)
-> (Structure -> ByteString) -> Structure -> MD5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
LBS.toStrict (LazyByteString -> ByteString)
-> (Structure -> LazyByteString) -> Structure -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
Builder.toLazyByteString (Builder -> LazyByteString)
-> (Structure -> Builder) -> Structure -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Structure -> Builder
structureBuilder

-- | A van-Laarhoven lens into 'TypeVersion' of 'Structure'
--
-- @
-- 'typeVersion' :: Lens' 'Structure' 'TypeVersion'
-- @
typeVersion :: Functor f => (TypeVersion -> f TypeVersion) -> Structure -> f Structure
typeVersion :: forall (f :: * -> *).
Functor f =>
(Word32 -> f Word32) -> Structure -> f Structure
typeVersion Word32 -> f Word32
f (Nominal SomeTypeRep
t Word32
v [Char]
n [Structure]
s) = (Word32 -> Structure) -> f Word32 -> f Structure
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word32
v' -> SomeTypeRep -> Word32 -> [Char] -> [Structure] -> Structure
Nominal SomeTypeRep
t Word32
v' [Char]
n [Structure]
s) (Word32 -> f Word32
f Word32
v)
typeVersion Word32 -> f Word32
f (Newtype SomeTypeRep
t Word32
v [Char]
n Structure
s) = (Word32 -> Structure) -> f Word32 -> f Structure
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word32
v' -> SomeTypeRep -> Word32 -> [Char] -> Structure -> Structure
Newtype SomeTypeRep
t Word32
v' [Char]
n Structure
s) (Word32 -> f Word32
f Word32
v)
typeVersion Word32 -> f Word32
f (Structure SomeTypeRep
t Word32
v [Char]
n [([Char], [Structure])]
s) = (Word32 -> Structure) -> f Word32 -> f Structure
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word32
v' -> SomeTypeRep
-> Word32 -> [Char] -> [([Char], [Structure])] -> Structure
Structure SomeTypeRep
t Word32
v' [Char]
n [([Char], [Structure])]
s) (Word32 -> f Word32
f Word32
v)

-- | A van-Laarhoven lens into 'TypeName' of 'Structure'
--
-- @
-- 'typeName' :: Lens' 'Structure' 'TypeName'
-- @
typeName :: Functor f => (TypeName -> f TypeName) -> Structure -> f Structure
typeName :: forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> Structure -> f Structure
typeName [Char] -> f [Char]
f (Nominal SomeTypeRep
t Word32
v [Char]
n [Structure]
s) = ([Char] -> Structure) -> f [Char] -> f Structure
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Char]
n' -> SomeTypeRep -> Word32 -> [Char] -> [Structure] -> Structure
Nominal SomeTypeRep
t Word32
v [Char]
n' [Structure]
s) ([Char] -> f [Char]
f [Char]
n)
typeName [Char] -> f [Char]
f (Newtype SomeTypeRep
t Word32
v [Char]
n Structure
s) = ([Char] -> Structure) -> f [Char] -> f Structure
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Char]
n' -> SomeTypeRep -> Word32 -> [Char] -> Structure -> Structure
Newtype SomeTypeRep
t Word32
v [Char]
n' Structure
s) ([Char] -> f [Char]
f [Char]
n)
typeName [Char] -> f [Char]
f (Structure SomeTypeRep
t Word32
v [Char]
n [([Char], [Structure])]
s) = ([Char] -> Structure) -> f [Char] -> f Structure
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Char]
n' -> SomeTypeRep
-> Word32 -> [Char] -> [([Char], [Structure])] -> Structure
Structure SomeTypeRep
t Word32
v [Char]
n' [([Char], [Structure])]
s) ([Char] -> f [Char]
f [Char]
n)

-------------------------------------------------------------------------------
-- Builder
-------------------------------------------------------------------------------

-- | Flatten 'Structure' into something we can calculate hash of.
--
-- As 'Structure' can be potentially infinite. For mutually recursive types,
-- we keep track of 'TypeRep's, and put just 'TypeRep' name when it's occurred
-- another time.
structureBuilder :: Structure -> Builder.Builder
structureBuilder :: Structure -> Builder
structureBuilder Structure
s0 = State (Map [Char] (NonEmpty SomeTypeRep)) Builder
-> Map [Char] (NonEmpty SomeTypeRep) -> Builder
forall s a. State s a -> s -> a
State.evalState (Structure -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
go Structure
s0) Map [Char] (NonEmpty SomeTypeRep)
forall k a. Map k a
Map.empty
  where
    go :: Structure -> State.State (Map.Map String (NonEmpty TypeRep)) Builder.Builder
    go :: Structure -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
go (Nominal SomeTypeRep
t Word32
v [Char]
n [Structure]
s) = SomeTypeRep
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
forall {m :: * -> *}.
Monad m =>
SomeTypeRep
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
withTypeRep SomeTypeRep
t (State (Map [Char] (NonEmpty SomeTypeRep)) Builder
 -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder)
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ do
      s' <- (Structure -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder)
-> [Structure]
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) Identity [Builder]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Structure -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
go [Structure]
s
      return $ mconcat $ Builder.word8 1 : Builder.word32LE v : Builder.stringUtf8 n : s'
    go (Newtype SomeTypeRep
t Word32
v [Char]
n Structure
s) = SomeTypeRep
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
forall {m :: * -> *}.
Monad m =>
SomeTypeRep
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
withTypeRep SomeTypeRep
t (State (Map [Char] (NonEmpty SomeTypeRep)) Builder
 -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder)
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ do
      s' <- Structure -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
go Structure
s
      return $ mconcat [Builder.word8 2, Builder.word32LE v, Builder.stringUtf8 n, s']
    go (Structure SomeTypeRep
t Word32
v [Char]
n [([Char], [Structure])]
s) = SomeTypeRep
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
forall {m :: * -> *}.
Monad m =>
SomeTypeRep
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
withTypeRep SomeTypeRep
t (State (Map [Char] (NonEmpty SomeTypeRep)) Builder
 -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder)
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ do
      s' <- [([Char], [Structure])]
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
goSop [([Char], [Structure])]
s
      return $ mconcat [Builder.word8 3, Builder.word32LE v, Builder.stringUtf8 n, s']

    withTypeRep :: SomeTypeRep
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
withTypeRep SomeTypeRep
t StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
k = do
      acc <- StateT
  (Map [Char] (NonEmpty SomeTypeRep))
  m
  (Map [Char] (NonEmpty SomeTypeRep))
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
      case insert t acc of
        Maybe (Map [Char] (NonEmpty SomeTypeRep))
Nothing -> Builder -> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
forall a. a -> StateT (Map [Char] (NonEmpty SomeTypeRep)) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder)
-> Builder -> StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Word8 -> Builder
Builder.word8 Word8
0, [Char] -> Builder
Builder.stringUtf8 (SomeTypeRep -> [Char]
forall a. Show a => a -> [Char]
show SomeTypeRep
t)]
        Just Map [Char] (NonEmpty SomeTypeRep)
acc' -> do
          Map [Char] (NonEmpty SomeTypeRep)
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put Map [Char] (NonEmpty SomeTypeRep)
acc'
          StateT (Map [Char] (NonEmpty SomeTypeRep)) m Builder
k

    goSop :: SopStructure -> State.State (Map.Map String (NonEmpty TypeRep)) Builder.Builder
    goSop :: [([Char], [Structure])]
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
goSop [([Char], [Structure])]
sop = do
      parts <- (([Char], [Structure])
 -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder)
-> [([Char], [Structure])]
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) Identity [Builder]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([Char], [Structure])
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
part [([Char], [Structure])]
sop
      return $ mconcat parts

    part :: ([Char], [Structure])
-> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
part ([Char]
cn, [Structure]
s) = do
      s' <- (Structure -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder)
-> [Structure]
-> StateT (Map [Char] (NonEmpty SomeTypeRep)) Identity [Builder]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Structure -> State (Map [Char] (NonEmpty SomeTypeRep)) Builder
go [Structure]
s
      return $ Data.Monoid.mconcat [Builder.stringUtf8 cn, mconcat s']

    insert :: TypeRep -> Map.Map String (NonEmpty TypeRep) -> Maybe (Map.Map String (NonEmpty TypeRep))
    insert :: SomeTypeRep
-> Map [Char] (NonEmpty SomeTypeRep)
-> Maybe (Map [Char] (NonEmpty SomeTypeRep))
insert SomeTypeRep
tr Map [Char] (NonEmpty SomeTypeRep)
m = case [Char]
-> Map [Char] (NonEmpty SomeTypeRep)
-> Maybe (NonEmpty SomeTypeRep)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
trShown Map [Char] (NonEmpty SomeTypeRep)
m of
      Maybe (NonEmpty SomeTypeRep)
Nothing -> Maybe (Map [Char] (NonEmpty SomeTypeRep))
inserted
      Just NonEmpty SomeTypeRep
ne
        | SomeTypeRep
tr SomeTypeRep -> NonEmpty SomeTypeRep -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Data.Foldable.elem` NonEmpty SomeTypeRep
ne -> Maybe (Map [Char] (NonEmpty SomeTypeRep))
forall a. Maybe a
Nothing
        | Bool
otherwise -> Maybe (Map [Char] (NonEmpty SomeTypeRep))
inserted
      where
        inserted :: Maybe (Map [Char] (NonEmpty SomeTypeRep))
inserted = Map [Char] (NonEmpty SomeTypeRep)
-> Maybe (Map [Char] (NonEmpty SomeTypeRep))
forall a. a -> Maybe a
Just ((NonEmpty SomeTypeRep
 -> NonEmpty SomeTypeRep -> NonEmpty SomeTypeRep)
-> [Char]
-> NonEmpty SomeTypeRep
-> Map [Char] (NonEmpty SomeTypeRep)
-> Map [Char] (NonEmpty SomeTypeRep)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith NonEmpty SomeTypeRep
-> NonEmpty SomeTypeRep -> NonEmpty SomeTypeRep
forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>) [Char]
trShown (SomeTypeRep -> NonEmpty SomeTypeRep
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeTypeRep
tr) Map [Char] (NonEmpty SomeTypeRep)
m)
        trShown :: [Char]
trShown = SomeTypeRep -> [Char]
forall a. Show a => a -> [Char]
show SomeTypeRep
tr

-------------------------------------------------------------------------------
-- Classes
-------------------------------------------------------------------------------

-- | Class of types with a known 'Structure'.
--
-- For regular data types 'Structured' can be derived generically.
--
-- @
-- data Record = Record { a :: Int, b :: Bool, c :: [Char] } deriving ('Generic')
-- instance 'Structured' Record
-- @
--
-- @since 3.2.0.0
class Typeable a => Structured a where
  structure :: Proxy a -> Structure
  default structure :: (Generic a, GStructured (Rep a)) => Proxy a -> Structure
  structure = Proxy a -> Structure
forall a.
(Typeable a, Generic a, GStructured (Rep a)) =>
Proxy a -> Structure
genericStructure

  -- This member is hidden. It's there to precalc
  structureHash' :: Tagged a MD5
  structureHash' = MD5 -> Tagged a MD5
forall {k} (a :: k) b. b -> Tagged a b
Tagged (Structure -> MD5
hashStructure (Proxy a -> Structure
forall a. Structured a => Proxy a -> Structure
structure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)))

-- private Tagged
newtype Tagged a b = Tagged {forall {k} (a :: k) b. Tagged a b -> b
untag :: b}

-- | Semantically @'hashStructure' . 'structure'@.
structureHash :: forall a. Structured a => Proxy a -> MD5
structureHash :: forall a. Structured a => Proxy a -> MD5
structureHash Proxy a
_ = Tagged a MD5 -> MD5
forall {k} (a :: k) b. Tagged a b -> b
untag (Tagged a MD5
forall a. Structured a => Tagged a MD5
structureHash' :: Tagged a MD5)

-------------------------------------------------------------------------------
-- Functions
-------------------------------------------------------------------------------

-- | Structured 'Binary.encode'.
-- Encode a value to using binary serialisation to a lazy 'LBS.ByteString'.
-- Encoding starts with 16 byte large structure hash.
structuredEncode
  :: forall a
   . (Binary.Binary a, Structured a)
  => a
  -> LBS.ByteString
structuredEncode :: forall a. (Binary a, Structured a) => a -> LazyByteString
structuredEncode a
x = (Tag a, a) -> LazyByteString
forall a. Binary a => a -> LazyByteString
Binary.encode (Tag a
forall {k} (a :: k). Tag a
Tag :: Tag a, a
x)

-- | Lazily serialise a value to a file
structuredEncodeFile :: (Binary.Binary a, Structured a) => FilePath -> a -> IO ()
structuredEncodeFile :: forall a. (Binary a, Structured a) => [Char] -> a -> IO ()
structuredEncodeFile [Char]
f = [Char] -> LazyByteString -> IO ()
LBS.writeFile [Char]
f (LazyByteString -> IO ()) -> (a -> LazyByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LazyByteString
forall a. (Binary a, Structured a) => a -> LazyByteString
structuredEncode

-- | Structured 'Binary.decode'.
-- Decode a value from a lazy 'LBS.ByteString', reconstructing the original structure.
-- Throws pure exception on invalid inputs.
structuredDecode
  :: forall a
   . (Binary.Binary a, Structured a)
  => LBS.ByteString
  -> a
structuredDecode :: forall a. (Binary a, Structured a) => LazyByteString -> a
structuredDecode LazyByteString
lbs = (Tag a, a) -> a
forall a b. (a, b) -> b
snd (LazyByteString -> (Tag a, a)
forall a. Binary a => LazyByteString -> a
Binary.decode LazyByteString
lbs :: (Tag a, a))

structuredDecodeOrFailIO :: (Binary.Binary a, Structured a) => LBS.ByteString -> IO (Either String a)
structuredDecodeOrFailIO :: forall a.
(Binary a, Structured a) =>
LazyByteString -> IO (Either [Char] a)
structuredDecodeOrFailIO LazyByteString
bs =
  IO (Either [Char] a)
-> (ErrorCall -> IO (Either [Char] a)) -> IO (Either [Char] a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (a -> IO a
forall a. a -> IO a
evaluate (LazyByteString -> a
forall a. (Binary a, Structured a) => LazyByteString -> a
structuredDecode LazyByteString
bs) IO a -> (a -> IO (Either [Char] a)) -> IO (Either [Char] a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either [Char] a -> IO (Either [Char] a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] a -> IO (Either [Char] a))
-> (a -> Either [Char] a) -> a -> IO (Either [Char] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either [Char] a
forall a b. b -> Either a b
Right) ErrorCall -> IO (Either [Char] a)
forall {m :: * -> *} {b}.
Monad m =>
ErrorCall -> m (Either [Char] b)
handler
  where
    handler :: ErrorCall -> m (Either [Char] b)
handler (ErrorCall [Char]
str) = Either [Char] b -> m (Either [Char] b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] b -> m (Either [Char] b))
-> Either [Char] b -> m (Either [Char] b)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] b
forall a b. a -> Either a b
Left [Char]
str

-- | Lazily reconstruct a value previously written to a file.
structuredDecodeFileOrFail :: (Binary.Binary a, Structured a) => FilePath -> IO (Either String a)
structuredDecodeFileOrFail :: forall a.
(Binary a, Structured a) =>
[Char] -> IO (Either [Char] a)
structuredDecodeFileOrFail [Char]
f = LazyByteString -> IO (Either [Char] a)
forall a.
(Binary a, Structured a) =>
LazyByteString -> IO (Either [Char] a)
structuredDecodeOrFailIO (LazyByteString -> IO (Either [Char] a))
-> IO LazyByteString -> IO (Either [Char] a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO LazyByteString
LBS.readFile [Char]
f

-------------------------------------------------------------------------------
-- Helper data
-------------------------------------------------------------------------------

data Tag a = Tag

instance Structured a => Binary.Binary (Tag a) where
  get :: Get (Tag a)
get = do
    actual <- Get MD5
binaryGetMD5
    if actual == expected
      then return Tag
      else
        fail $
          concat
            [ "Non-matching structured hashes: "
            , showMD5 actual
            , "; expected: "
            , showMD5 expected
            ]
    where
      expected :: MD5
expected = Tagged a MD5 -> MD5
forall {k} (a :: k) b. Tagged a b -> b
untag (Tagged a MD5
forall a. Structured a => Tagged a MD5
structureHash' :: Tagged a MD5)

  put :: Tag a -> Put
put Tag a
_ = MD5 -> Put
binaryPutMD5 MD5
expected
    where
      expected :: MD5
expected = Tagged a MD5 -> MD5
forall {k} (a :: k) b. Tagged a b -> b
untag (Tagged a MD5
forall a. Structured a => Tagged a MD5
structureHash' :: Tagged a MD5)

-------------------------------------------------------------------------------
-- Smart constructors
-------------------------------------------------------------------------------

-- | Use 'Typeable' to infer name
nominalStructure :: Typeable a => Proxy a -> Structure
nominalStructure :: forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure Proxy a
p = SomeTypeRep -> Word32 -> [Char] -> [Structure] -> Structure
Nominal SomeTypeRep
tr Word32
0 (SomeTypeRep -> [Char]
forall a. Show a => a -> [Char]
show SomeTypeRep
tr) []
  where
    tr :: SomeTypeRep
tr = Proxy a -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep Proxy a
p

containerStructure :: forall f a. (Typeable f, Structured a) => Proxy (f a) -> Structure
containerStructure :: forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
containerStructure Proxy (f a)
_ =
  SomeTypeRep -> Word32 -> [Char] -> [Structure] -> Structure
Nominal
    SomeTypeRep
faTypeRep
    Word32
0
    (SomeTypeRep -> [Char]
forall a. Show a => a -> [Char]
show SomeTypeRep
fTypeRep)
    [ Proxy a -> Structure
forall a. Structured a => Proxy a -> Structure
structure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
    ]
  where
    fTypeRep :: SomeTypeRep
fTypeRep = Proxy f -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f)
    faTypeRep :: SomeTypeRep
faTypeRep = Proxy (f a) -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep (Proxy (f a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f a))

-------------------------------------------------------------------------------
-- Generic
-------------------------------------------------------------------------------

-- | Derive 'structure' generically.
genericStructure :: forall a. (Typeable a, Generic a, GStructured (Rep a)) => Proxy a -> Structure
genericStructure :: forall a.
(Typeable a, Generic a, GStructured (Rep a)) =>
Proxy a -> Structure
genericStructure Proxy a
_ = SomeTypeRep -> Proxy (Rep a) -> Word32 -> Structure
forall (f :: * -> *).
GStructured f =>
SomeTypeRep -> Proxy f -> Word32 -> Structure
gstructured (Proxy a -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) (Proxy (Rep a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep a)) Word32
0

-- | Used to implement 'genericStructure'.
class GStructured (f :: Type -> Type) where
  gstructured :: TypeRep -> Proxy f -> TypeVersion -> Structure

instance (i ~ D, Datatype c, GStructuredSum f) => GStructured (M1 i c f) where
  gstructured :: SomeTypeRep -> Proxy (M1 i c f) -> Word32 -> Structure
gstructured SomeTypeRep
tr Proxy (M1 i c f)
_ Word32
v = case [([Char], [Structure])]
sop of
    [([Char]
_, [Structure
s])] | M1 i c f () -> Bool
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> Bool
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Bool
isNewtype M1 i c f ()
p -> SomeTypeRep -> Word32 -> [Char] -> Structure -> Structure
Newtype SomeTypeRep
tr Word32
v [Char]
name Structure
s
    [([Char], [Structure])]
_ -> SomeTypeRep
-> Word32 -> [Char] -> [([Char], [Structure])] -> Structure
Structure SomeTypeRep
tr Word32
v [Char]
name [([Char], [Structure])]
sop
    where
      p :: M1 i c f ()
p = M1 i c f ()
forall a. HasCallStack => a
undefined :: M1 i c f ()
      name :: [Char]
name = M1 i c f () -> [Char]
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
datatypeName M1 i c f ()
p
      sop :: [([Char], [Structure])]
sop = Proxy f -> [([Char], [Structure])] -> [([Char], [Structure])]
forall (f :: * -> *).
GStructuredSum f =>
Proxy f -> [([Char], [Structure])] -> [([Char], [Structure])]
gstructuredSum (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f) []

class GStructuredSum (f :: Type -> Type) where
  gstructuredSum :: Proxy f -> SopStructure -> SopStructure

instance (i ~ C, Constructor c, GStructuredProd f) => GStructuredSum (M1 i c f) where
  gstructuredSum :: Proxy (M1 i c f)
-> [([Char], [Structure])] -> [([Char], [Structure])]
gstructuredSum Proxy (M1 i c f)
_ [([Char], [Structure])]
xs = ([Char]
name, [Structure]
prod) ([Char], [Structure])
-> [([Char], [Structure])] -> [([Char], [Structure])]
forall a. a -> [a] -> [a]
: [([Char], [Structure])]
xs
    where
      name :: [Char]
name = M1 i c f () -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName (M1 i c f ()
forall a. HasCallStack => a
undefined :: M1 i c f ())
      prod :: [Structure]
prod = Proxy f -> [Structure] -> [Structure]
forall (f :: * -> *).
GStructuredProd f =>
Proxy f -> [Structure] -> [Structure]
gstructuredProd (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f) []

instance (GStructuredSum f, GStructuredSum g) => GStructuredSum (f :+: g) where
  gstructuredSum :: Proxy (f :+: g)
-> [([Char], [Structure])] -> [([Char], [Structure])]
gstructuredSum Proxy (f :+: g)
_ [([Char], [Structure])]
xs =
    Proxy f -> [([Char], [Structure])] -> [([Char], [Structure])]
forall (f :: * -> *).
GStructuredSum f =>
Proxy f -> [([Char], [Structure])] -> [([Char], [Structure])]
gstructuredSum (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f) ([([Char], [Structure])] -> [([Char], [Structure])])
-> [([Char], [Structure])] -> [([Char], [Structure])]
forall a b. (a -> b) -> a -> b
$
      Proxy g -> [([Char], [Structure])] -> [([Char], [Structure])]
forall (f :: * -> *).
GStructuredSum f =>
Proxy f -> [([Char], [Structure])] -> [([Char], [Structure])]
gstructuredSum (Proxy g
forall {k} (t :: k). Proxy t
Proxy :: Proxy g) [([Char], [Structure])]
xs

instance GStructuredSum V1 where
  gstructuredSum :: Proxy V1 -> [([Char], [Structure])] -> [([Char], [Structure])]
gstructuredSum Proxy V1
_ = [([Char], [Structure])] -> [([Char], [Structure])]
forall a. a -> a
id

class GStructuredProd (f :: Type -> Type) where
  gstructuredProd :: Proxy f -> [Structure] -> [Structure]

instance (i ~ S, GStructuredProd f) => GStructuredProd (M1 i c f) where
  gstructuredProd :: Proxy (M1 i c f) -> [Structure] -> [Structure]
gstructuredProd Proxy (M1 i c f)
_ = Proxy f -> [Structure] -> [Structure]
forall (f :: * -> *).
GStructuredProd f =>
Proxy f -> [Structure] -> [Structure]
gstructuredProd (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

instance Structured c => GStructuredProd (K1 i c) where
  gstructuredProd :: Proxy (K1 i c) -> [Structure] -> [Structure]
gstructuredProd Proxy (K1 i c)
_ [Structure]
xs = Proxy c -> Structure
forall a. Structured a => Proxy a -> Structure
structure (Proxy c
forall {k} (t :: k). Proxy t
Proxy :: Proxy c) Structure -> [Structure] -> [Structure]
forall a. a -> [a] -> [a]
: [Structure]
xs

instance GStructuredProd U1 where
  gstructuredProd :: Proxy U1 -> [Structure] -> [Structure]
gstructuredProd Proxy U1
_ = [Structure] -> [Structure]
forall a. a -> a
id

instance (GStructuredProd f, GStructuredProd g) => GStructuredProd (f :*: g) where
  gstructuredProd :: Proxy (f :*: g) -> [Structure] -> [Structure]
gstructuredProd Proxy (f :*: g)
_ [Structure]
xs =
    Proxy f -> [Structure] -> [Structure]
forall (f :: * -> *).
GStructuredProd f =>
Proxy f -> [Structure] -> [Structure]
gstructuredProd (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f) ([Structure] -> [Structure]) -> [Structure] -> [Structure]
forall a b. (a -> b) -> a -> b
$
      Proxy g -> [Structure] -> [Structure]
forall (f :: * -> *).
GStructuredProd f =>
Proxy f -> [Structure] -> [Structure]
gstructuredProd (Proxy g
forall {k} (t :: k). Proxy t
Proxy :: Proxy g) [Structure]
xs

-------------------------------------------------------------------------------
-- instances
-------------------------------------------------------------------------------

instance Structured ()
instance Structured Bool
instance Structured Ordering

instance Structured Char where structure :: Proxy Char -> Structure
structure = Proxy Char -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Int where structure :: Proxy Int -> Structure
structure = Proxy Int -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Integer where structure :: Proxy Integer -> Structure
structure = Proxy Integer -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure

instance Structured Data.Word.Word where structure :: Proxy Word -> Structure
structure = Proxy Word -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure

instance Structured Int8 where structure :: Proxy Int8 -> Structure
structure = Proxy Int8 -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Int16 where structure :: Proxy Int16 -> Structure
structure = Proxy Int16 -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Int32 where structure :: Proxy Int32 -> Structure
structure = Proxy Int32 -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Int64 where structure :: Proxy Int64 -> Structure
structure = Proxy Int64 -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure

instance Structured Word8 where structure :: Proxy Word8 -> Structure
structure = Proxy Word8 -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Word16 where structure :: Proxy Word16 -> Structure
structure = Proxy Word16 -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Word32 where structure :: Proxy Word32 -> Structure
structure = Proxy Word32 -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Word64 where structure :: Proxy Word64 -> Structure
structure = Proxy Word64 -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure

instance Structured Float where structure :: Proxy Float -> Structure
structure = Proxy Float -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Double where structure :: Proxy Double -> Structure
structure = Proxy Double -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure

instance Structured a => Structured (Maybe a)
instance Structured a => Structured (Last a)
instance (Structured a, Structured b) => Structured (Either a b)
instance Structured a => Structured (Ratio a) where structure :: Proxy (Ratio a) -> Structure
structure = Proxy (Ratio a) -> Structure
forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
containerStructure
instance Structured a => Structured [a] where structure :: Proxy [a] -> Structure
structure = Proxy [a] -> Structure
forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
containerStructure
instance Structured a => Structured (NonEmpty a) where structure :: Proxy (NonEmpty a) -> Structure
structure = Proxy (NonEmpty a) -> Structure
forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
containerStructure

-- These instances are defined directly because the generic names for tuples changed
-- in 9.6 (https://gitlab.haskell.org/ghc/ghc/-/issues/24291).
--
-- By defining our own instances the STuple2 identifier will be used in the hash and
-- hence the same on all GHC versions.

data STuple2 a b = STuple2 a b deriving ((forall x. STuple2 a b -> Rep (STuple2 a b) x)
-> (forall x. Rep (STuple2 a b) x -> STuple2 a b)
-> Generic (STuple2 a b)
forall x. Rep (STuple2 a b) x -> STuple2 a b
forall x. STuple2 a b -> Rep (STuple2 a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (STuple2 a b) x -> STuple2 a b
forall a b x. STuple2 a b -> Rep (STuple2 a b) x
$cfrom :: forall a b x. STuple2 a b -> Rep (STuple2 a b) x
from :: forall x. STuple2 a b -> Rep (STuple2 a b) x
$cto :: forall a b x. Rep (STuple2 a b) x -> STuple2 a b
to :: forall x. Rep (STuple2 a b) x -> STuple2 a b
Generic)
data STuple3 a b c = STuple3 a b c deriving ((forall x. STuple3 a b c -> Rep (STuple3 a b c) x)
-> (forall x. Rep (STuple3 a b c) x -> STuple3 a b c)
-> Generic (STuple3 a b c)
forall x. Rep (STuple3 a b c) x -> STuple3 a b c
forall x. STuple3 a b c -> Rep (STuple3 a b c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c x. Rep (STuple3 a b c) x -> STuple3 a b c
forall a b c x. STuple3 a b c -> Rep (STuple3 a b c) x
$cfrom :: forall a b c x. STuple3 a b c -> Rep (STuple3 a b c) x
from :: forall x. STuple3 a b c -> Rep (STuple3 a b c) x
$cto :: forall a b c x. Rep (STuple3 a b c) x -> STuple3 a b c
to :: forall x. Rep (STuple3 a b c) x -> STuple3 a b c
Generic)
data STuple4 a b c d = STuple4 a b c d deriving ((forall x. STuple4 a b c d -> Rep (STuple4 a b c d) x)
-> (forall x. Rep (STuple4 a b c d) x -> STuple4 a b c d)
-> Generic (STuple4 a b c d)
forall x. Rep (STuple4 a b c d) x -> STuple4 a b c d
forall x. STuple4 a b c d -> Rep (STuple4 a b c d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d x. Rep (STuple4 a b c d) x -> STuple4 a b c d
forall a b c d x. STuple4 a b c d -> Rep (STuple4 a b c d) x
$cfrom :: forall a b c d x. STuple4 a b c d -> Rep (STuple4 a b c d) x
from :: forall x. STuple4 a b c d -> Rep (STuple4 a b c d) x
$cto :: forall a b c d x. Rep (STuple4 a b c d) x -> STuple4 a b c d
to :: forall x. Rep (STuple4 a b c d) x -> STuple4 a b c d
Generic)
data STuple5 a b c d e = STuple5 a b c d e deriving ((forall x. STuple5 a b c d e -> Rep (STuple5 a b c d e) x)
-> (forall x. Rep (STuple5 a b c d e) x -> STuple5 a b c d e)
-> Generic (STuple5 a b c d e)
forall x. Rep (STuple5 a b c d e) x -> STuple5 a b c d e
forall x. STuple5 a b c d e -> Rep (STuple5 a b c d e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d e x. Rep (STuple5 a b c d e) x -> STuple5 a b c d e
forall a b c d e x. STuple5 a b c d e -> Rep (STuple5 a b c d e) x
$cfrom :: forall a b c d e x. STuple5 a b c d e -> Rep (STuple5 a b c d e) x
from :: forall x. STuple5 a b c d e -> Rep (STuple5 a b c d e) x
$cto :: forall a b c d e x. Rep (STuple5 a b c d e) x -> STuple5 a b c d e
to :: forall x. Rep (STuple5 a b c d e) x -> STuple5 a b c d e
Generic)
data STuple6 a b c d e f = STuple6 a b c d e f deriving ((forall x. STuple6 a b c d e f -> Rep (STuple6 a b c d e f) x)
-> (forall x. Rep (STuple6 a b c d e f) x -> STuple6 a b c d e f)
-> Generic (STuple6 a b c d e f)
forall x. Rep (STuple6 a b c d e f) x -> STuple6 a b c d e f
forall x. STuple6 a b c d e f -> Rep (STuple6 a b c d e f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d e f x.
Rep (STuple6 a b c d e f) x -> STuple6 a b c d e f
forall a b c d e f x.
STuple6 a b c d e f -> Rep (STuple6 a b c d e f) x
$cfrom :: forall a b c d e f x.
STuple6 a b c d e f -> Rep (STuple6 a b c d e f) x
from :: forall x. STuple6 a b c d e f -> Rep (STuple6 a b c d e f) x
$cto :: forall a b c d e f x.
Rep (STuple6 a b c d e f) x -> STuple6 a b c d e f
to :: forall x. Rep (STuple6 a b c d e f) x -> STuple6 a b c d e f
Generic)
data STuple7 a b c d e f g = STuple7 a b c d e f g deriving ((forall x. STuple7 a b c d e f g -> Rep (STuple7 a b c d e f g) x)
-> (forall x.
    Rep (STuple7 a b c d e f g) x -> STuple7 a b c d e f g)
-> Generic (STuple7 a b c d e f g)
forall x. Rep (STuple7 a b c d e f g) x -> STuple7 a b c d e f g
forall x. STuple7 a b c d e f g -> Rep (STuple7 a b c d e f g) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d e f g x.
Rep (STuple7 a b c d e f g) x -> STuple7 a b c d e f g
forall a b c d e f g x.
STuple7 a b c d e f g -> Rep (STuple7 a b c d e f g) x
$cfrom :: forall a b c d e f g x.
STuple7 a b c d e f g -> Rep (STuple7 a b c d e f g) x
from :: forall x. STuple7 a b c d e f g -> Rep (STuple7 a b c d e f g) x
$cto :: forall a b c d e f g x.
Rep (STuple7 a b c d e f g) x -> STuple7 a b c d e f g
to :: forall x. Rep (STuple7 a b c d e f g) x -> STuple7 a b c d e f g
Generic)

instance (Structured a1, Structured a2) => Structured (STuple2 a1 a2)
instance (Structured a1, Structured a2) => Structured (a1, a2) where
  structure :: Proxy (a1, a2) -> Structure
structure Proxy (a1, a2)
Proxy = forall a. Structured a => Proxy a -> Structure
structure @(STuple2 a1 a2) Proxy (STuple2 a1 a2)
forall {k} (t :: k). Proxy t
Proxy

instance (Structured a1, Structured a2, Structured a3) => Structured (STuple3 a1 a2 a3)
instance (Structured a1, Structured a2, Structured a3) => Structured (a1, a2, a3) where
  structure :: Proxy (a1, a2, a3) -> Structure
structure Proxy (a1, a2, a3)
Proxy = forall a. Structured a => Proxy a -> Structure
structure @(STuple3 a1 a2 a3) Proxy (STuple3 a1 a2 a3)
forall {k} (t :: k). Proxy t
Proxy

instance (Structured a1, Structured a2, Structured a3, Structured a4) => Structured (STuple4 a1 a2 a3 a4)
instance (Structured a1, Structured a2, Structured a3, Structured a4) => Structured (a1, a2, a3, a4) where
  structure :: Proxy (a1, a2, a3, a4) -> Structure
structure Proxy (a1, a2, a3, a4)
Proxy = forall a. Structured a => Proxy a -> Structure
structure @(STuple4 a1 a2 a3 a4) Proxy (STuple4 a1 a2 a3 a4)
forall {k} (t :: k). Proxy t
Proxy

instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5) => Structured (STuple5 a1 a2 a3 a4 a5)
instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5) => Structured (a1, a2, a3, a4, a5) where
  structure :: Proxy (a1, a2, a3, a4, a5) -> Structure
structure Proxy (a1, a2, a3, a4, a5)
Proxy = forall a. Structured a => Proxy a -> Structure
structure @(STuple5 a1 a2 a3 a4 a5) Proxy (STuple5 a1 a2 a3 a4 a5)
forall {k} (t :: k). Proxy t
Proxy

instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6) => Structured (STuple6 a1 a2 a3 a4 a5 a6)
instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6) => Structured (a1, a2, a3, a4, a5, a6) where
  structure :: Proxy (a1, a2, a3, a4, a5, a6) -> Structure
structure Proxy (a1, a2, a3, a4, a5, a6)
Proxy = forall a. Structured a => Proxy a -> Structure
structure @(STuple6 a1 a2 a3 a4 a5 a6) Proxy (STuple6 a1 a2 a3 a4 a5 a6)
forall {k} (t :: k). Proxy t
Proxy

instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6, Structured a7) => Structured (STuple7 a1 a2 a3 a4 a5 a6 a7)
instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6, Structured a7) => Structured (a1, a2, a3, a4, a5, a6, a7) where
  structure :: Proxy (a1, a2, a3, a4, a5, a6, a7) -> Structure
structure Proxy (a1, a2, a3, a4, a5, a6, a7)
Proxy = forall a. Structured a => Proxy a -> Structure
structure @(STuple7 a1 a2 a3 a4 a5 a6 a7) Proxy (STuple7 a1 a2 a3 a4 a5 a6 a7)
forall {k} (t :: k). Proxy t
Proxy

instance Structured BS.ByteString where structure :: Proxy ByteString -> Structure
structure = Proxy ByteString -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured LBS.ByteString where structure :: Proxy LazyByteString -> Structure
structure = Proxy LazyByteString -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure

instance Structured T.Text where structure :: Proxy Text -> Structure
structure = Proxy Text -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured LT.Text where structure :: Proxy Text -> Structure
structure = Proxy Text -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure

instance (Structured k, Structured v) => Structured (Map.Map k v) where structure :: Proxy (Map k v) -> Structure
structure Proxy (Map k v)
_ = SomeTypeRep -> Word32 -> [Char] -> [Structure] -> Structure
Nominal (Proxy (Map k v) -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep (Proxy (Map k v)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Map.Map k v))) Word32
0 [Char]
"Map" [Proxy k -> Structure
forall a. Structured a => Proxy a -> Structure
structure (Proxy k
forall {k} (t :: k). Proxy t
Proxy :: Proxy k), Proxy v -> Structure
forall a. Structured a => Proxy a -> Structure
structure (Proxy v
forall {k} (t :: k). Proxy t
Proxy :: Proxy v)]
instance Structured k => Structured (Set.Set k) where structure :: Proxy (Set k) -> Structure
structure = Proxy (Set k) -> Structure
forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
containerStructure
instance Structured v => Structured (IM.IntMap v) where structure :: Proxy (IntMap v) -> Structure
structure = Proxy (IntMap v) -> Structure
forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
containerStructure
instance Structured IS.IntSet where structure :: Proxy IntSet -> Structure
structure = Proxy IntSet -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured v => Structured (Seq.Seq v) where structure :: Proxy (Seq v) -> Structure
structure = Proxy (Seq v) -> Structure
forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
containerStructure

instance Structured Time.UTCTime where structure :: Proxy UTCTime -> Structure
structure = Proxy UTCTime -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.DiffTime where structure :: Proxy DiffTime -> Structure
structure = Proxy DiffTime -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.UniversalTime where structure :: Proxy UniversalTime -> Structure
structure = Proxy UniversalTime -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.NominalDiffTime where structure :: Proxy NominalDiffTime -> Structure
structure = Proxy NominalDiffTime -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.Day where structure :: Proxy Day -> Structure
structure = Proxy Day -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.TimeZone where structure :: Proxy TimeZone -> Structure
structure = Proxy TimeZone -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.TimeOfDay where structure :: Proxy TimeOfDay -> Structure
structure = Proxy TimeOfDay -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.LocalTime where structure :: Proxy LocalTime -> Structure
structure = Proxy LocalTime -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure