{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}

module Inferno.VersionControl.Types
  ( VCObjectHash (..),
    VCObject (..),
    VCObjectVisibility (..),
    VCMeta (..),
    VCCommitMessage (..),
    VCIncompatReason (..),
    VCObjectPred (..),
    VCHashUpdate (..),
    Pinned (..),
    vcObjectHashToByteString,
    vcHash,
    showVCObjectType,
  )
where

import Data.Aeson (FromJSON, ToJSON)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import Foreign.C.Types (CTime)
import GHC.Generics (Generic)
import Inferno.Types.Module (Module (..))
import Inferno.Types.Syntax (Dependencies (..), Expr (..), Ident (..))
import Inferno.Types.Type (Namespace, TCScheme (..)) -- TypeMetadata(..),
import Inferno.Types.VersionControl (Pinned (..), VCHashUpdate (..), VCObjectHash (..), pinnedUnderVCToMaybe, vcHash, vcObjectHashToByteString)
import Test.QuickCheck (Arbitrary (..), oneof)
import Test.QuickCheck.Arbitrary.ADT (ToADTArbitrary)
import Test.QuickCheck.Instances.Text ()

data VCObject
  = VCModule (Module (Map Ident VCObjectHash))
  | VCFunction (Expr (Pinned VCObjectHash) ()) TCScheme -- (Map (SourcePos, SourcePos) (TypeMetadata TCScheme))
  | VCTestFunction (Expr (Pinned VCObjectHash) ())
  | VCEnum Ident (Set Ident)
  deriving (VCObject -> VCObject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VCObject -> VCObject -> Bool
$c/= :: VCObject -> VCObject -> Bool
== :: VCObject -> VCObject -> Bool
$c== :: VCObject -> VCObject -> Bool
Eq, forall x. Rep VCObject x -> VCObject
forall x. VCObject -> Rep VCObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VCObject x -> VCObject
$cfrom :: forall x. VCObject -> Rep VCObject x
Generic, [VCObject] -> Encoding
[VCObject] -> Value
VCObject -> Encoding
VCObject -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VCObject] -> Encoding
$ctoEncodingList :: [VCObject] -> Encoding
toJSONList :: [VCObject] -> Value
$ctoJSONList :: [VCObject] -> Value
toEncoding :: VCObject -> Encoding
$ctoEncoding :: VCObject -> Encoding
toJSON :: VCObject -> Value
$ctoJSON :: VCObject -> Value
ToJSON, Value -> Parser [VCObject]
Value -> Parser VCObject
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VCObject]
$cparseJSONList :: Value -> Parser [VCObject]
parseJSON :: Value -> Parser VCObject
$cparseJSON :: Value -> Parser VCObject
FromJSON, Context SHA256 -> VCObject -> Context SHA256
forall obj.
(Context SHA256 -> obj -> Context SHA256) -> VCHashUpdate obj
&< :: Context SHA256 -> VCObject -> Context SHA256
$c&< :: Context SHA256 -> VCObject -> Context SHA256
VCHashUpdate)

showVCObjectType :: VCObject -> Text
showVCObjectType :: VCObject -> Text
showVCObjectType = \case
  VCModule Module (Map Ident VCObjectHash)
_ -> Text
"module"
  VCFunction Expr (Pinned VCObjectHash) ()
_ TCScheme
_ -> Text
"function"
  VCTestFunction Expr (Pinned VCObjectHash) ()
_ -> Text
"test function"
  VCEnum Ident
_ Set Ident
_ -> Text
"enum"

instance Dependencies VCObject VCObjectHash where
  getDependencies :: Ord VCObjectHash => VCObject -> Set VCObjectHash
getDependencies = \case
    VCModule Module {moduleObjects :: forall objs. Module objs -> objs
moduleObjects = Map Ident VCObjectHash
os} -> forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map Ident VCObjectHash
os
    VCFunction Expr (Pinned VCObjectHash) ()
expr TCScheme
_ -> forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pinned a -> Maybe a
pinnedUnderVCToMaybe forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall f hash. (Dependencies f hash, Ord hash) => f -> Set hash
getDependencies Expr (Pinned VCObjectHash) ()
expr
    VCTestFunction Expr (Pinned VCObjectHash) ()
expr -> forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pinned a -> Maybe a
pinnedUnderVCToMaybe forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall f hash. (Dependencies f hash, Ord hash) => f -> Set hash
getDependencies Expr (Pinned VCObjectHash) ()
expr
    VCEnum Ident
_ Set Ident
_ -> forall a. Monoid a => a
mempty

