{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

module Composite.Dhall.CoRecord () where

import           Composite.CoRecord    hiding (Op)
import           Composite.Record
import           Data.Functor.Compose
import           Data.Functor.Identity
import           Data.Vinyl
import qualified Dhall                 as D
import           GHC.TypeLits

class FromDhallUnion x where
  autoWithU :: D.InputNormalizer -> D.UnionDecoder x

instance (KnownSymbol s, D.FromDhall x) => FromDhallUnion (s :-> x) where
  autoWithU :: InputNormalizer -> UnionDecoder (s :-> x)
autoWithU InputNormalizer
opts =
    let nL :: (s :-> a)
        nL :: forall a. s :-> a
nL = forall a. HasCallStack => a
undefined
     in forall a. Text -> Decoder a -> UnionDecoder a
D.constructor (forall (s :: Symbol) a. KnownSymbol s => (s :-> a) -> Text
valName forall a. s :-> a
nL) (forall (s :: Symbol) a. a -> s :-> a
Val @s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromDhall a => InputNormalizer -> Decoder a
D.autoWith InputNormalizer
opts)

instance FromDhallUnion (Field '[]) where
  autoWithU :: InputNormalizer -> UnionDecoder (Field '[])
autoWithU = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Compose (Map Text) Decoder a -> UnionDecoder a
D.UnionDecoder forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a. Monoid a => a
mempty

instance FromDhallUnion x => FromDhallUnion (Identity x) where
  autoWithU :: InputNormalizer -> UnionDecoder (Identity x)
autoWithU InputNormalizer
opts = forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. FromDhallUnion x => InputNormalizer -> UnionDecoder x
autoWithU InputNormalizer
opts

instance (RMap xs, RecApplicative xs, FoldRec (s :-> x ': xs) (s :-> x ': xs), xs ⊆ (s :-> x ': xs), KnownSymbol s, FromDhallUnion (Field xs), D.FromDhall x) => D.FromDhall (Field (s :-> x ': xs)) where
  autoWith :: InputNormalizer -> Decoder (Field ((s :-> x) : xs))
autoWith InputNormalizer
opts = forall a. UnionDecoder a -> Decoder a
D.union forall a b. (a -> b) -> a -> b
$ forall x. FromDhallUnion x => InputNormalizer -> UnionDecoder x
autoWithU InputNormalizer
opts

instance (RMap xs, RecApplicative xs, KnownSymbol s, D.FromDhall x, xs ⊆ (s :-> x ': xs), FoldRec (s :-> x ': xs) (s :-> x ': xs), FromDhallUnion (Field xs)) => FromDhallUnion (Field (s :-> x ': xs)) where
  autoWithU :: InputNormalizer -> UnionDecoder (Field ((s :-> x) : xs))
autoWithU InputNormalizer
opts =
    let k :: Field xs -> Field (s :-> x ': xs)
        k :: Field xs -> Field ((s :-> x) : xs)
k = forall (ss :: [*]) (rs :: [*]).
(FoldRec ss ss, RMap rs, RMap ss, RecApplicative rs,
 RecApplicative ss, rs ⊆ ss) =>
Field rs -> Field ss
widenField
        l :: Field '[s :-> x] -> Field (s :-> x ': xs)
        l :: Field '[s :-> x] -> Field ((s :-> x) : xs)
l = forall (ss :: [*]) (rs :: [*]).
(FoldRec ss ss, RMap rs, RMap ss, RecApplicative rs,
 RecApplicative ss, rs ⊆ ss) =>
Field rs -> Field ss
widenField
        (UnionDecoder (Field ((s :-> x) : xs))
p :: D.UnionDecoder (Field (s :-> x ': xs))) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Field '[s :-> x] -> Field ((s :-> x) : xs)
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (r :: u) (b :: [u]) (a :: u -> *).
(r ∈ b) =>
a r -> CoRec a b
CoVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity) (forall x. FromDhallUnion x => InputNormalizer -> UnionDecoder x
autoWithU @(s :-> x) InputNormalizer
opts)
        (UnionDecoder (Field ((s :-> x) : xs))
q :: D.UnionDecoder (Field (s :-> x ': xs))) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field xs -> Field ((s :-> x) : xs)
k (forall x. FromDhallUnion x => InputNormalizer -> UnionDecoder x
autoWithU @(Field xs) InputNormalizer
opts)
     in (UnionDecoder (Field ((s :-> x) : xs))
p forall a. Semigroup a => a -> a -> a
<> UnionDecoder (Field ((s :-> x) : xs))
q :: D.UnionDecoder (Field (s :-> x ': xs)))