{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- the reason for this being in its own module
{-# OPTIONS_GHC -Wno-orphans #-}
module Codec.Candid.Generic (AsRecord(..), AsVariant(..)) where

import qualified Data.Row as R
import qualified Data.Row.Records as R
import qualified Data.Row.Variants as V
import qualified Data.Row.Dictionaries as R
import Data.Typeable

import Codec.Candid.Class

-- | This newtype encodes a Haskell record type using generic programming. Best used with @DerivingVia@, as shown in the tutorial.
newtype AsRecord a = AsRecord { AsRecord a -> a
unAsRecord :: a }


type CanBeCandidRecord a =
    ( Typeable a
    , Candid (R.Rec (R.NativeRow a))
    , R.ToNative a
    , R.FromNative a
    -- Superclass constraints that need to be explicit since GHC 9.6
    , Typeable (R.NativeRow a)
    , V.AllUniqueLabels (R.NativeRow a)
    , V.AllUniqueLabels (V.Map (Either String) (R.NativeRow a))
    , V.Forall (R.NativeRow a) R.Unconstrained1
    , V.Forall (R.NativeRow a) Candid
    )
instance CanBeCandidRecord a => Candid (AsRecord a) where
    type AsCandid (AsRecord a) = AsCandid (R.Rec (R.NativeRow a))
    toCandid :: AsRecord a -> AsCandid (AsRecord a)
toCandid = Candid (Rec (NativeRow a)) =>
Rec (NativeRow a) -> AsCandid (Rec (NativeRow a))
forall a. Candid a => a -> AsCandid a
toCandid @(R.Rec (R.NativeRow a)) (Rec (NativeRowG (Rep a)) -> Rec (NativeRowG (Rep a)))
-> (AsRecord a -> Rec (NativeRowG (Rep a)))
-> AsRecord a
-> Rec (NativeRowG (Rep a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rec (NativeRowG (Rep a))
forall t. FromNative t => t -> Rec (NativeRow t)
R.fromNative (a -> Rec (NativeRowG (Rep a)))
-> (AsRecord a -> a) -> AsRecord a -> Rec (NativeRowG (Rep a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsRecord a -> a
forall a. AsRecord a -> a
unAsRecord
    fromCandid :: AsCandid (AsRecord a) -> AsRecord a
fromCandid = a -> AsRecord a
forall a. a -> AsRecord a
AsRecord (a -> AsRecord a)
-> (Rec (NativeRowG (Rep a)) -> a)
-> Rec (NativeRowG (Rep a))
-> AsRecord a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (NativeRowG (Rep a)) -> a
forall t. ToNative t => Rec (NativeRow t) -> t
R.toNative (Rec (NativeRowG (Rep a)) -> a)
-> (Rec (NativeRowG (Rep a)) -> Rec (NativeRowG (Rep a)))
-> Rec (NativeRowG (Rep a))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Candid (Rec (NativeRow a)) =>
AsCandid (Rec (NativeRow a)) -> Rec (NativeRow a)
forall a. Candid a => AsCandid a -> a
fromCandid @(R.Rec (R.NativeRow a))

-- | This newtype encodes a Haskell data type as a variant using generic programming. Best used with @DerivingVia@, as shown in the tutorial.
newtype AsVariant a = AsVariant { AsVariant a -> a
unAsVariant :: a }

type CanBeCandidVariant a =
    ( Typeable a
    , Candid (V.Var (V.NativeRow a))
    , V.ToNative a
    , V.FromNative a
    -- Superclass constraints that need to be explicit since GHC 9.6
    , Typeable (V.NativeRow a)
    , V.AllUniqueLabels (V.NativeRow a)
    , V.AllUniqueLabels (V.Map (Either String) (V.NativeRow a))
    , V.Forall (V.NativeRow a) R.Unconstrained1
    , V.Forall (V.NativeRow a) Candid
    )
instance CanBeCandidVariant a => Candid (AsVariant a) where
    type AsCandid (AsVariant a) = AsCandid (V.Var (V.NativeRow a))
    toCandid :: AsVariant a -> AsCandid (AsVariant a)
toCandid = Candid (Var (NativeRow a)) =>
Var (NativeRow a) -> AsCandid (Var (NativeRow a))
forall a. Candid a => a -> AsCandid a
toCandid @(V.Var (V.NativeRow a)) (Var (NativeRowG (Rep a)) -> Var (NativeRowG (Rep a)))
-> (AsVariant a -> Var (NativeRowG (Rep a)))
-> AsVariant a
-> Var (NativeRowG (Rep a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Var (NativeRowG (Rep a))
forall t. FromNative t => t -> Var (NativeRow t)
V.fromNative (a -> Var (NativeRowG (Rep a)))
-> (AsVariant a -> a) -> AsVariant a -> Var (NativeRowG (Rep a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsVariant a -> a
forall a. AsVariant a -> a
unAsVariant
    fromCandid :: AsCandid (AsVariant a) -> AsVariant a
fromCandid = a -> AsVariant a
forall a. a -> AsVariant a
AsVariant (a -> AsVariant a)
-> (Var (NativeRowG (Rep a)) -> a)
-> Var (NativeRowG (Rep a))
-> AsVariant a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var (NativeRowG (Rep a)) -> a
forall t. ToNative t => Var (NativeRow t) -> t
V.toNative (Var (NativeRowG (Rep a)) -> a)
-> (Var (NativeRowG (Rep a)) -> Var (NativeRowG (Rep a)))
-> Var (NativeRowG (Rep a))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Candid (Var (NativeRow a)) =>
AsCandid (Var (NativeRow a)) -> Var (NativeRow a)
forall a. Candid a => AsCandid a -> a
fromCandid @(V.Var (V.NativeRow a))