data VCObjectVisibility = VCObjectPublic | VCObjectPrivate deriving (Int -> VCObjectVisibility -> ShowS
[VCObjectVisibility] -> ShowS
VCObjectVisibility -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VCObjectVisibility] -> ShowS
$cshowList :: [VCObjectVisibility] -> ShowS
show :: VCObjectVisibility -> String
$cshow :: VCObjectVisibility -> String
showsPrec :: Int -> VCObjectVisibility -> ShowS
$cshowsPrec :: Int -> VCObjectVisibility -> ShowS
Show, VCObjectVisibility -> VCObjectVisibility -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VCObjectVisibility -> VCObjectVisibility -> Bool
$c/= :: VCObjectVisibility -> VCObjectVisibility -> Bool
== :: VCObjectVisibility -> VCObjectVisibility -> Bool
$c== :: VCObjectVisibility -> VCObjectVisibility -> Bool
Eq, forall x. Rep VCObjectVisibility x -> VCObjectVisibility
forall x. VCObjectVisibility -> Rep VCObjectVisibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VCObjectVisibility x -> VCObjectVisibility
$cfrom :: forall x. VCObjectVisibility -> Rep VCObjectVisibility x
Generic, [VCObjectVisibility] -> Encoding
[VCObjectVisibility] -> Value
VCObjectVisibility -> Encoding
VCObjectVisibility -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VCObjectVisibility] -> Encoding
$ctoEncodingList :: [VCObjectVisibility] -> Encoding
toJSONList :: [VCObjectVisibility] -> Value
$ctoJSONList :: [VCObjectVisibility] -> Value
toEncoding :: VCObjectVisibility -> Encoding
$ctoEncoding :: VCObjectVisibility -> Encoding
toJSON :: VCObjectVisibility -> Value
$ctoJSON :: VCObjectVisibility -> Value
ToJSON, Value -> Parser [VCObjectVisibility]
Value -> Parser VCObjectVisibility
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VCObjectVisibility]
$cparseJSONList :: Value -> Parser [VCObjectVisibility]
parseJSON :: Value -> Parser VCObjectVisibility
$cparseJSON :: Value -> Parser VCObjectVisibility
FromJSON, Context SHA256 -> VCObjectVisibility -> Context SHA256
forall obj.
(Context SHA256 -> obj -> Context SHA256) -> VCHashUpdate obj
&< :: Context SHA256 -> VCObjectVisibility -> Context SHA256
$c&< :: Context SHA256 -> VCObjectVisibility -> Context SHA256
VCHashUpdate)

instance Arbitrary VCObjectVisibility where
  arbitrary :: Gen VCObjectVisibility
arbitrary = forall a. [Gen a] -> Gen a
oneof forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Applicative f => a -> f a
pure [VCObjectVisibility
VCObjectPublic, VCObjectVisibility
VCObjectPrivate]

deriving instance ToADTArbitrary VCObjectVisibility

newtype VCCommitMessage = VCCommitMessage {VCCommitMessage -> Text
unVCCommitMessage :: Text}
  deriving stock (Int -> VCCommitMessage -> ShowS
[VCCommitMessage] -> ShowS
VCCommitMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VCCommitMessage] -> ShowS
$cshowList :: [VCCommitMessage] -> ShowS
show :: VCCommitMessage -> String
$cshow :: VCCommitMessage -> String
showsPrec :: Int -> VCCommitMessage -> ShowS
$cshowsPrec :: Int -> VCCommitMessage -> ShowS
Show, VCCommitMessage -> VCCommitMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VCCommitMessage -> VCCommitMessage -> Bool
$c/= :: VCCommitMessage -> VCCommitMessage -> Bool
== :: VCCommitMessage -> VCCommitMessage -> Bool
$c== :: VCCommitMessage -> VCCommitMessage -> Bool
Eq, forall x. Rep VCCommitMessage x -> VCCommitMessage
forall x. VCCommitMessage -> Rep VCCommitMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VCCommitMessage x -> VCCommitMessage
$cfrom :: forall x. VCCommitMessage -> Rep VCCommitMessage x
Generic)
  deriving newtype ([VCCommitMessage] -> Encoding
[VCCommitMessage] -> Value
VCCommitMessage -> Encoding
VCCommitMessage -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VCCommitMessage] -> Encoding
$ctoEncodingList :: [VCCommitMessage] -> Encoding
toJSONList :: [VCCommitMessage] -> Value
$ctoJSONList :: [VCCommitMessage] -> Value
toEncoding :: VCCommitMessage -> Encoding
$ctoEncoding :: VCCommitMessage -> Encoding
toJSON :: VCCommitMessage -> Value
$ctoJSON :: VCCommitMessage -> Value
ToJSON, Value -> Parser [VCCommitMessage]
Value -> Parser VCCommitMessage
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VCCommitMessage]
$cparseJSONList :: Value -> Parser [VCCommitMessage]
parseJSON :: Value -> Parser VCCommitMessage
$cparseJSON :: Value -> Parser VCCommitMessage
FromJSON, Context SHA256 -> VCCommitMessage -> Context SHA256
forall obj.
(Context SHA256 -> obj -> Context SHA256) -> VCHashUpdate obj
&< :: Context SHA256 -> VCCommitMessage -> Context SHA256
$c&< :: Context SHA256 -> VCCommitMessage -> Context SHA256
VCHashUpdate)

