{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

{-| This module handles exposing a Contract API to the Plutus Playground frontend.

In practice this means having a way of turning the Contract's effect
rows into a Schema declaration, by using an 'EndpointToSchema'
instance.

|-}
module Playground.Schema
    ( endpointsToSchemas
    , EndpointToSchema
    ) where

import Data.Kind (Type)
import Data.Row (Empty, KnownSymbol, Label (Label))
import Data.Row.Internal (LT ((:->)), Row (R))
import Playground.Types (FunctionSchema (FunctionSchema), argument, endpointDescription)
import Plutus.Contract.Effects (ActiveEndpoint)
import Plutus.Contract.Schema ()
import Schema (FormSchema, ToSchema, toSchema)
import Wallet.Types (EndpointDescription (EndpointDescription), EndpointValue)

class EndpointToSchema (s :: Row Type) where
    endpointsToSchemas :: [FunctionSchema FormSchema]

instance EndpointToSchema Empty where
    endpointsToSchemas :: [FunctionSchema FormSchema]
endpointsToSchemas = []

instance (ToSchema params, KnownSymbol label, EndpointToSchema (R bs)) =>
         EndpointToSchema (R (label :-> (EndpointValue params, ActiveEndpoint) : bs)) where
    endpointsToSchemas :: [FunctionSchema FormSchema]
endpointsToSchemas =
        FunctionSchema :: forall a. EndpointDescription -> a -> FunctionSchema a
FunctionSchema {EndpointDescription
endpointDescription :: EndpointDescription
endpointDescription :: EndpointDescription
endpointDescription, FormSchema
argument :: FormSchema
argument :: FormSchema
argument} FunctionSchema FormSchema
-> [FunctionSchema FormSchema] -> [FunctionSchema FormSchema]
forall a. a -> [a] -> [a]
: EndpointToSchema ('R bs) => [FunctionSchema FormSchema]
forall (s :: Row *).
EndpointToSchema s =>
[FunctionSchema FormSchema]
endpointsToSchemas @(R bs)
      where
        endpointDescription :: EndpointDescription
endpointDescription = String -> EndpointDescription
EndpointDescription (String -> EndpointDescription)
-> (Label label -> String) -> Label label -> EndpointDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label label -> String
forall a. Show a => a -> String
show (Label label -> EndpointDescription)
-> Label label -> EndpointDescription
forall a b. (a -> b) -> a -> b
$ Label label
forall (s :: Symbol). Label s
Label @label
        argument :: FormSchema
argument = ToSchema params => FormSchema
forall a. ToSchema a => FormSchema
toSchema @params