{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}

module PlutusTx.Blueprint.Definition.Derive where

import PlutusTx.Blueprint.Class (HasBlueprintSchema (..))
import PlutusTx.Blueprint.Definition.Internal (Definition (..), Definitions (..), addDefinition)
import PlutusTx.Blueprint.Definition.Unroll (HasBlueprintDefinition (definitionId), UnrollAll)
import PlutusTx.Blueprint.Schema (Schema (..))

-- | Derive a 'Definitions' value for a list of types.
deriveDefinitions :: forall ts. (DefinitionsFor (UnrollAll ts)) => Definitions (UnrollAll ts)
deriveDefinitions :: forall (ts :: [*]).
DefinitionsFor (UnrollAll ts) =>
Definitions (UnrollAll ts)
deriveDefinitions = forall (ts :: [*]). DefinitionsFor ts => Definitions ts
definitionsFor @(UnrollAll ts)

-- | Construct a 'Schema' that is a reference to a schema definition.
definitionRef :: forall t ts. (HasBlueprintDefinition t) => Schema ts
definitionRef :: forall t (ts :: [*]). HasBlueprintDefinition t => Schema ts
definitionRef = DefinitionId -> Schema ts
forall (referencedTypes :: [*]).
DefinitionId -> Schema referencedTypes
SchemaDefinitionRef (forall t. HasBlueprintDefinition t => DefinitionId
definitionId @t)

{- | This class and its two instances are used internally to derive 'Definitions'
for a given list of types.
-}
type DefinitionsFor ts = DefinitionsFor' ts ts

definitionsFor :: forall ts. (DefinitionsFor ts) => Definitions ts
definitionsFor :: forall (ts :: [*]). DefinitionsFor ts => Definitions ts
definitionsFor = forall (referencedTypes :: [*]) (acc :: [*]).
DefinitionsFor' referencedTypes acc =>
Definitions referencedTypes
forall {k} (referencedTypes :: [*]) (acc :: k).
DefinitionsFor' referencedTypes acc =>
Definitions referencedTypes
definitionsFor' @ts @ts

class DefinitionsFor' referencedTypes acc where
  definitionsFor' :: Definitions referencedTypes

instance DefinitionsFor' referencedTypes '[] where
  definitionsFor' :: Definitions referencedTypes
definitionsFor' = Definitions referencedTypes
forall (referencedTypes :: [*]). Definitions referencedTypes
NoDefinitions

instance
  ( HasBlueprintDefinition t
  , HasBlueprintSchema t referencedTypes
  , DefinitionsFor' referencedTypes ts
  )
  => DefinitionsFor' referencedTypes (t ': ts)
  where
  definitionsFor' :: Definitions referencedTypes
definitionsFor' =
    Definitions referencedTypes
-> Definition Any referencedTypes -> Definitions referencedTypes
forall {k} (ts :: [*]) (t :: k).
Definitions ts -> Definition t ts -> Definitions ts
addDefinition
      (forall (referencedTypes :: [*]) (acc :: [*]).
DefinitionsFor' referencedTypes acc =>
Definitions referencedTypes
forall {k} (referencedTypes :: [*]) (acc :: k).
DefinitionsFor' referencedTypes acc =>
Definitions referencedTypes
definitionsFor' @referencedTypes @ts)
      (DefinitionId
-> Schema referencedTypes -> Definition Any referencedTypes
forall {k} (t :: k) (ts :: [*]).
DefinitionId -> Schema ts -> Definition t ts
MkDefinition (forall t. HasBlueprintDefinition t => DefinitionId
definitionId @t) (forall t (referencedTypes :: [*]).
HasBlueprintSchema t referencedTypes =>
Schema referencedTypes
schema @t))