data VCIncompatReason
  = TypeSignatureChange
  | EnumConstructorsChanged
  deriving (Int -> VCIncompatReason -> ShowS
[VCIncompatReason] -> ShowS
VCIncompatReason -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VCIncompatReason] -> ShowS
$cshowList :: [VCIncompatReason] -> ShowS
show :: VCIncompatReason -> String
$cshow :: VCIncompatReason -> String
showsPrec :: Int -> VCIncompatReason -> ShowS
$cshowsPrec :: Int -> VCIncompatReason -> ShowS
Show, VCIncompatReason -> VCIncompatReason -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VCIncompatReason -> VCIncompatReason -> Bool
$c/= :: VCIncompatReason -> VCIncompatReason -> Bool
== :: VCIncompatReason -> VCIncompatReason -> Bool
$c== :: VCIncompatReason -> VCIncompatReason -> Bool
Eq, forall x. Rep VCIncompatReason x -> VCIncompatReason
forall x. VCIncompatReason -> Rep VCIncompatReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VCIncompatReason x -> VCIncompatReason
$cfrom :: forall x. VCIncompatReason -> Rep VCIncompatReason x
Generic, [VCIncompatReason] -> Encoding
[VCIncompatReason] -> Value
VCIncompatReason -> Encoding
VCIncompatReason -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VCIncompatReason] -> Encoding
$ctoEncodingList :: [VCIncompatReason] -> Encoding
toJSONList :: [VCIncompatReason] -> Value
$ctoJSONList :: [VCIncompatReason] -> Value
toEncoding :: VCIncompatReason -> Encoding
$ctoEncoding :: VCIncompatReason -> Encoding
toJSON :: VCIncompatReason -> Value
$ctoJSON :: VCIncompatReason -> Value
ToJSON, Value -> Parser [VCIncompatReason]
Value -> Parser VCIncompatReason
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VCIncompatReason]
$cparseJSONList :: Value -> Parser [VCIncompatReason]
parseJSON :: Value -> Parser VCIncompatReason
$cparseJSON :: Value -> Parser VCIncompatReason
FromJSON, Context SHA256 -> VCIncompatReason -> Context SHA256
forall obj.
(Context SHA256 -> obj -> Context SHA256) -> VCHashUpdate obj
&< :: Context SHA256 -> VCIncompatReason -> Context SHA256
$c&< :: Context SHA256 -> VCIncompatReason -> Context SHA256
VCHashUpdate)

instance Arbitrary VCIncompatReason where
  arbitrary :: Gen VCIncompatReason
arbitrary = forall a. [Gen a] -> Gen a
oneof forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Applicative f => a -> f a
pure [VCIncompatReason
TypeSignatureChange, VCIncompatReason
EnumConstructorsChanged]

deriving instance ToADTArbitrary VCIncompatReason

data VCObjectPred
  = -- | Original script (root of the histories).
    Init
  | CompatibleWithPred VCObjectHash
  | IncompatibleWithPred VCObjectHash [(Namespace, VCIncompatReason)]
  | MarkedBreakingWithPred VCObjectHash
  | -- | Similar to 'Init' but this script is init'd by cloning the original script.
    CloneOf VCObjectHash
  | -- | CloneOfRemoved' is a "virtual" constructor to differentiate that the source of the script has been removed (but can
    -- still be found in removed directory). However, in the DB the field is still stored as 'CloneOf'. When we build the histories
    -- of a script, it will be differentiated between these 3 constructors for cloned script.
    CloneOfRemoved VCObjectHash
  | -- | 'CloneOfNotFound' is similar to 'CloneOfRemoved' but it is for case where the original script is not found
    -- i.e. the removed folder might get cleared so we lost the original script information.
    CloneOfNotFound VCObjectHash
  deriving (Int -> VCObjectPred -> ShowS
[VCObjectPred] -> ShowS
VCObjectPred -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VCObjectPred] -> ShowS
$cshowList :: [VCObjectPred] -> ShowS
show :: VCObjectPred -> String
$cshow :: VCObjectPred -> String
showsPrec :: Int -> VCObjectPred -> ShowS
$cshowsPrec :: Int -> VCObjectPred -> ShowS
Show, VCObjectPred -> VCObjectPred -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VCObjectPred -> VCObjectPred -> Bool
$c/= :: VCObjectPred -> VCObjectPred -> Bool
== :: VCObjectPred -> VCObjectPred -> Bool
$c== :: VCObjectPred -> VCObjectPred -> Bool
Eq, forall x. Rep VCObjectPred x -> VCObjectPred
forall x. VCObjectPred -> Rep VCObjectPred x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VCObjectPred x -> VCObjectPred
$cfrom :: forall x. VCObjectPred -> Rep VCObjectPred x
Generic, [VCObjectPred] -> Encoding
[VCObjectPred] -> Value
VCObjectPred -> Encoding
VCObjectPred -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VCObjectPred] -> Encoding
$ctoEncodingList :: [VCObjectPred] -> Encoding
toJSONList :: [VCObjectPred] -> Value
$ctoJSONList :: [VCObjectPred] -> Value
toEncoding :: VCObjectPred -> Encoding
$ctoEncoding :: VCObjectPred -> Encoding
toJSON :: VCObjectPred -> Value
$ctoJSON :: VCObjectPred -> Value
ToJSON, Value -> Parser [VCObjectPred]
Value -> Parser VCObjectPred
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VCObjectPred]
$cparseJSONList :: Value -> Parser [VCObjectPred]
parseJSON :: Value -> Parser VCObjectPred
$cparseJSON :: Value -> Parser VCObjectPred
FromJSON, Context SHA256 -> VCObjectPred -> Context SHA256
forall obj.
(Context SHA256 -> obj -> Context SHA256) -> VCHashUpdate obj
&< :: Context SHA256 -> VCObjectPred -> Context SHA256
$c&< :: Context SHA256 -> VCObjectPred -> Context SHA256
VCHashUpdate)

instance Arbitrary VCObjectPred where
  arbitrary :: Gen VCObjectPred
arbitrary =
    forall a. [Gen a] -> Gen a
oneof
      [ forall (f :: * -> *) a. Applicative f => a -> f a
pure VCObjectPred
Init,
        VCObjectHash -> VCObjectPred
CompatibleWithPred forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
        VCObjectHash -> [(Namespace, VCIncompatReason)] -> VCObjectPred
IncompatibleWithPred forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary,
        VCObjectHash -> VCObjectPred
MarkedBreakingWithPred forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
        VCObjectHash -> VCObjectPred
CloneOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      ]

deriving instance ToADTArbitrary VCObjectPred

