{-# 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
module Distribution.Utils.Structured (
structuredEncode,
structuredEncodeFile,
structuredDecode,
structuredDecodeOrFailIO,
structuredDecodeFileOrFail,
Structured (structure),
MD5,
structureHash,
structureBuilder,
genericStructure,
GStructured,
nominalStructure,
containerStructure,
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
#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
type TypeName = String
type ConstructorName = String
type TypeVersion = Word32
data Structure
= Nominal !TypeRep !TypeVersion TypeName [Structure]
| Newtype !TypeRep !TypeVersion TypeName Structure
| Structure !TypeRep !TypeVersion TypeName SopStructure
deriving (Structure -> Structure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Structure -> Structure -> Bool
$c/= :: Structure -> Structure -> Bool
== :: Structure -> Structure -> Bool
$c== :: Structure -> Structure -> Bool
Eq, Eq 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
Ord, Int -> Structure -> ShowS
[Structure] -> ShowS
Structure -> String
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
Show, 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])]
hashStructure :: Structure -> MD5
hashStructure :: Structure -> MD5
hashStructure = ByteString -> MD5
md5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Structure -> Builder
structureBuilder
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 TypeRep
t Word32
v String
n [Structure]
s) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word32
v' -> TypeRep -> Word32 -> String -> SopStructure -> Structure
Structure TypeRep
t Word32
v' String
n SopStructure
s) (Word32 -> f Word32
f Word32
v)
typeName :: Functor f => (TypeName -> f TypeName) -> Structure -> f Structure
typeName :: forall (f :: * -> *).
Functor f =>
(String -> f String) -> Structure -> f Structure
typeName String -> f String
f (Nominal TypeRep
t Word32
v String
n [Structure]
s) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
n' -> TypeRep -> Word32 -> String -> SopStructure -> Structure
Structure TypeRep
t Word32
v String
n' SopStructure
s) (String -> f String
f String
n)
structureBuilder :: Structure -> Builder.Builder
structureBuilder :: Structure -> Builder
structureBuilder Structure
s0 = forall s a. State s a -> s -> a
State.evalState (Structure -> State (Map String (NonEmpty TypeRep)) Builder
go Structure
s0) 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) = forall {m :: * -> *}.
Monad m =>
TypeRep
-> StateT (Map String (NonEmpty TypeRep)) m Builder
-> StateT (Map String (NonEmpty TypeRep)) m Builder
withTypeRep TypeRep
t forall a b. (a -> b) -> a -> b
$ do
[Builder]
s' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Structure -> State (Map String (NonEmpty TypeRep)) Builder
go [Structure]
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
Builder.word8 Word8
1 forall a. a -> [a] -> [a]
: Word32 -> Builder
Builder.word32LE Word32
v forall a. a -> [a] -> [a]
: String -> Builder
Builder.stringUtf8 String
n forall a. a -> [a] -> [a]
: [Builder]
s'
go (Newtype TypeRep
t Word32
v String
n Structure
s) = forall {m :: * -> *}.
Monad m =>
TypeRep
-> StateT (Map String (NonEmpty TypeRep)) m Builder
-> StateT (Map String (NonEmpty TypeRep)) m Builder
withTypeRep TypeRep
t forall a b. (a -> b) -> a -> b
$ do
Builder
s' <- Structure -> State (Map String (NonEmpty TypeRep)) Builder
go Structure
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
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) = forall {m :: * -> *}.
Monad m =>
TypeRep
-> StateT (Map String (NonEmpty TypeRep)) m Builder
-> StateT (Map String (NonEmpty TypeRep)) m Builder
withTypeRep TypeRep
t forall a b. (a -> b) -> a -> b
$ do
Builder
s' <- SopStructure -> State (Map String (NonEmpty TypeRep)) Builder
goSop SopStructure
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
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 <- forall (m :: * -> *) s. Monad m => StateT s m s
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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [ Word8 -> Builder
Builder.word8 Word8
0, String -> Builder
Builder.stringUtf8 (forall a. Show a => a -> String
show TypeRep
t) ]
Just Map String (NonEmpty TypeRep)
acc' -> do
forall (m :: * -> *) s. Monad m => s -> StateT s 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 <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String, [Structure])
-> State (Map String (NonEmpty TypeRep)) Builder
part SopStructure
sop
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Builder]
parts
part :: (String, [Structure])
-> State (Map String (NonEmpty TypeRep)) Builder
part (String
cn, [Structure]
s) = do
[Builder]
s' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Structure -> State (Map String (NonEmpty TypeRep)) Builder
go [Structure]
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
Data.Monoid.mconcat [ String -> Builder
Builder.stringUtf8 String
cn, forall a. Monoid a => [a] -> a
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 forall k a. Ord k => k -> Map k a -> Maybe a
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Data.Foldable.elem` NonEmpty TypeRep
ne -> forall a. Maybe a
Nothing
| Bool
otherwise -> Maybe (Map String (NonEmpty TypeRep))
inserted
where
inserted :: Maybe (Map String (NonEmpty TypeRep))
inserted = forall a. a -> Maybe a
Just (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>) String
trShown (forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeRep
tr) Map String (NonEmpty TypeRep)
m)
trShown :: String
trShown = forall a. Show a => a -> String
show TypeRep
tr
class Typeable a => Structured a where
structure :: Proxy a -> Structure
default structure :: (Generic a, GStructured (Rep a)) => Proxy a -> Structure
structure = forall a.
(Typeable a, Generic a, GStructured (Rep a)) =>
Proxy a -> Structure
genericStructure
structureHash' :: Tagged a MD5
structureHash' = forall {k} (a :: k) b. b -> Tagged a b
Tagged (Structure -> MD5
hashStructure (forall a. Structured a => Proxy a -> Structure
structure (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)))
newtype Tagged a b = Tagged { forall {k} (a :: k) b. Tagged a b -> b
untag :: b }
structureHash :: forall a. Structured a => Proxy a -> MD5
structureHash :: forall a. Structured a => Proxy a -> MD5
structureHash Proxy a
_ = forall {k} (a :: k) b. Tagged a b -> b
untag (forall a. Structured a => Tagged a MD5
structureHash' :: Tagged a MD5)
structuredEncode
:: forall a. (Binary.Binary a, Structured a)
=> a -> LBS.ByteString
structuredEncode :: forall a. (Binary a, Structured a) => a -> ByteString
structuredEncode a
x = forall a. Binary a => a -> ByteString
Binary.encode (forall {k} (a :: k). Tag a
Tag :: Tag a, a
x)
structuredEncodeFile :: (Binary.Binary a, Structured a) => FilePath -> a -> IO ()
structuredEncodeFile :: forall a. (Binary a, Structured a) => String -> a -> IO ()
structuredEncodeFile String
f = String -> ByteString -> IO ()
LBS.writeFile String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Binary a, Structured a) => a -> ByteString
structuredEncode
structuredDecode
:: forall a. (Binary.Binary a, Structured a)
=> LBS.ByteString -> a
structuredDecode :: forall a. (Binary a, Structured a) => ByteString -> a
structuredDecode ByteString
lbs = forall a b. (a, b) -> b
snd (forall a. Binary a => ByteString -> a
Binary.decode ByteString
lbs :: (Tag a, a))
structuredDecodeOrFailIO :: (Binary.Binary a, Structured a) => LBS.ByteString -> IO (Either String a)
structuredDecodeOrFailIO :: forall a.
(Binary a, Structured a) =>
ByteString -> IO (Either String a)
structuredDecodeOrFailIO ByteString
bs =
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall a. a -> IO a
evaluate (forall a. (Binary a, Structured a) => ByteString -> a
structuredDecode ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall {m :: * -> *} {b}.
Monad m =>
ErrorCall -> m (Either String b)
handler
where
#if MIN_VERSION_base(4,9,0)
handler :: ErrorCall -> m (Either String b)
handler (ErrorCallWithLocation String
str String
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
str
#else
handler (ErrorCall str) = return $ Left str
#endif
structuredDecodeFileOrFail :: (Binary.Binary a, Structured a) => FilePath -> IO (Either String a)
structuredDecodeFileOrFail :: forall a.
(Binary a, Structured a) =>
String -> IO (Either String a)
structuredDecodeFileOrFail String
f = forall a.
(Binary a, Structured a) =>
ByteString -> IO (Either String a)
structuredDecodeOrFailIO forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
LBS.readFile String
f
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 forall a. Eq a => a -> a -> Bool
== MD5
expected
then forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). Tag a
Tag
else forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Non-matching structured hashes: "
, MD5 -> String
showMD5 MD5
actual
, String
"; expected: "
, MD5 -> String
showMD5 MD5
expected
]
where
expected :: MD5
expected = forall {k} (a :: k) b. Tagged a b -> b
untag (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 = forall {k} (a :: k) b. Tagged a b -> b
untag (forall a. Structured a => Tagged a MD5
structureHash' :: Tagged a MD5)
nominalStructure :: Typeable a => Proxy a -> Structure
nominalStructure :: forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure Proxy a
p = TypeRep -> Word32 -> String -> [Structure] -> Structure
Nominal TypeRep
tr Word32
0 (forall a. Show a => a -> String
show TypeRep
tr) [] where
tr :: TypeRep
tr = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
p
#if MIN_VERSION_base(4,7,0)
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)
_ = TypeRep -> Word32 -> String -> [Structure] -> Structure
Nominal TypeRep
faTypeRep Word32
0 (forall a. Show a => a -> String
show TypeRep
fTypeRep)
[ forall a. Structured a => Proxy a -> Structure
structure (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
]
where
fTypeRep :: TypeRep
fTypeRep = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy f)
faTypeRep :: TypeRep
faTypeRep = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (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
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
_ = forall (f :: * -> *).
GStructured f =>
TypeRep -> Proxy f -> Word32 -> Structure
gstructured (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep a)) Word32
0
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])] | forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> Bool
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 = forall a. HasCallStack => a
undefined :: M1 i c f ()
name :: String
name = forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName M1 i c f ()
p
sop :: SopStructure
sop = forall (f :: * -> *).
GStructuredSum f =>
Proxy f -> SopStructure -> SopStructure
gstructuredSum (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) forall a. a -> [a] -> [a]
: SopStructure
xs
where
name :: String
name = forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
undefined :: M1 i c f ())
prod :: [Structure]
prod = forall (f :: * -> *).
GStructuredProd f =>
Proxy f -> [Structure] -> [Structure]
gstructuredProd (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
= forall (f :: * -> *).
GStructuredSum f =>
Proxy f -> SopStructure -> SopStructure
gstructuredSum (forall {k} (t :: k). Proxy t
Proxy :: Proxy f)
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
GStructuredSum f =>
Proxy f -> SopStructure -> SopStructure
gstructuredSum (forall {k} (t :: k). Proxy t
Proxy :: Proxy g) SopStructure
xs
instance GStructuredSum V1 where
gstructuredSum :: Proxy V1 -> SopStructure -> SopStructure
gstructuredSum Proxy V1
_ = 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)
_ = forall (f :: * -> *).
GStructuredProd f =>
Proxy f -> [Structure] -> [Structure]
gstructuredProd (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 = forall a. Structured a => Proxy a -> Structure
structure (forall {k} (t :: k). Proxy t
Proxy :: Proxy c) forall a. a -> [a] -> [a]
: [Structure]
xs
instance GStructuredProd U1 where
gstructuredProd :: Proxy U1 -> [Structure] -> [Structure]
gstructuredProd Proxy U1
_ = 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
= forall (f :: * -> *).
GStructuredProd f =>
Proxy f -> [Structure] -> [Structure]
gstructuredProd (forall {k} (t :: k). Proxy t
Proxy :: Proxy f)
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
GStructuredProd f =>
Proxy f -> [Structure] -> [Structure]
gstructuredProd (forall {k} (t :: k). Proxy t
Proxy :: Proxy g) [Structure]
xs
instance Structured ()
instance Structured Bool
instance Structured Ordering
instance Structured Char where structure :: Proxy Char -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Int where structure :: Proxy Int -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Integer where structure :: Proxy Integer -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Data.Word.Word where structure :: Proxy Word -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Int8 where structure :: Proxy Int8 -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Int16 where structure :: Proxy Int16 -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Int32 where structure :: Proxy Int32 -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Int64 where structure :: Proxy Int64 -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Word8 where structure :: Proxy Word8 -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Word16 where structure :: Proxy Word16 -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Word32 where structure :: Proxy Word32 -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Word64 where structure :: Proxy Word64 -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Float where structure :: Proxy Float -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Double where structure :: Proxy Double -> Structure
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 = 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 = 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 = forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
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 = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured LBS.ByteString where structure :: Proxy ByteString -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured T.Text where structure :: Proxy Text -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured LT.Text where structure :: Proxy Text -> Structure
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 (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Map.Map k v))) Word32
0 String
"Map" [ forall a. Structured a => Proxy a -> Structure
structure (forall {k} (t :: k). Proxy t
Proxy :: Proxy k), forall a. Structured a => Proxy a -> Structure
structure (forall {k} (t :: k). Proxy t
Proxy :: Proxy v) ]
instance (Structured k) => Structured (Set.Set k) where structure :: Proxy (Set k) -> Structure
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 = forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
containerStructure
instance Structured IS.IntSet where structure :: Proxy IntSet -> Structure
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 = forall {k} (f :: * -> k) a.
(Typeable f, Structured a) =>
Proxy (f a) -> Structure
containerStructure
instance Structured Time.UTCTime where structure :: Proxy UTCTime -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.DiffTime where structure :: Proxy DiffTime -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.UniversalTime where structure :: Proxy UniversalTime -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.NominalDiffTime where structure :: Proxy NominalDiffTime -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.Day where structure :: Proxy Day -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.TimeZone where structure :: Proxy TimeZone -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.TimeOfDay where structure :: Proxy TimeOfDay -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
instance Structured Time.LocalTime where structure :: Proxy LocalTime -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure