{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
module PlutusTx.Blueprint.Definition.Internal where
import Prelude
import Data.Kind (Constraint, Type)
import Data.Map (Map)
import Data.Map qualified as Map
import GHC.TypeLits qualified as GHC
import PlutusTx.Blueprint.Definition.Id (DefinitionId)
import PlutusTx.Blueprint.Schema (Schema (..))
data Definition t ts = MkDefinition DefinitionId (Schema ts)
deriving stock (Int -> Definition t ts -> ShowS
[Definition t ts] -> ShowS
Definition t ts -> String
(Int -> Definition t ts -> ShowS)
-> (Definition t ts -> String)
-> ([Definition t ts] -> ShowS)
-> Show (Definition t ts)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) (ts :: [*]). Int -> Definition t ts -> ShowS
forall k (t :: k) (ts :: [*]). [Definition t ts] -> ShowS
forall k (t :: k) (ts :: [*]). Definition t ts -> String
$cshowsPrec :: forall k (t :: k) (ts :: [*]). Int -> Definition t ts -> ShowS
showsPrec :: Int -> Definition t ts -> ShowS
$cshow :: forall k (t :: k) (ts :: [*]). Definition t ts -> String
show :: Definition t ts -> String
$cshowList :: forall k (t :: k) (ts :: [*]). [Definition t ts] -> ShowS
showList :: [Definition t ts] -> ShowS
Show)
data Definitions ts where
NoDefinitions :: Definitions ts
AddDefinition :: Definition t ts -> Definitions ts -> Definitions ts
deriving stock instance Show (Definitions ts)
addDefinition :: Definitions ts -> Definition t ts -> Definitions ts
addDefinition :: forall {k} (ts :: [*]) (t :: k).
Definitions ts -> Definition t ts -> Definitions ts
addDefinition Definitions ts
NoDefinitions Definition t ts
d = Definition t ts -> Definitions ts -> Definitions ts
forall {k} (t :: k) (ts :: [*]).
Definition t ts -> Definitions ts -> Definitions ts
AddDefinition Definition t ts
d Definitions ts
forall (ts :: [*]). Definitions ts
NoDefinitions
addDefinition (AddDefinition Definition t ts
t Definitions ts
s) Definition t ts
d = Definition t ts -> Definitions ts -> Definitions ts
forall {k} (t :: k) (ts :: [*]).
Definition t ts -> Definitions ts -> Definitions ts
AddDefinition Definition t ts
d (Definition t ts -> Definitions ts -> Definitions ts
forall {k} (t :: k) (ts :: [*]).
Definition t ts -> Definitions ts -> Definitions ts
AddDefinition Definition t ts
t Definitions ts
s)
definitionsToMap :: Definitions ts -> (forall xs. Schema xs -> v) -> Map DefinitionId v
definitionsToMap :: forall (ts :: [*]) v.
Definitions ts
-> (forall (xs :: [*]). Schema xs -> v) -> Map DefinitionId v
definitionsToMap Definitions ts
NoDefinitions forall (xs :: [*]). Schema xs -> v
_k = Map DefinitionId v
forall k a. Map k a
Map.empty
definitionsToMap (AddDefinition (MkDefinition DefinitionId
defId Schema ts
v) Definitions ts
s) forall (xs :: [*]). Schema xs -> v
k =
DefinitionId -> v -> Map DefinitionId v -> Map DefinitionId v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert DefinitionId
defId (Schema ts -> v
forall (xs :: [*]). Schema xs -> v
k Schema ts
v) (Definitions ts
-> (forall (xs :: [*]). Schema xs -> v) -> Map DefinitionId v
forall (ts :: [*]) v.
Definitions ts
-> (forall (xs :: [*]). Schema xs -> v) -> Map DefinitionId v
definitionsToMap Definitions ts
s Schema xs -> v
forall (xs :: [*]). Schema xs -> v
k)
type HasSchemaDefinition t ts = HasSchemaDefinition' t ts ts
type HasSchemaDefinition' :: Type -> [Type] -> [Type] -> Constraint
type family HasSchemaDefinition' n xs xs0 where
HasSchemaDefinition' x (x ': xs) _ = ()
HasSchemaDefinition' x (_ ': xs) xs0 = HasSchemaDefinition' x xs xs0
HasSchemaDefinition' n xs xs0 =
GHC.TypeError
( GHC.ShowType n
GHC.:<>: GHC.Text " type was not found in the list of types having schema definitions: "
GHC.:<>: GHC.ShowType xs0
)