-- the owner information and commit messages will be added in further revisions with other metadata as needed
data VCMeta author group o = VCMeta
  { forall author group o. VCMeta author group o -> CTime
timestamp :: CTime,
    forall author group o. VCMeta author group o -> author
author :: author,
    forall author group o. VCMeta author group o -> group
group :: group,
    forall author group o. VCMeta author group o -> Text
name :: Text,
    forall author group o. VCMeta author group o -> Text
description :: Text,
    forall author group o. VCMeta author group o -> VCObjectPred
pred :: VCObjectPred,
    -- commitMessage :: VCCommitMessage,
    forall author group o. VCMeta author group o -> VCObjectVisibility
visibility :: VCObjectVisibility,
    forall author group o. VCMeta author group o -> o
obj :: o
  }
  deriving (Int -> VCMeta author group o -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall author group o.
(Show author, Show group, Show o) =>
Int -> VCMeta author group o -> ShowS
forall author group o.
(Show author, Show group, Show o) =>
[VCMeta author group o] -> ShowS
forall author group o.
(Show author, Show group, Show o) =>
VCMeta author group o -> String
showList :: [VCMeta author group o] -> ShowS
$cshowList :: forall author group o.
(Show author, Show group, Show o) =>
[VCMeta author group o] -> ShowS
show :: VCMeta author group o -> String
$cshow :: forall author group o.
(Show author, Show group, Show o) =>
VCMeta author group o -> String
showsPrec :: Int -> VCMeta author group o -> ShowS
$cshowsPrec :: forall author group o.
(Show author, Show group, Show o) =>
Int -> VCMeta author group o -> ShowS
Show, VCMeta author group o -> VCMeta author group o -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall author group o.
(Eq author, Eq group, Eq o) =>
VCMeta author group o -> VCMeta author group o -> Bool
/= :: VCMeta author group o -> VCMeta author group o -> Bool
$c/= :: forall author group o.
(Eq author, Eq group, Eq o) =>
VCMeta author group o -> VCMeta author group o -> Bool
== :: VCMeta author group o -> VCMeta author group o -> Bool
$c== :: forall author group o.
(Eq author, Eq group, Eq o) =>
VCMeta author group o -> VCMeta author group o -> Bool
Eq, forall a b. a -> VCMeta author group b -> VCMeta author group a
forall a b.
(a -> b) -> VCMeta author group a -> VCMeta author group b
forall author group a b.
a -> VCMeta author group b -> VCMeta author group a
forall author group a b.
(a -> b) -> VCMeta author group a -> VCMeta author group b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> VCMeta author group b -> VCMeta author group a
$c<$ :: forall author group a b.
a -> VCMeta author group b -> VCMeta author group a
fmap :: forall a b.
(a -> b) -> VCMeta author group a -> VCMeta author group b
$cfmap :: forall author group a b.
(a -> b) -> VCMeta author group a -> VCMeta author group b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall author group o x.
Rep (VCMeta author group o) x -> VCMeta author group o
forall author group o x.
VCMeta author group o -> Rep (VCMeta author group o) x
$cto :: forall author group o x.
Rep (VCMeta author group o) x -> VCMeta author group o
$cfrom :: forall author group o x.
VCMeta author group o -> Rep (VCMeta author group o) x
Generic, forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall author group o.
(ToJSON o, ToJSON group, ToJSON author) =>
[VCMeta author group o] -> Encoding
forall author group o.
(ToJSON o, ToJSON group, ToJSON author) =>
[VCMeta author group o] -> Value
forall author group o.
(ToJSON o, ToJSON group, ToJSON author) =>
VCMeta author group o -> Encoding
forall author group o.
(ToJSON o, ToJSON group, ToJSON author) =>
VCMeta author group o -> Value
toEncodingList :: [VCMeta author group o] -> Encoding
$ctoEncodingList :: forall author group o.
(ToJSON o, ToJSON group, ToJSON author) =>
[VCMeta author group o] -> Encoding
toJSONList :: [VCMeta author group o] -> Value
$ctoJSONList :: forall author group o.
(ToJSON o, ToJSON group, ToJSON author) =>
[VCMeta author group o] -> Value
toEncoding :: VCMeta author group o -> Encoding
$ctoEncoding :: forall author group o.
(ToJSON o, ToJSON group, ToJSON author) =>
VCMeta author group o -> Encoding
toJSON :: VCMeta author group o -> Value
$ctoJSON :: forall author group o.
(ToJSON o, ToJSON group, ToJSON author) =>
VCMeta author group o -> Value
ToJSON, forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall author group o.
(FromJSON author, FromJSON group, FromJSON o) =>
Value -> Parser [VCMeta author group o]
forall author group o.
(FromJSON author, FromJSON group, FromJSON o) =>
Value -> Parser (VCMeta author group o)
parseJSONList :: Value -> Parser [VCMeta author group o]
$cparseJSONList :: forall author group o.
(FromJSON author, FromJSON group, FromJSON o) =>
Value -> Parser [VCMeta author group o]
parseJSON :: Value -> Parser (VCMeta author group o)
$cparseJSON :: forall author group o.
(FromJSON author, FromJSON group, FromJSON o) =>
Value -> Parser (VCMeta author group o)
FromJSON, forall obj.
(Context SHA256 -> obj -> Context SHA256) -> VCHashUpdate obj
forall author group o.
(VCHashUpdate author, VCHashUpdate group, VCHashUpdate o) =>
Context SHA256 -> VCMeta author group o -> Context SHA256
&< :: Context SHA256 -> VCMeta author group o -> Context SHA256
$c&< :: forall author group o.
(VCHashUpdate author, VCHashUpdate group, VCHashUpdate o) =>
Context SHA256 -> VCMeta author group o -> Context SHA256
VCHashUpdate)

instance (Arbitrary a, Arbitrary g, Arbitrary o) => Arbitrary (VCMeta a g o) where
  arbitrary :: Gen (VCMeta a g o)
arbitrary =
    forall author group o.
CTime
-> author
-> group
-> Text
-> Text
-> VCObjectPred
-> VCObjectVisibility
-> o
-> VCMeta author group o
VCMeta
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

deriving instance (Arbitrary a, Arbitrary g, Arbitrary o) => ToADTArbitrary (VCMeta a g o)