{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
#if __GLASGOW_HASKELL__ >= 711
{-# LANGUAGE PatternSynonyms     #-}
#endif
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE TypeInType          #-}
#endif
-- |
--
-- Copyright: (c) 2019 Oleg Grenrus
--
-- Structurally tag binary serialisaton 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 (..),
    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
import qualified Data.ByteString.Lazy.Builder as Builder
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

#if __GLASGOW_HASKELL__ >= 800
import Data.Kind (Type)
#else
#define Type *
#endif

import Distribution.Compat.Typeable (Typeable, TypeRep, typeRep)
import Distribution.Utils.MD5

import Data.Monoid (mconcat)

import qualified Data.Semigroup
import qualified Data.Foldable

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (pure)
import Data.Traversable (traverse)
#endif

#if !MIN_VERSION_base(4,7,0)
import Data.Typeable (Typeable1, typeOf1)
#endif


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

type TypeName        = String
type ConstructorName = String

-- | A sematic 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   !TypeRep !TypeVersion TypeName [Structure]  -- ^ nominal, yet can be parametrised by other structures.
    | Newtype   !TypeRep !TypeVersion TypeName Structure    -- ^ a newtype wrapper
    | Structure !TypeRep !TypeVersion TypeName SopStructure -- ^ sum-of-products structure
  deriving (Structure -> Structure -> Bool
(Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool) -> Eq Structure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Structure -> Structure -> Bool
$c/= :: Structure -> Structure -> Bool
== :: Structure -> Structure -> Bool
$c== :: Structure -> Structure -> Bool
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type Eq Char
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
Instance of class: Eq of the constraint type Eq Structure
Instance of class: Eq of the constraint type Eq Structure
External instance of the constraint type forall a. Eq a => Eq [a]
Instance of class: Eq of the constraint type Eq Structure
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Eq Word32
External instance of the constraint type Eq Word32
External instance of the constraint type Eq TypeRep
Instance of class: Eq of the constraint type Eq Structure
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
min :: Structure -> Structure -> Structure
$cmin :: Structure -> Structure -> Structure
max :: Structure -> Structure -> Structure
$cmax :: Structure -> Structure -> Structure
>= :: Structure -> Structure -> Bool
$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
compare :: Structure -> Structure -> Ordering
$ccompare :: Structure -> Structure -> Ordering
External instance of the constraint type forall a b. (Ord a, Ord b) => Ord (a, b)
External instance of the constraint type forall a b. (Ord a, Ord b) => Ord (a, b)
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
Instance of class: Ord of the constraint type Ord Structure
Instance of class: Ord of the constraint type Ord Structure
External instance of the constraint type forall a. Ord a => Ord [a]
Instance of class: Ord of the constraint type Ord Structure
External instance of the constraint type Ord Word32
External instance of the constraint type Ord TypeRep
External instance of the constraint type forall a b. (Ord a, Ord b) => Ord (a, b)
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
Instance of class: Ord of the constraint type Ord Structure
Instance of class: Ord of the constraint type Ord Structure
External instance of the constraint type forall a. Ord a => Ord [a]
Instance of class: Ord of the constraint type Ord Structure
External instance of the constraint type Ord Word32
External instance of the constraint type Ord Word32
External instance of the constraint type Ord TypeRep
External instance of the constraint type Ord TypeRep
Instance of class: Eq of the constraint type Eq Structure
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Instance of class: Ord of the constraint type Ord Structure
Instance of class: Eq of the constraint type Eq Structure
Ord, Int -> Structure -> ShowS
[Structure] -> ShowS
Structure -> String
(Int -> Structure -> ShowS)
-> (Structure -> String)
-> ([Structure] -> ShowS)
-> Show Structure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Structure] -> ShowS
$cshowList :: [Structure] -> ShowS
show :: Structure -> String
$cshow :: Structure -> String
showsPrec :: Int -> Structure -> ShowS
$cshowsPrec :: Int -> Structure -> ShowS
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show Char
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
Instance of class: Show of the constraint type Show Structure
Instance of class: Show of the constraint type Show Structure
External instance of the constraint type forall a. Show a => Show [a]
Instance of class: Show of the constraint type Show Structure
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Show Word32
External instance of the constraint type Show Word32
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
External instance of the constraint type Show TypeRep
Instance of class: Show of the constraint type Show Structure
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
$cto :: forall x. Rep Structure x -> Structure
$cfrom :: forall x. Structure -> Rep Structure x
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
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (Structure -> ByteString) -> Structure -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Structure -> Builder) -> Structure -> ByteString
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 :: (Word32 -> f Word32) -> Structure -> f Structure
typeVersion Word32 -> f Word32
f (Nominal   TypeRep
t Word32
v String
n [Structure]
s) = (Word32 -> Structure) -> f Word32 -> f Structure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
fmap (\Word32
v' -> TypeRep -> Word32 -> String -> [Structure] -> Structure
Nominal   TypeRep
t Word32
v' String
n [Structure]
s) (Word32 -> f Word32
f Word32
v)
typeVersion Word32 -> f Word32
f (Newtype   TypeRep
t Word32
v String
n Structure
s) = (Word32 -> Structure) -> f Word32 -> f Structure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
fmap (\Word32
v' -> TypeRep -> Word32 -> String -> Structure -> Structure
Newtype   TypeRep
t Word32
v' String
n Structure
s) (Word32 -> f Word32
f Word32
v)
typeVersion Word32 -> f Word32
f (Structure TypeRep
t Word32
v String
n SopStructure
s) = (Word32 -> Structure) -> f Word32 -> f Structure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
fmap (\Word32
v' -> TypeRep -> Word32 -> String -> SopStructure -> Structure
Structure TypeRep
t Word32
v' String
n SopStructure
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 :: (String -> f String) -> Structure -> f Structure
typeName String -> f String
f (Nominal   TypeRep
t Word32
v String
n [Structure]
s) = (String -> Structure) -> f String -> f Structure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
fmap (\String
n' -> TypeRep -> Word32 -> String -> [Structure] -> Structure
Nominal   TypeRep
t Word32
v String
n' [Structure]
s) (String -> f String
f String
n)
typeName String -> f String
f (Newtype   TypeRep
t Word32
v String
n Structure
s) = (String -> Structure) -> f String -> f Structure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
fmap (\String
n' -> TypeRep -> Word32 -> String -> Structure -> Structure
Newtype   TypeRep
t Word32
v String
n' Structure
s) (String -> f String
f String
n)
typeName String -> f String
f (Structure TypeRep
t Word32
v String
n SopStructure
s) = (String -> Structure) -> f String -> f Structure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
fmap (\String
n' -> TypeRep -> Word32 -> String -> SopStructure -> Structure
Structure TypeRep
t Word32
v String
n' SopStructure
s) (String -> f String
f String
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 String (NonEmpty TypeRep)) Builder
-> Map String (NonEmpty TypeRep) -> Builder
forall s a. State s a -> s -> a
State.evalState (Structure -> State (Map String (NonEmpty TypeRep)) Builder
go Structure
s0) Map String (NonEmpty TypeRep)
forall k a. Map k a
Map.empty where
    go :: Structure -> State.State (Map.Map String (NonEmpty TypeRep)) Builder.Builder
    go :: Structure -> State (Map String (NonEmpty TypeRep)) Builder
go (Nominal   TypeRep
t Word32
v String
n [Structure]
s) = TypeRep
-> State (Map String (NonEmpty TypeRep)) Builder
-> State (Map String (NonEmpty TypeRep)) Builder
forall {m :: * -> *}.
Monad m =>
TypeRep
-> StateT (Map String (NonEmpty TypeRep)) m Builder
-> StateT (Map String (NonEmpty TypeRep)) m Builder
External instance of the constraint type Monad Identity
withTypeRep TypeRep
t (State (Map String (NonEmpty TypeRep)) Builder
 -> State (Map String (NonEmpty TypeRep)) Builder)
-> State (Map String (NonEmpty TypeRep)) Builder
-> State (Map String (NonEmpty TypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ do
        [Builder]
s' <- (Structure -> State (Map String (NonEmpty TypeRep)) Builder)
-> [Structure]
-> StateT (Map String (NonEmpty TypeRep)) Identity [Builder]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
External instance of the constraint type forall (m :: * -> *) s.
(Functor m, Monad m) =>
Applicative (StateT s m)
External instance of the constraint type Functor Identity
External instance of the constraint type Monad Identity
External instance of the constraint type Traversable []
traverse Structure -> State (Map String (NonEmpty TypeRep)) Builder
go [Structure]
s
        Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *) s. Monad m => Monad (StateT s m)
External instance of the constraint type Monad Identity
return (Builder -> State (Map String (NonEmpty TypeRep)) Builder)
-> Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
External instance of the constraint type Monoid Builder
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
Builder.word8 Word8
1 Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Word32 -> Builder
Builder.word32LE Word32
v Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:  String -> Builder
Builder.stringUtf8 String
n Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
s'

    go (Newtype   TypeRep
t Word32
v String
n Structure
s) = TypeRep
-> State (Map String (NonEmpty TypeRep)) Builder
-> State (Map String (NonEmpty TypeRep)) Builder
forall {m :: * -> *}.
Monad m =>
TypeRep
-> StateT (Map String (NonEmpty TypeRep)) m Builder
-> StateT (Map String (NonEmpty TypeRep)) m Builder
External instance of the constraint type Monad Identity
withTypeRep TypeRep
t (State (Map String (NonEmpty TypeRep)) Builder
 -> State (Map String (NonEmpty TypeRep)) Builder)
-> State (Map String (NonEmpty TypeRep)) Builder
-> State (Map String (NonEmpty TypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ do
        Builder
s' <- Structure -> State (Map String (NonEmpty TypeRep)) Builder
go Structure
s
        Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *) s. Monad m => Monad (StateT s m)
External instance of the constraint type Monad Identity
return (Builder -> State (Map String (NonEmpty TypeRep)) Builder)
-> Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
External instance of the constraint type Monoid Builder
mconcat [Word8 -> Builder
Builder.word8 Word8
2, Word32 -> Builder
Builder.word32LE Word32
v, String -> Builder
Builder.stringUtf8 String
n, Builder
s']

    go (Structure TypeRep
t Word32
v String
n SopStructure
s) = TypeRep
-> State (Map String (NonEmpty TypeRep)) Builder
-> State (Map String (NonEmpty TypeRep)) Builder
forall {m :: * -> *}.
Monad m =>
TypeRep
-> StateT (Map String (NonEmpty TypeRep)) m Builder
-> StateT (Map String (NonEmpty TypeRep)) m Builder
External instance of the constraint type Monad Identity
withTypeRep TypeRep
t (State (Map String (NonEmpty TypeRep)) Builder
 -> State (Map String (NonEmpty TypeRep)) Builder)
-> State (Map String (NonEmpty TypeRep)) Builder
-> State (Map String (NonEmpty TypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ do
        Builder
s' <- SopStructure -> State (Map String (NonEmpty TypeRep)) Builder
goSop SopStructure
s
        Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *) s. Monad m => Monad (StateT s m)
External instance of the constraint type Monad Identity
return (Builder -> State (Map String (NonEmpty TypeRep)) Builder)
-> Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
External instance of the constraint type Monoid Builder
mconcat [Word8 -> Builder
Builder.word8 Word8
3, Word32 -> Builder
Builder.word32LE Word32
v, String -> Builder
Builder.stringUtf8 String
n, Builder
s']

    withTypeRep :: TypeRep
-> StateT (Map String (NonEmpty TypeRep)) m Builder
-> StateT (Map String (NonEmpty TypeRep)) m Builder
withTypeRep TypeRep
t StateT (Map String (NonEmpty TypeRep)) m Builder
k = do
        Map String (NonEmpty TypeRep)
acc <- StateT
  (Map String (NonEmpty TypeRep)) m (Map String (NonEmpty TypeRep))
forall (m :: * -> *) s. Monad m => StateT s m s
Evidence bound by a type signature of the constraint type Monad m
State.get
        case TypeRep
-> Map String (NonEmpty TypeRep)
-> Maybe (Map String (NonEmpty TypeRep))
insert TypeRep
t Map String (NonEmpty TypeRep)
acc of
            Maybe (Map String (NonEmpty TypeRep))
Nothing -> Builder -> StateT (Map String (NonEmpty TypeRep)) m Builder
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *) s. Monad m => Monad (StateT s m)
Evidence bound by a type signature of the constraint type Monad m
return (Builder -> StateT (Map String (NonEmpty TypeRep)) m Builder)
-> Builder -> StateT (Map String (NonEmpty TypeRep)) m Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
External instance of the constraint type Monoid Builder
mconcat [ Word8 -> Builder
Builder.word8 Word8
0, String -> Builder
Builder.stringUtf8 (TypeRep -> String
forall a. Show a => a -> String
External instance of the constraint type Show TypeRep
show TypeRep
t) ]
            Just Map String (NonEmpty TypeRep)
acc' -> do
                Map String (NonEmpty TypeRep)
-> StateT (Map String (NonEmpty TypeRep)) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Evidence bound by a type signature of the constraint type Monad m
State.put Map String (NonEmpty TypeRep)
acc'
                StateT (Map String (NonEmpty TypeRep)) m Builder
k 

    goSop :: SopStructure -> State.State (Map.Map String (NonEmpty TypeRep)) Builder.Builder
    goSop :: SopStructure -> State (Map String (NonEmpty TypeRep)) Builder
goSop SopStructure
sop = do
        [Builder]
parts <- ((String, [Structure])
 -> State (Map String (NonEmpty TypeRep)) Builder)
-> SopStructure
-> StateT (Map String (NonEmpty TypeRep)) Identity [Builder]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
External instance of the constraint type forall (m :: * -> *) s.
(Functor m, Monad m) =>
Applicative (StateT s m)
External instance of the constraint type Functor Identity
External instance of the constraint type Monad Identity
External instance of the constraint type Traversable []
traverse (String, [Structure])
-> State (Map String (NonEmpty TypeRep)) Builder
part SopStructure
sop
        Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *) s. Monad m => Monad (StateT s m)
External instance of the constraint type Monad Identity
return (Builder -> State (Map String (NonEmpty TypeRep)) Builder)
-> Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
External instance of the constraint type Monoid Builder
mconcat [Builder]
parts

    part :: (String, [Structure])
-> State (Map String (NonEmpty TypeRep)) Builder
part (String
cn, [Structure]
s) = do
        [Builder]
s' <- (Structure -> State (Map String (NonEmpty TypeRep)) Builder)
-> [Structure]
-> StateT (Map String (NonEmpty TypeRep)) Identity [Builder]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
External instance of the constraint type forall (m :: * -> *) s.
(Functor m, Monad m) =>
Applicative (StateT s m)
External instance of the constraint type Functor Identity
External instance of the constraint type Monad Identity
External instance of the constraint type Traversable []
traverse Structure -> State (Map String (NonEmpty TypeRep)) Builder
go [Structure]
s
        Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *) s. Monad m => Monad (StateT s m)
External instance of the constraint type Monad Identity
return (Builder -> State (Map String (NonEmpty TypeRep)) Builder)
-> Builder -> State (Map String (NonEmpty TypeRep)) Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
External instance of the constraint type Monoid Builder
Data.Monoid.mconcat [ String -> Builder
Builder.stringUtf8 String
cn, [Builder] -> Builder
forall a. Monoid a => [a] -> a
External instance of the constraint type Monoid Builder
mconcat [Builder]
s' ]

    insert :: TypeRep -> Map.Map String (NonEmpty TypeRep) -> Maybe (Map.Map String (NonEmpty TypeRep))
    insert :: TypeRep
-> Map String (NonEmpty TypeRep)
-> Maybe (Map String (NonEmpty TypeRep))
insert TypeRep
tr Map String (NonEmpty TypeRep)
m = case String -> Map String (NonEmpty TypeRep) -> Maybe (NonEmpty TypeRep)
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.lookup String
trShown Map String (NonEmpty TypeRep)
m of
        Maybe (NonEmpty TypeRep)
Nothing                              -> Maybe (Map String (NonEmpty TypeRep))
inserted
        Just NonEmpty TypeRep
ne | TypeRep
tr TypeRep -> NonEmpty TypeRep -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq TypeRep
External instance of the constraint type Foldable NonEmpty
`Data.Foldable.elem` NonEmpty TypeRep
ne -> Maybe (Map String (NonEmpty TypeRep))
forall a. Maybe a
Nothing
                | Bool
otherwise                  -> Maybe (Map String (NonEmpty TypeRep))
inserted
      where
        inserted :: Maybe (Map String (NonEmpty TypeRep))
inserted = Map String (NonEmpty TypeRep)
-> Maybe (Map String (NonEmpty TypeRep))
forall a. a -> Maybe a
Just ((NonEmpty TypeRep -> NonEmpty TypeRep -> NonEmpty TypeRep)
-> String
-> NonEmpty TypeRep
-> Map String (NonEmpty TypeRep)
-> Map String (NonEmpty TypeRep)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.insertWith NonEmpty TypeRep -> NonEmpty TypeRep -> NonEmpty TypeRep
forall a. Semigroup a => a -> a -> a
External instance of the constraint type forall a. Semigroup (NonEmpty a)
(Data.Semigroup.<>) String
trShown (TypeRep -> NonEmpty TypeRep
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative NonEmpty
pure TypeRep
tr) Map String (NonEmpty TypeRep)
m)
        trShown :: String
trShown  = TypeRep -> String
forall a. Show a => a -> String
External instance of the constraint type Show TypeRep
show TypeRep
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
Evidence bound by a type signature of the constraint type GStructured (Rep a)
Evidence bound by a type signature of the constraint type Generic a
Evidence bound by a superclass of: Structured of the constraint type forall a. Structured a => Typeable a
Evidence bound by a type signature of the constraint type Structured a
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
Evidence bound by a type signature of the constraint type Structured a
structure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)))

-- private Tagged
newtype Tagged a b = Tagged { Tagged a b -> b
untag :: b }

-- | Semantically @'hashStructure' . 'structure'@.
structureHash :: forall a. Structured a => Proxy a -> MD5
structureHash :: 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
Evidence bound by a type signature of the constraint type Structured a
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 :: a -> ByteString
structuredEncode a
x = (Tag a, a) -> ByteString
forall a. Binary a => a -> ByteString
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
Instance of class: Binary of the constraint type forall a. Structured a => Binary (Tag a)
Evidence bound by a type signature of the constraint type Structured a
Evidence bound by a type signature of the constraint type Binary a
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 :: String -> a -> IO ()
structuredEncodeFile String
f = String -> ByteString -> IO ()
LBS.writeFile String
f (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. (Binary a, Structured a) => a -> ByteString
Evidence bound by a type signature of the constraint type Structured a
Evidence bound by a type signature of the constraint type Binary a
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 :: ByteString -> a
structuredDecode ByteString
lbs = (Tag a, a) -> a
forall a b. (a, b) -> b
snd (ByteString -> (Tag a, a)
forall a. Binary a => ByteString -> a
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
Instance of class: Binary of the constraint type forall a. Structured a => Binary (Tag a)
Evidence bound by a type signature of the constraint type Structured a
Evidence bound by a type signature of the constraint type Binary a
Binary.decode ByteString
lbs :: (Tag a, a))

structuredDecodeOrFailIO :: (Binary.Binary a, Structured a) => LBS.ByteString -> IO (Either String a)
structuredDecodeOrFailIO :: ByteString -> IO (Either String a)
structuredDecodeOrFailIO ByteString
bs =
    IO (Either String a)
-> (ErrorCall -> IO (Either String a)) -> IO (Either String a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
External instance of the constraint type Exception ErrorCall
catch (a -> IO a
forall a. a -> IO a
evaluate (ByteString -> a
forall a. (Binary a, Structured a) => ByteString -> a
Evidence bound by a type signature of the constraint type Structured a
Evidence bound by a type signature of the constraint type Binary a
structuredDecode ByteString
bs) IO a -> (a -> IO (Either String a)) -> IO (Either String a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad IO
>>= Either String a -> IO (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Either String a -> IO (Either String a))
-> (a -> Either String a) -> a -> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String a
forall a b. b -> Either a b
Right) ErrorCall -> IO (Either String a)
forall {m :: * -> *} {b}.
Monad m =>
ErrorCall -> m (Either String b)
External instance of the constraint type Monad IO
handler
  where
#if MIN_VERSION_base(4,9,0)
    handler :: ErrorCall -> m (Either String b)
handler (ErrorCallWithLocation String
str String
_) = Either String b -> m (Either String b)
forall (m :: * -> *) a. Monad m => a -> m a
Evidence bound by a type signature of the constraint type Monad m
return (Either String b -> m (Either String b))
-> Either String b -> m (Either String b)
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a b. a -> Either a b
Left String
str
#else
    handler (ErrorCall str) = return $ Left str
#endif

-- | Lazily reconstruct a value previously written to a file.
structuredDecodeFileOrFail :: (Binary.Binary a, Structured a) => FilePath -> IO (Either String a)
structuredDecodeFileOrFail :: String -> IO (Either String a)
structuredDecodeFileOrFail String
f = ByteString -> IO (Either String a)
forall a.
(Binary a, Structured a) =>
ByteString -> IO (Either String a)
Evidence bound by a type signature of the constraint type Structured a
Evidence bound by a type signature of the constraint type Binary a
structuredDecodeOrFailIO (ByteString -> IO (Either String a))
-> IO ByteString -> IO (Either String a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
External instance of the constraint type Monad IO
=<< String -> IO ByteString
LBS.readFile String
f

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

data Tag a = Tag

instance Structured a => Binary.Binary (Tag a) where
    get :: Get (Tag a)
get = do
        MD5
actual <- Get MD5
binaryGetMD5
        if MD5
actual MD5 -> MD5 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq MD5
== MD5
expected
        then Tag a -> Get (Tag a)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Get
return Tag a
forall {k} (a :: k). Tag a
Tag
        else String -> Get (Tag a)
forall (m :: * -> *) a. MonadFail m => String -> m a
External instance of the constraint type MonadFail Get
fail (String -> Get (Tag a)) -> String -> Get (Tag a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
concat
            [ String
"Non-matching structured hashes: "
            , MD5 -> String
showMD5 MD5
actual
            , String
"; expected: "
            , MD5 -> String
showMD5 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
Evidence bound by a type signature of the constraint type Structured a
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
Evidence bound by a type signature of the constraint type Structured a
structureHash' :: Tagged a MD5)

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

-- | Use 'Typeable' to infer name
nominalStructure :: Typeable a => Proxy a -> Structure
nominalStructure :: Proxy a -> Structure
nominalStructure Proxy a
p = TypeRep -> Word32 -> String -> [Structure] -> Structure
Nominal TypeRep
tr Word32
0 (TypeRep -> String
forall a. Show a => a -> String
External instance of the constraint type Show TypeRep
show TypeRep
tr) [] where
    tr :: TypeRep
tr = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Evidence bound by a type signature of the constraint type Typeable a
typeRep Proxy a
p

#if MIN_VERSION_base(4,7,0)
containerStructure :: forall f a. (Typeable f, Structured a) => Proxy (f a) -> Structure
containerStructure :: Proxy (f a) -> Structure
containerStructure Proxy (f a)
_ = TypeRep -> Word32 -> String -> [Structure] -> Structure
Nominal TypeRep
faTypeRep Word32
0 (TypeRep -> String
forall a. Show a => a -> String
External instance of the constraint type Show TypeRep
show TypeRep
fTypeRep)
    [ Proxy a -> Structure
forall a. Structured a => Proxy a -> Structure
Evidence bound by a type signature of the constraint type Structured a
structure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
    ]
  where
    fTypeRep :: TypeRep
fTypeRep  = Proxy f -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Evidence bound by a type signature of the constraint type Typeable f
typeRep (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f)
    faTypeRep :: TypeRep
faTypeRep = Proxy (f a) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Evidence bound by a type signature of the constraint type Typeable f
Evidence bound by a superclass of: Structured of the constraint type forall a. Structured a => Typeable a
Evidence bound by a type signature of the constraint type Structured a
typeRep (Proxy (f a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f a))

#else
containerStructure :: forall f a. (Typeable1 f, Structured a) => Proxy (f a) -> Structure
containerStructure _ = Nominal faTypeRep 0 (show fTypeRep)
    [ structure (Proxy :: Proxy a)
    ]
  where
    fTypeRep  = typeOf1 (undefined :: f ())
    faTypeRep = typeRep (Proxy :: Proxy (f a))
#endif

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

-- | Derive 'structure' genrically.
genericStructure :: forall a. (Typeable a, Generic a, GStructured (Rep a)) => Proxy a -> Structure
genericStructure :: Proxy a -> Structure
genericStructure Proxy a
_ = TypeRep -> Proxy (Rep a) -> Word32 -> Structure
forall (f :: * -> *).
GStructured f =>
TypeRep -> Proxy f -> Word32 -> Structure
Evidence bound by a type signature of the constraint type GStructured (Rep a)
gstructured (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Evidence bound by a type signature of the constraint type Typeable a
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 :: TypeRep -> Proxy (M1 i c f) -> Word32 -> Structure
gstructured TypeRep
tr Proxy (M1 i c f)
_ Word32
v = case SopStructure
sop of
#if MIN_VERSION_base(4,7,0)
        [(String
_, [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
Evidence bound by a type signature of the constraint type Datatype c
isNewtype M1 i c f ()
p -> TypeRep -> Word32 -> String -> Structure -> Structure
Newtype TypeRep
tr Word32
v String
name Structure
s
#endif
        SopStructure
_                        -> TypeRep -> Word32 -> String -> SopStructure -> Structure
Structure TypeRep
tr Word32
v String
name SopStructure
sop
      where
        p :: M1 i c f ()
p    = M1 i c f ()
forall a. HasCallStack => a
undefined :: M1 i c f ()
        name :: String
name = M1 i c f () -> String
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
Evidence bound by a type signature of the constraint type Datatype c
datatypeName M1 i c f ()
p
        sop :: SopStructure
sop  = Proxy f -> SopStructure -> SopStructure
forall (f :: * -> *).
GStructuredSum f =>
Proxy f -> SopStructure -> SopStructure
Evidence bound by a type signature of the constraint type GStructuredSum f
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) -> SopStructure -> SopStructure
gstructuredSum Proxy (M1 i c f)
_ SopStructure
xs = (String
name, [Structure]
prod) (String, [Structure]) -> SopStructure -> SopStructure
forall a. a -> [a] -> [a]
: SopStructure
xs
      where
        name :: String
name = M1 i c f () -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
Evidence bound by a type signature of the constraint type Constructor c
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]
Evidence bound by a type signature of the constraint type GStructuredProd f
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) -> SopStructure -> SopStructure
gstructuredSum Proxy (f :+: g)
_ SopStructure
xs
        = Proxy f -> SopStructure -> SopStructure
forall (f :: * -> *).
GStructuredSum f =>
Proxy f -> SopStructure -> SopStructure
Evidence bound by a type signature of the constraint type GStructuredSum f
gstructuredSum (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f)
        (SopStructure -> SopStructure) -> SopStructure -> SopStructure
forall a b. (a -> b) -> a -> b
$ Proxy g -> SopStructure -> SopStructure
forall (f :: * -> *).
GStructuredSum f =>
Proxy f -> SopStructure -> SopStructure
Evidence bound by a type signature of the constraint type GStructuredSum g
gstructuredSum (Proxy g
forall {k} (t :: k). Proxy t
Proxy :: Proxy g) SopStructure
xs

instance GStructuredSum V1 where
    gstructuredSum :: Proxy V1 -> SopStructure -> SopStructure
gstructuredSum Proxy V1
_ = SopStructure -> SopStructure
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]
Evidence bound by a type signature of the constraint type GStructuredProd f
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
Evidence bound by a type signature of the constraint type Structured c
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]
Evidence bound by a type signature of the constraint type GStructuredProd f
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]
Evidence bound by a type signature of the constraint type GStructuredProd g
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 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
Evidence bound by a type signature of the constraint type Structured a
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
Evidence bound by a type signature of the constraint type Structured a
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
Evidence bound by a type signature of the constraint type Structured a
containerStructure

instance (Structured a1, Structured a2) => Structured (a1, a2)
instance (Structured a1, Structured a2, Structured a3) => Structured (a1, a2, a3)
instance (Structured a1, Structured a2, Structured a3, Structured a4) => Structured (a1, a2, a3, a4)
instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5) => Structured (a1, a2, a3, a4, a5)
instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6) => Structured (a1, a2, a3, a4, a5, a6)
instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6, Structured a7) => Structured (a1, a2, a3, a4, a5, a6, a7)

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 ByteString -> Structure
structure = Proxy ByteString -> 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)
_ = TypeRep -> Word32 -> String -> [Structure] -> Structure
Nominal (Proxy (Map k v) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Evidence bound by a superclass of: Structured of the constraint type forall a. Structured a => Typeable a
Evidence bound by a type signature of the constraint type Structured k
Evidence bound by a superclass of: Structured of the constraint type forall a. Structured a => Typeable a
Evidence bound by a type signature of the constraint type Structured v
typeRep (Proxy (Map k v)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Map.Map k v))) Word32
0 String
"Map" [ Proxy k -> Structure
forall a. Structured a => Proxy a -> Structure
Evidence bound by a type signature of the constraint type Structured k
structure (Proxy k
forall {k} (t :: k). Proxy t
Proxy :: Proxy k), Proxy v -> Structure
forall a. Structured a => Proxy a -> Structure
Evidence bound by a type signature of the constraint type Structured v
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
Evidence bound by a type signature of the constraint type Structured k
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
Evidence bound by a type signature of the constraint type Structured v
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
Evidence bound by a type signature of the constraint type Structured v
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

-- Proxy isn't Typeable in base-4.8 / base

-- #if __GLASGOW_HASKELL__ >= 800
-- instance (Typeable k, Typeable (a :: k)) => Structured (Proxy a)
-- #else
-- instance (Typeable a) => Structured (Proxy a) where
--     structure p = Structure (typeRep p) 0 "Proxy" [("Proxy",[])]
-- #endif