{-# language AllowAmbiguousTypes    #-}
{-# language DataKinds              #-}
{-# language FlexibleContexts       #-}
{-# language FlexibleInstances      #-}
{-# language FunctionalDependencies #-}
{-# language GADTs                  #-}
{-# language InstanceSigs           #-}
{-# language LambdaCase             #-}
{-# language OverloadedLabels       #-}
{-# language PartialTypeSignatures  #-}
{-# language PolyKinds              #-}
{-# language QuantifiedConstraints  #-}
{-# language RankNTypes             #-}
{-# language ScopedTypeVariables    #-}
{-# language TypeApplications       #-}
{-# language TypeFamilies           #-}
{-# language TypeOperators          #-}
{-# language UndecidableInstances   #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Mu.Schema.Lens (
  record,
  is
) where

import           Control.Lens
import           Data.Kind
import           Data.Map
import           Data.SOP
import qualified Data.Text            as T


import           GHC.Int
import           GHC.OverloadedLabels
import           GHC.TypeLits         hiding (Nat)
import           Mu.Schema

is :: s -> APrism' s () -> Bool
is :: s -> APrism' s () -> Bool
is s
s APrism' s ()
l = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ APrism' s () -> s -> Bool
forall s t a b. APrism s t a b -> s -> Bool
isn't APrism' s ()
l s
s

-- we need structurally inductive Nats
data Nat = Zero | Succ Nat

record :: BuildRecord sch args r => r -> Term sch ('DRecord name args)
record :: r -> Term sch ('DRecord name args)
record = NP (Field sch) args -> Term sch ('DRecord name args)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (name :: typeName).
NP (Field sch) args -> Term sch ('DRecord name args)
TRecord (NP (Field sch) args -> Term sch ('DRecord name args))
-> (r -> NP (Field sch) args) -> r -> Term sch ('DRecord name args)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> NP (Field sch) args
forall (sch :: Schema Symbol Symbol)
       (args :: [FieldDef Symbol Symbol]) r.
BuildRecord sch args r =>
r -> NP (Field sch) args
buildR

class BuildRecord (sch :: Schema Symbol Symbol) (args :: [FieldDef Symbol Symbol]) (r :: Type) | sch args -> r where
  buildR :: r -> NP (Field sch) args

instance
  {-# OVERLAPPABLE #-}
  ( Interpret sch fieldType ~ r,
    Uninterpret r ~ fieldType,
    UninterpretField sch r
  ) =>
  BuildRecord
    sch
    '[ 'FieldDef fieldName fieldType
     ]
    r
  where
  buildR :: r -> NP (Field sch) '[ 'FieldDef fieldName fieldType]
buildR r
val = FieldValue sch fieldType
-> Field sch ('FieldDef fieldName fieldType)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
Field (r -> FieldValue sch (Uninterpret r)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue r
val) Field sch ('FieldDef fieldName fieldType)
-> NP (Field sch) '[]
-> NP (Field sch) '[ 'FieldDef fieldName fieldType]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (Field sch) '[]
forall k (a :: k -> *). NP a '[]
Nil

instance
  ( Interpret sch fieldType1 ~ v1,
    Interpret sch fieldType2 ~ v2,
    Uninterpret v1 ~ fieldType1,
    Uninterpret v2 ~ fieldType2,
    All (UninterpretField sch) '[v1, v2]
  ) =>
  BuildRecord
    sch
    '[ 'FieldDef fieldName1 fieldType1,
       'FieldDef fieldName2 fieldType2
     ]
    (v1, v2)
  where
  buildR :: (v1, v2)
-> NP
     (Field sch)
     '[ 'FieldDef fieldName1 fieldType1,
        'FieldDef fieldName2 fieldType2]
buildR (v1
v1, v2
v2) = FieldValue sch fieldType1
-> Field sch ('FieldDef fieldName1 fieldType1)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
Field (v1 -> FieldValue sch (Uninterpret v1)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue v1
v1) Field sch ('FieldDef fieldName1 fieldType1)
-> NP (Field sch) '[ 'FieldDef fieldName2 fieldType2]
-> NP
     (Field sch)
     '[ 'FieldDef fieldName1 fieldType1,
        'FieldDef fieldName2 fieldType2]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FieldValue sch fieldType2
-> Field sch ('FieldDef fieldName2 fieldType2)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
Field (v2 -> FieldValue sch (Uninterpret v2)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue v2
v2) Field sch ('FieldDef fieldName2 fieldType2)
-> NP (Field sch) '[]
-> NP (Field sch) '[ 'FieldDef fieldName2 fieldType2]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (Field sch) '[]
forall k (a :: k -> *). NP a '[]
Nil

instance
  ( Interpret sch fieldType1 ~ v1,
    Interpret sch fieldType2 ~ v2,
    Interpret sch fieldType3 ~ v3,
    Uninterpret v1 ~ fieldType1,
    Uninterpret v2 ~ fieldType2,
    Uninterpret v3 ~ fieldType3,
    All (UninterpretField sch) '[v1, v2, v3]
  ) =>
  BuildRecord
    sch
    '[ 'FieldDef fieldName1 fieldType1,
       'FieldDef fieldName2 fieldType2,
       'FieldDef fieldName3 fieldType3
     ]
    (v1, v2, v3)
  where
  buildR :: (v1, v2, v3)
-> NP
     (Field sch)
     '[ 'FieldDef fieldName1 fieldType1,
        'FieldDef fieldName2 fieldType2, 'FieldDef fieldName3 fieldType3]
buildR (v1
v1, v2
v2, v3
v3) =
    FieldValue sch fieldType1
-> Field sch ('FieldDef fieldName1 fieldType1)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
Field (v1 -> FieldValue sch (Uninterpret v1)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue v1
v1)
      Field sch ('FieldDef fieldName1 fieldType1)
-> NP
     (Field sch)
     '[ 'FieldDef fieldName2 fieldType2,
        'FieldDef fieldName3 fieldType3]
-> NP
     (Field sch)
     '[ 'FieldDef fieldName1 fieldType1,
        'FieldDef fieldName2 fieldType2, 'FieldDef fieldName3 fieldType3]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FieldValue sch fieldType2
-> Field sch ('FieldDef fieldName2 fieldType2)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
Field (v2 -> FieldValue sch (Uninterpret v2)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue v2
v2)
      Field sch ('FieldDef fieldName2 fieldType2)
-> NP (Field sch) '[ 'FieldDef fieldName3 fieldType3]
-> NP
     (Field sch)
     '[ 'FieldDef fieldName2 fieldType2,
        'FieldDef fieldName3 fieldType3]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FieldValue sch fieldType3
-> Field sch ('FieldDef fieldName3 fieldType3)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
Field (v3 -> FieldValue sch (Uninterpret v3)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue v3
v3)
      Field sch ('FieldDef fieldName3 fieldType3)
-> NP (Field sch) '[]
-> NP (Field sch) '[ 'FieldDef fieldName3 fieldType3]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (Field sch) '[]
forall k (a :: k -> *). NP a '[]
Nil

instance
  ( Functor f,
    HasFieldIx (IndexOf fieldName fields) fields fields' fieldType fieldType',
    Interpret sch fieldType ~ fieldValue,
    Interpret sch fieldType' ~ fieldValue',
    Uninterpret fieldValue ~ fieldType,
    Uninterpret fieldValue' ~ fieldType',
    UninterpretField sch fieldValue'
  ) =>
  IsLabel
    fieldName
    ( (fieldValue -> f fieldValue') ->
      (Term sch ('DRecord name fields) -> f (Term sch ('DRecord name fields')))
    )
  where
  fromLabel :: (fieldValue -> f fieldValue')
-> Term sch ('DRecord name fields)
-> f (Term sch ('DRecord name fields'))
fromLabel = forall (sch :: Schema Symbol Symbol) (name :: Symbol)
       (fieldDefs :: [FieldDef Symbol Symbol])
       (fieldDefs' :: [FieldDef Symbol Symbol])
       (fieldType :: FieldType Symbol) (fieldType' :: FieldType Symbol)
       fieldValue fieldValue'.
(HasFieldIx
   (IndexOf fieldName fieldDefs)
   fieldDefs
   fieldDefs'
   fieldType
   fieldType',
 HasFieldIx
   (IndexOf fieldName fieldDefs)
   fieldDefs
   fieldDefs'
   fieldType
   fieldType',
 Interpret sch fieldType ~ fieldValue,
 Interpret sch fieldType' ~ fieldValue',
 Uninterpret fieldValue ~ fieldType,
 Uninterpret fieldValue' ~ fieldType',
 UninterpretField sch fieldValue') =>
Lens
  (Term sch ('DRecord name fieldDefs))
  (Term sch ('DRecord name fieldDefs'))
  fieldValue
  fieldValue'
forall (fieldName :: Symbol) (sch :: Schema Symbol Symbol)
       (name :: Symbol) (fieldDefs :: [FieldDef Symbol Symbol])
       (fieldDefs' :: [FieldDef Symbol Symbol])
       (fieldType :: FieldType Symbol) (fieldType' :: FieldType Symbol)
       fieldValue fieldValue'.
(HasFieldIx
   (IndexOf fieldName fieldDefs)
   fieldDefs
   fieldDefs'
   fieldType
   fieldType',
 HasFieldIx
   (IndexOf fieldName fieldDefs)
   fieldDefs
   fieldDefs'
   fieldType
   fieldType',
 Interpret sch fieldType ~ fieldValue,
 Interpret sch fieldType' ~ fieldValue',
 Uninterpret fieldValue ~ fieldType,
 Uninterpret fieldValue' ~ fieldType',
 UninterpretField sch fieldValue') =>
Lens
  (Term sch ('DRecord name fieldDefs))
  (Term sch ('DRecord name fieldDefs'))
  fieldValue
  fieldValue'
field @fieldName

instance
  forall choiceName p f sch name choiceDefs choiceDefs' choiceType choiceType'.
  ( Choice p,
    Applicative f,
    HasChoiceIx (ChoiceIndexOf choiceName choiceDefs) choiceDefs choiceDefs' choiceType choiceType'
  ) =>
  IsLabel
    choiceName
    ( p choiceType (f choiceType') ->
      p (Term sch ('DEnum name choiceDefs)) (f (Term sch ('DEnum name choiceDefs')))
    )
  where
  fromLabel :: p choiceType (f choiceType')
-> p (Term sch ('DEnum name choiceDefs))
     (f (Term sch ('DEnum name choiceDefs')))
fromLabel = forall (sch :: Schema typeName Symbol) (name :: typeName)
       (choiceDefs :: [ChoiceDef Symbol])
       (choiceDefs' :: [ChoiceDef Symbol]) choiceType choiceType'.
HasChoiceIx
  (ChoiceIndexOf choiceName choiceDefs)
  choiceDefs
  choiceDefs'
  choiceType
  choiceType' =>
Prism
  (Term sch ('DEnum name choiceDefs))
  (Term sch ('DEnum name choiceDefs'))
  choiceType
  choiceType'
forall typeName (choiceName :: Symbol)
       (sch :: Schema typeName Symbol) (name :: typeName)
       (choiceDefs :: [ChoiceDef Symbol])
       (choiceDefs' :: [ChoiceDef Symbol]) choiceType choiceType'.
HasChoiceIx
  (ChoiceIndexOf choiceName choiceDefs)
  choiceDefs
  choiceDefs'
  choiceType
  choiceType' =>
Prism
  (Term sch ('DEnum name choiceDefs))
  (Term sch ('DEnum name choiceDefs'))
  choiceType
  choiceType'
choose @choiceName

choose ::
  forall (choiceName :: Symbol) sch name choiceDefs choiceDefs' choiceType choiceType'.
  (HasChoiceIx (ChoiceIndexOf choiceName choiceDefs) choiceDefs choiceDefs' choiceType choiceType') =>
  Prism
    (Term sch ('DEnum name choiceDefs))
    (Term sch ('DEnum name choiceDefs'))
    choiceType
    choiceType'
choose :: Prism
  (Term sch ('DEnum name choiceDefs))
  (Term sch ('DEnum name choiceDefs'))
  choiceType
  choiceType'
choose = forall (choiceDefs :: [ChoiceDef Symbol])
       (choiceDefs' :: [ChoiceDef Symbol]) choiceType choiceType' typeName
       (sch :: Schema typeName Symbol) (name :: typeName)
       (name' :: typeName).
HasChoiceIx
  (ChoiceIndexOf choiceName choiceDefs)
  choiceDefs
  choiceDefs'
  choiceType
  choiceType' =>
Prism
  (Term sch ('DEnum name choiceDefs))
  (Term sch ('DEnum name' choiceDefs'))
  choiceType
  choiceType'
forall (choiceIndex :: Nat) (choiceDefs :: [ChoiceDef Symbol])
       (choiceDefs' :: [ChoiceDef Symbol]) choiceType choiceType' typeName
       (sch :: Schema typeName Symbol) (name :: typeName)
       (name' :: typeName).
HasChoiceIx
  choiceIndex choiceDefs choiceDefs' choiceType choiceType' =>
Prism
  (Term sch ('DEnum name choiceDefs))
  (Term sch ('DEnum name' choiceDefs'))
  choiceType
  choiceType'
chooseIx @(ChoiceIndexOf choiceName choiceDefs)

class
  HasChoiceIx
    (choiceIndex :: Nat)
    (choiceDefs :: [ChoiceDef Symbol])
    (choiceDefs' :: [ChoiceDef Symbol])
    choiceType
    choiceType'
    | choiceIndex choiceDefs -> choiceType,
      choiceIndex choiceDefs' -> choiceType',
      choiceIndex choiceDefs choiceType' -> choiceDefs',
      choiceIndex choiceDefs' choiceType -> choiceDefs where
  chooseIx ::
    Prism
      (Term sch ('DEnum name choiceDefs))
      (Term sch ('DEnum name' choiceDefs'))
      choiceType
      choiceType'

instance
  HasChoiceIx
    'Zero
    ('ChoiceDef choiceName ': choiceDefs)
    ('ChoiceDef choiceName ': choiceDefs)
    ()
    ()
  where
  chooseIx :: p () (f ())
-> p (Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs)))
     (f (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))))
chooseIx p () (f ())
f = (Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
 -> Either
      (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))) ())
-> (Either
      (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs)))
      (f ())
    -> f (Term
            sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))))
-> p (Either
        (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))) ())
     (Either
        (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs)))
        (f ()))
-> p (Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs)))
     (f (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
-> Either
     (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))) ()
forall typeName (sch :: Schema typeName Symbol) (name :: typeName)
       (name' :: typeName) (choiceName' :: Symbol).
Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
-> Either
     (Term sch ('DEnum name' ('ChoiceDef choiceName' : choiceDefs))) ()
project ((Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))
 -> f (Term
         sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))))
-> (f ()
    -> f (Term
            sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))))
-> Either
     (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs)))
     (f ())
-> f (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs)))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))
-> f (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((()
 -> Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs)))
-> f ()
-> f (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))
forall typeName (sch :: Schema typeName Symbol) (name :: typeName).
() -> Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
inject)) (p () (f ())
-> p (Either
        (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs))) ())
     (Either
        (Term sch ('DEnum name' ('ChoiceDef choiceName : choiceDefs)))
        (f ()))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' p () (f ())
f)
    where
      inject :: () -> Term sch ('DEnum name ('ChoiceDef choiceName ': choiceDefs))
      inject :: () -> Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
inject () = NS Proxy ('ChoiceDef choiceName : choiceDefs)
-> Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
TEnum (Proxy ('ChoiceDef choiceName)
-> NS Proxy ('ChoiceDef choiceName : choiceDefs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (Proxy ('ChoiceDef choiceName)
forall k (t :: k). Proxy t
Proxy @('ChoiceDef choiceName)))
      project ::
        Term sch ('DEnum name ('ChoiceDef choiceName ': choiceDefs)) ->
        Either (Term sch ('DEnum name' ('ChoiceDef choiceName' ': choiceDefs))) ()
      project :: Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
-> Either
     (Term sch ('DEnum name' ('ChoiceDef choiceName' : choiceDefs))) ()
project Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
term = case Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
term of
        TEnum (Z Proxy x
Proxy) -> ()
-> Either
     (Term sch ('DEnum name' ('ChoiceDef choiceName' : choiceDefs))) ()
forall a b. b -> Either a b
Right ()
        Term sch ('DEnum name ('ChoiceDef choiceName : choiceDefs))
_               -> Term sch ('DEnum name' ('ChoiceDef choiceName' : choiceDefs))
-> Either
     (Term sch ('DEnum name' ('ChoiceDef choiceName' : choiceDefs))) ()
forall a b. a -> Either a b
Left (NS Proxy ('ChoiceDef choiceName' : choiceDefs)
-> Term sch ('DEnum name' ('ChoiceDef choiceName' : choiceDefs))
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
TEnum (Proxy ('ChoiceDef choiceName')
-> NS Proxy ('ChoiceDef choiceName' : choiceDefs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z Proxy ('ChoiceDef choiceName')
forall k (t :: k). Proxy t
Proxy))

instance
  (HasChoiceIx choiceIndex choiceDefs choiceDefs' choiceType choiceType') =>
  HasChoiceIx
    ('Succ choiceIndex)
    (choiceDef ': choiceDefs)
    (choiceDef ': choiceDefs')
    choiceType
    choiceType'
  where
  chooseIx :: p choiceType (f choiceType')
-> p (Term sch ('DEnum name (choiceDef : choiceDefs)))
     (f (Term sch ('DEnum name' (choiceDef : choiceDefs'))))
chooseIx p choiceType (f choiceType')
f =
    (Term sch ('DEnum name (choiceDef : choiceDefs))
 -> Either () (Term sch ('DEnum name choiceDefs)))
-> (Either () (f (Term sch ('DEnum name' choiceDefs')))
    -> f (Term sch ('DEnum name' (choiceDef : choiceDefs'))))
-> p (Either () (Term sch ('DEnum name choiceDefs)))
     (Either () (f (Term sch ('DEnum name' choiceDefs'))))
-> p (Term sch ('DEnum name (choiceDef : choiceDefs)))
     (f (Term sch ('DEnum name' (choiceDef : choiceDefs'))))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap
      Term sch ('DEnum name (choiceDef : choiceDefs))
-> Either () (Term sch ('DEnum name choiceDefs))
forall typeName (sch :: Schema typeName Symbol) (name :: typeName).
Term sch ('DEnum name (choiceDef : choiceDefs))
-> Either () (Term sch ('DEnum name choiceDefs))
project
      Either () (f (Term sch ('DEnum name' choiceDefs')))
-> f (Term sch ('DEnum name' (choiceDef : choiceDefs')))
forall typeName (f :: * -> *) (sch :: Schema typeName Symbol)
       (name :: typeName).
Applicative f =>
Either () (f (Term sch ('DEnum name choiceDefs')))
-> f (Term sch ('DEnum name (choiceDef : choiceDefs')))
inject
      (p (Term sch ('DEnum name choiceDefs))
  (f (Term sch ('DEnum name' choiceDefs')))
-> p (Either () (Term sch ('DEnum name choiceDefs)))
     (Either () (f (Term sch ('DEnum name' choiceDefs'))))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' (p choiceType (f choiceType')
-> p (Term sch ('DEnum name choiceDefs))
     (f (Term sch ('DEnum name' choiceDefs')))
forall (choiceIndex :: Nat) (choiceDefs :: [ChoiceDef Symbol])
       (choiceDefs' :: [ChoiceDef Symbol]) choiceType choiceType' typeName
       (sch :: Schema typeName Symbol) (name :: typeName)
       (name' :: typeName).
HasChoiceIx
  choiceIndex choiceDefs choiceDefs' choiceType choiceType' =>
Prism
  (Term sch ('DEnum name choiceDefs))
  (Term sch ('DEnum name' choiceDefs'))
  choiceType
  choiceType'
chooseIx @choiceIndex @choiceDefs @choiceDefs' p choiceType (f choiceType')
f))
    where
      project ::
        Term sch ('DEnum name (choiceDef ': choiceDefs)) ->
        Either () (Term sch ('DEnum name choiceDefs))
      project :: Term sch ('DEnum name (choiceDef : choiceDefs))
-> Either () (Term sch ('DEnum name choiceDefs))
project (TEnum (Z Proxy x
Proxy)) = () -> Either () (Term sch ('DEnum name choiceDefs))
forall a b. a -> Either a b
Left ()
      project (TEnum (S NS Proxy xs
inner)) = Term sch ('DEnum name xs) -> Either () (Term sch ('DEnum name xs))
forall a b. b -> Either a b
Right (NS Proxy xs -> Term sch ('DEnum name xs)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
TEnum NS Proxy xs
inner)
      inject ::
        Applicative f =>
        Either () (f (Term sch ('DEnum name choiceDefs'))) ->
        f (Term sch ('DEnum name (choiceDef ': choiceDefs')))
      inject :: Either () (f (Term sch ('DEnum name choiceDefs')))
-> f (Term sch ('DEnum name (choiceDef : choiceDefs')))
inject (Left ())     = Term sch ('DEnum name (choiceDef : choiceDefs'))
-> f (Term sch ('DEnum name (choiceDef : choiceDefs')))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NS Proxy (choiceDef : choiceDefs')
-> Term sch ('DEnum name (choiceDef : choiceDefs'))
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
TEnum (Proxy choiceDef -> NS Proxy (choiceDef : choiceDefs')
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z Proxy choiceDef
forall k (t :: k). Proxy t
Proxy))
      inject (Right f (Term sch ('DEnum name choiceDefs'))
inner) = (Term sch ('DEnum name choiceDefs')
 -> Term sch ('DEnum name (choiceDef : choiceDefs')))
-> f (Term sch ('DEnum name choiceDefs'))
-> f (Term sch ('DEnum name (choiceDef : choiceDefs')))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term sch ('DEnum name choiceDefs')
-> Term sch ('DEnum name (choiceDef : choiceDefs'))
forall typeName (sch :: Schema typeName Symbol) (name :: typeName).
Term sch ('DEnum name choiceDefs')
-> Term sch ('DEnum name (choiceDef : choiceDefs'))
wrap f (Term sch ('DEnum name choiceDefs'))
inner
      wrap :: Term sch ('DEnum name choiceDefs') -> Term sch ('DEnum name (choiceDef ': choiceDefs'))
      wrap :: Term sch ('DEnum name choiceDefs')
-> Term sch ('DEnum name (choiceDef : choiceDefs'))
wrap (TEnum NS Proxy choices
choices) = NS Proxy (choiceDef : choices)
-> Term sch ('DEnum name (choiceDef : choices))
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
TEnum (NS Proxy choices -> NS Proxy (choiceDef : choices)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S NS Proxy choices
choices)

field ::
  forall fieldName sch name fieldDefs fieldDefs' fieldType fieldType' fieldValue fieldValue'.
  (HasFieldIx (IndexOf fieldName fieldDefs) fieldDefs fieldDefs' fieldType fieldType') =>
  ( HasFieldIx (IndexOf fieldName fieldDefs) fieldDefs fieldDefs' fieldType fieldType',
    Interpret sch fieldType ~ fieldValue,
    Interpret sch fieldType' ~ fieldValue',
    Uninterpret fieldValue ~ fieldType,
    Uninterpret fieldValue' ~ fieldType',
    UninterpretField sch fieldValue'
  ) =>
  Lens
    (Term sch ('DRecord name fieldDefs))
    (Term sch ('DRecord name fieldDefs'))
    fieldValue
    fieldValue'
field :: Lens
  (Term sch ('DRecord name fieldDefs))
  (Term sch ('DRecord name fieldDefs'))
  fieldValue
  fieldValue'
field = forall (sch :: Schema Symbol Symbol) (name :: Symbol)
       (fieldDefs :: [FieldDef Symbol Symbol])
       (fieldDefs' :: [FieldDef Symbol Symbol])
       (fieldType :: FieldType Symbol) (fieldType' :: FieldType Symbol).
HasFieldIx
  (IndexOf fieldName fieldDefs)
  fieldDefs
  fieldDefs'
  fieldType
  fieldType' =>
Lens
  (Term sch ('DRecord name fieldDefs))
  (Term sch ('DRecord name fieldDefs'))
  (FieldValue sch fieldType)
  (FieldValue sch fieldType')
forall (fieldName :: Symbol) (sch :: Schema Symbol Symbol)
       (name :: Symbol) (fieldDefs :: [FieldDef Symbol Symbol])
       (fieldDefs' :: [FieldDef Symbol Symbol])
       (fieldType :: FieldType Symbol) (fieldType' :: FieldType Symbol).
HasFieldIx
  (IndexOf fieldName fieldDefs)
  fieldDefs
  fieldDefs'
  fieldType
  fieldType' =>
Lens
  (Term sch ('DRecord name fieldDefs))
  (Term sch ('DRecord name fieldDefs'))
  (FieldValue sch fieldType)
  (FieldValue sch fieldType')
fieldValueName @fieldName ((FieldValue sch fieldType -> f (FieldValue sch fieldType'))
 -> Term sch ('DRecord name fieldDefs)
 -> f (Term sch ('DRecord name fieldDefs')))
-> ((fieldValue -> f fieldValue')
    -> FieldValue sch fieldType -> f (FieldValue sch fieldType'))
-> (fieldValue -> f fieldValue')
-> Term sch ('DRecord name fieldDefs)
-> f (Term sch ('DRecord name fieldDefs'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (fieldValue -> f fieldValue')
-> FieldValue sch fieldType -> f (FieldValue sch fieldType')
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fieldType' :: FieldType typeName)
       (fieldType :: FieldType typeName).
(Uninterpret (Interpret sch fieldType') ~ fieldType',
 UninterpretField sch (Interpret sch fieldType')) =>
Iso
  (FieldValue sch fieldType)
  (FieldValue sch fieldType')
  (Interpret sch fieldType)
  (Interpret sch fieldType')
interpretIso

fieldValueName ::
  forall fieldName sch name fieldDefs fieldDefs' fieldType fieldType'.
  (HasFieldIx (IndexOf fieldName fieldDefs) fieldDefs fieldDefs' fieldType fieldType') =>
  Lens
    (Term sch ('DRecord name fieldDefs))
    (Term sch ('DRecord name fieldDefs'))
    (FieldValue sch fieldType)
    (FieldValue sch fieldType')
fieldValueName :: Lens
  (Term sch ('DRecord name fieldDefs))
  (Term sch ('DRecord name fieldDefs'))
  (FieldValue sch fieldType)
  (FieldValue sch fieldType')
fieldValueName = forall (fieldDefs :: [FieldDef Symbol Symbol])
       (fieldDefs' :: [FieldDef Symbol Symbol])
       (fieldType :: FieldType Symbol) (fieldType' :: FieldType Symbol)
       (sch :: Schema Symbol Symbol) (name :: Symbol) (name' :: Symbol).
HasFieldIx
  (IndexOf fieldName fieldDefs)
  fieldDefs
  fieldDefs'
  fieldType
  fieldType' =>
Lens
  (Term sch ('DRecord name fieldDefs))
  (Term sch ('DRecord name' fieldDefs'))
  (FieldValue sch fieldType)
  (FieldValue sch fieldType')
forall (fieldIndex :: Nat) (fieldDefs :: [FieldDef Symbol Symbol])
       (fieldDefs' :: [FieldDef Symbol Symbol])
       (fieldType :: FieldType Symbol) (fieldType' :: FieldType Symbol)
       (sch :: Schema Symbol Symbol) (name :: Symbol) (name' :: Symbol).
HasFieldIx fieldIndex fieldDefs fieldDefs' fieldType fieldType' =>
Lens
  (Term sch ('DRecord name fieldDefs))
  (Term sch ('DRecord name' fieldDefs'))
  (FieldValue sch fieldType)
  (FieldValue sch fieldType')
fieldValueIx @(IndexOf fieldName fieldDefs)

type family IndexOf (fieldName :: fieldNameKind) (fieldDefs :: [FieldDefB builtin fieldNameKind typeNameKind]) :: Nat where
  IndexOf fieldName ('FieldDef fieldName _ ': _) = 'Zero
  IndexOf fieldName (_ ': fieldDefs) = 'Succ (IndexOf fieldName fieldDefs)
  IndexOf fieldName '[] = TypeError ('Text "does not contain field name " ':<>: 'ShowType fieldName)

type family
  ChoiceIndexOf
    (choiceName :: choiceNameKind)
    (choiceDefs :: [ChoiceDef choiceNameKind]) ::
    Nat where
  ChoiceIndexOf choiceName ('ChoiceDef choiceName : _) = 'Zero
  ChoiceIndexOf choiceName (_ ': choiceDefs) = 'Succ (ChoiceIndexOf choiceName choiceDefs)

class
  HasFieldIx
    (fieldIndex :: Nat)
    (fieldDefs :: [FieldDef Symbol Symbol])
    (fieldDefs' :: [FieldDef Symbol Symbol])
    (fieldType :: FieldType Symbol)
    (fieldType' :: FieldType Symbol)
    | fieldIndex fieldDefs -> fieldType,
      fieldIndex fieldDefs' -> fieldType',
      fieldIndex fieldDefs fieldType' -> fieldDefs',
      fieldIndex fieldDefs' fieldType -> fieldDefs where
  fieldValueIx ::
    Lens
      (Term sch ('DRecord name fieldDefs))
      (Term sch ('DRecord name' fieldDefs'))
      (FieldValue sch fieldType)
      (FieldValue sch fieldType')

instance
  HasFieldIx
    'Zero
    ('FieldDef fieldName fieldType ': fieldDefs)
    ('FieldDef fieldName fieldType' ': fieldDefs)
    fieldType
    fieldType'
  where
  fieldValueIx :: (FieldValue sch fieldType -> f (FieldValue sch fieldType'))
-> Term
     sch ('DRecord name ('FieldDef fieldName fieldType : fieldDefs))
-> f (Term
        sch ('DRecord name' ('FieldDef fieldName fieldType' : fieldDefs)))
fieldValueIx FieldValue sch fieldType -> f (FieldValue sch fieldType')
f (TRecord (Field FieldValue sch t
fieldValue :* NP (Field sch) xs
fields)) = NP (Field sch) ('FieldDef fieldName fieldType' : xs)
-> Term sch ('DRecord name' ('FieldDef fieldName fieldType' : xs))
forall typeName fieldName (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (name :: typeName).
NP (Field sch) args -> Term sch ('DRecord name args)
TRecord (NP (Field sch) ('FieldDef fieldName fieldType' : xs)
 -> Term sch ('DRecord name' ('FieldDef fieldName fieldType' : xs)))
-> (FieldValue sch fieldType'
    -> NP (Field sch) ('FieldDef fieldName fieldType' : xs))
-> FieldValue sch fieldType'
-> Term sch ('DRecord name' ('FieldDef fieldName fieldType' : xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Field sch ('FieldDef fieldName fieldType')
-> NP (Field sch) xs
-> NP (Field sch) ('FieldDef fieldName fieldType' : xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (Field sch) xs
fields) (Field sch ('FieldDef fieldName fieldType')
 -> NP (Field sch) ('FieldDef fieldName fieldType' : xs))
-> (FieldValue sch fieldType'
    -> Field sch ('FieldDef fieldName fieldType'))
-> FieldValue sch fieldType'
-> NP (Field sch) ('FieldDef fieldName fieldType' : xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldValue sch fieldType'
-> Field sch ('FieldDef fieldName fieldType')
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
Field (FieldValue sch fieldType'
 -> Term sch ('DRecord name' ('FieldDef fieldName fieldType' : xs)))
-> f (FieldValue sch fieldType')
-> f (Term
        sch ('DRecord name' ('FieldDef fieldName fieldType' : xs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldValue sch fieldType -> f (FieldValue sch fieldType')
f FieldValue sch fieldType
FieldValue sch t
fieldValue

instance
  ( HasFieldIx
      fieldIndex
      fieldDefs
      fieldDefs'
      fieldType
      fieldType'
  ) =>
  HasFieldIx ('Succ fieldIndex) (fieldDef ': fieldDefs) (fieldDef ': fieldDefs') fieldType fieldType'
  where
  fieldValueIx :: (FieldValue sch fieldType -> f (FieldValue sch fieldType'))
-> Term sch ('DRecord name (fieldDef : fieldDefs))
-> f (Term sch ('DRecord name' (fieldDef : fieldDefs')))
fieldValueIx FieldValue sch fieldType -> f (FieldValue sch fieldType')
f (TRecord (Field sch x
firstField :* NP (Field sch) xs
restOfFields)) =
    Term sch ('DRecord Any fieldDefs')
-> Term sch ('DRecord name' (fieldDef : fieldDefs'))
wrap (Term sch ('DRecord Any fieldDefs')
 -> Term sch ('DRecord name' (fieldDef : fieldDefs')))
-> f (Term sch ('DRecord Any fieldDefs'))
-> f (Term sch ('DRecord name' (fieldDef : fieldDefs')))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldValue sch fieldType -> f (FieldValue sch fieldType'))
-> Term sch ('DRecord Any xs)
-> f (Term sch ('DRecord Any fieldDefs'))
forall (fieldIndex :: Nat) (fieldDefs :: [FieldDef Symbol Symbol])
       (fieldDefs' :: [FieldDef Symbol Symbol])
       (fieldType :: FieldType Symbol) (fieldType' :: FieldType Symbol)
       (sch :: Schema Symbol Symbol) (name :: Symbol) (name' :: Symbol).
HasFieldIx fieldIndex fieldDefs fieldDefs' fieldType fieldType' =>
Lens
  (Term sch ('DRecord name fieldDefs))
  (Term sch ('DRecord name' fieldDefs'))
  (FieldValue sch fieldType)
  (FieldValue sch fieldType')
fieldValueIx @fieldIndex FieldValue sch fieldType -> f (FieldValue sch fieldType')
f (NP (Field sch) xs -> Term sch ('DRecord Any xs)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (name :: typeName).
NP (Field sch) args -> Term sch ('DRecord name args)
TRecord NP (Field sch) xs
restOfFields)
    where
      wrap :: Term sch ('DRecord Any fieldDefs')
-> Term sch ('DRecord name' (fieldDef : fieldDefs'))
wrap (TRecord NP (Field sch) args
fields) = NP (Field sch) (x : fieldDefs')
-> Term sch ('DRecord name' (x : fieldDefs'))
forall typeName fieldName (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (name :: typeName).
NP (Field sch) args -> Term sch ('DRecord name args)
TRecord (Field sch x
firstField Field sch x
-> NP (Field sch) fieldDefs' -> NP (Field sch) (x : fieldDefs')
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (Field sch) fieldDefs'
NP (Field sch) args
fields)

interpretIso ::
  ( Uninterpret (Interpret sch fieldType') ~ fieldType',
    UninterpretField sch (Interpret sch fieldType')
  ) =>
  Iso (FieldValue sch fieldType) (FieldValue sch fieldType') (Interpret sch fieldType) (Interpret sch fieldType')
interpretIso :: Iso
  (FieldValue sch fieldType)
  (FieldValue sch fieldType')
  (Interpret sch fieldType)
  (Interpret sch fieldType')
interpretIso = (FieldValue sch fieldType -> Interpret sch fieldType)
-> (f (Interpret sch fieldType') -> f (FieldValue sch fieldType'))
-> p (Interpret sch fieldType) (f (Interpret sch fieldType'))
-> p (FieldValue sch fieldType) (f (FieldValue sch fieldType'))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap FieldValue sch fieldType -> Interpret sch fieldType
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fieldType :: FieldType typeName).
FieldValue sch fieldType -> Interpret sch fieldType
fromFieldValue ((Interpret sch fieldType' -> FieldValue sch fieldType')
-> f (Interpret sch fieldType') -> f (FieldValue sch fieldType')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Interpret sch fieldType' -> FieldValue sch fieldType'
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue)

type family Interpret (sch :: Schema typeName fieldName) (fieldType :: FieldType typeName) :: Type where
  Interpret _ 'TNull = ()
  Interpret _ ('TPrimitive builtin) = builtin
  Interpret sch ('TSchematic typeName) = Term sch (sch :/: typeName)
  Interpret sch ('TOption innerType) = Maybe (Interpret sch innerType)
  Interpret sch ('TList innerType) = [Interpret sch innerType]
  Interpret sch ('TMap keyType valueType) = Map (Interpret sch keyType) (Interpret sch valueType)
  Interpret sch ('TUnion choiceTypes) = NS Identity (InterpretList sch choiceTypes)

type family InterpretList sch (fieldTypes :: [FieldType typeName]) :: [Type] where
  InterpretList _ '[] = '[]
  InterpretList sch (t ': ts) = (Interpret sch t ': InterpretList sch ts)

fromFieldValue :: FieldValue sch fieldType -> Interpret sch fieldType
fromFieldValue :: FieldValue sch fieldType -> Interpret sch fieldType
fromFieldValue = \case
  FieldValue sch fieldType
FNull -> ()
  (FPrimitive t1
val) -> t1
Interpret sch fieldType
val
  (FSchematic Term sch (sch :/: t1)
term) -> Term sch (sch :/: t1)
Interpret sch fieldType
term
  (FOption Maybe (FieldValue sch t1)
maybeFieldValue) -> FieldValue sch t1 -> Interpret sch t1
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fieldType :: FieldType typeName).
FieldValue sch fieldType -> Interpret sch fieldType
fromFieldValue (FieldValue sch t1 -> Interpret sch t1)
-> Maybe (FieldValue sch t1) -> Maybe (Interpret sch t1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FieldValue sch t1)
maybeFieldValue
  (FList [FieldValue sch t1]
listFieldValues) -> FieldValue sch t1 -> Interpret sch t1
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fieldType :: FieldType typeName).
FieldValue sch fieldType -> Interpret sch fieldType
fromFieldValue (FieldValue sch t1 -> Interpret sch t1)
-> [FieldValue sch t1] -> [Interpret sch t1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldValue sch t1]
listFieldValues
  (FMap Map (FieldValue sch k) (FieldValue sch v)
mapFieldValues) -> (FieldValue sch k -> Interpret sch k)
-> Map (FieldValue sch k) (Interpret sch v)
-> Map (Interpret sch k) (Interpret sch v)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeysMonotonic FieldValue sch k -> Interpret sch k
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fieldType :: FieldType typeName).
FieldValue sch fieldType -> Interpret sch fieldType
fromFieldValue (FieldValue sch v -> Interpret sch v
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fieldType :: FieldType typeName).
FieldValue sch fieldType -> Interpret sch fieldType
fromFieldValue (FieldValue sch v -> Interpret sch v)
-> Map (FieldValue sch k) (FieldValue sch v)
-> Map (FieldValue sch k) (Interpret sch v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (FieldValue sch k) (FieldValue sch v)
mapFieldValues)
  (FUnion (Z FieldValue sch x
val)) -> Identity (Interpret sch x)
-> NS Identity (Interpret sch x : InterpretList sch xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (Interpret sch x -> Identity (Interpret sch x)
forall a. a -> Identity a
Identity (FieldValue sch x -> Interpret sch x
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fieldType :: FieldType typeName).
FieldValue sch fieldType -> Interpret sch fieldType
fromFieldValue FieldValue sch x
val))
  (FUnion (S NS (FieldValue sch) xs
val)) -> NS Identity (InterpretList sch xs)
-> NS Identity (Interpret sch x : InterpretList sch xs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (FieldValue sch ('TUnion xs) -> Interpret sch ('TUnion xs)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fieldType :: FieldType typeName).
FieldValue sch fieldType -> Interpret sch fieldType
fromFieldValue (NS (FieldValue sch) xs -> FieldValue sch ('TUnion xs)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (choices :: [FieldType typeName]).
NS (FieldValue sch) choices -> FieldValue sch ('TUnion choices)
FUnion NS (FieldValue sch) xs
val))

class UninterpretField sch a where
  type Uninterpret a :: FieldType typeName
  toFieldValue :: a -> FieldValue sch (Uninterpret a)

instance UninterpretField sch () where
  type Uninterpret () = 'TNull
  toFieldValue :: () -> FieldValue sch (Uninterpret ())
toFieldValue () = FieldValue sch (Uninterpret ())
forall typeName fieldName (sch :: Schema typeName fieldName).
FieldValue sch 'TNull
FNull

instance UninterpretField sch Integer where
  type Uninterpret Integer = 'TPrimitive Integer
  toFieldValue :: Integer -> FieldValue sch (Uninterpret Integer)
toFieldValue = Integer -> FieldValue sch (Uninterpret Integer)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive

instance UninterpretField sch Int32 where
  type Uninterpret Int32 = 'TPrimitive Int32
  toFieldValue :: Int32 -> FieldValue sch (Uninterpret Int32)
toFieldValue = Int32 -> FieldValue sch (Uninterpret Int32)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive

instance UninterpretField sch Int where
  type Uninterpret Int = 'TPrimitive Int
  toFieldValue :: Int -> FieldValue sch (Uninterpret Int)
toFieldValue = Int -> FieldValue sch (Uninterpret Int)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive

instance UninterpretField sch T.Text where
  type Uninterpret T.Text = 'TPrimitive T.Text
  toFieldValue :: Text -> FieldValue sch (Uninterpret Text)
toFieldValue = Text -> FieldValue sch (Uninterpret Text)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive

instance
  ((sch :/: recordName) ~ 'DRecord recordName fieldDefs, sch ~ sch') =>
  UninterpretField sch (Term sch' ('DRecord recordName fieldDefs))
  where
  type Uninterpret (Term sch' ('DRecord recordName fieldDefs)) = 'TSchematic recordName
  toFieldValue :: Term sch' ('DRecord recordName fieldDefs)
-> FieldValue
     sch (Uninterpret (Term sch' ('DRecord recordName fieldDefs)))
toFieldValue = Term sch' ('DRecord recordName fieldDefs)
-> FieldValue
     sch (Uninterpret (Term sch' ('DRecord recordName fieldDefs)))
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t1 :: typeName).
Term sch (sch :/: t1) -> FieldValue sch ('TSchematic t1)
FSchematic

instance
  ((sch :/: enumName) ~ 'DEnum enumName choiceDefs) =>
  UninterpretField sch (Term sch ('DEnum enumName choiceDefs))
  where
  type Uninterpret (Term sch ('DEnum enumName choiceDefs)) = 'TSchematic enumName
  toFieldValue :: Term sch ('DEnum enumName choiceDefs)
-> FieldValue
     sch (Uninterpret (Term sch ('DEnum enumName choiceDefs)))
toFieldValue = Term sch ('DEnum enumName choiceDefs)
-> FieldValue
     sch (Uninterpret (Term sch ('DEnum enumName choiceDefs)))
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t1 :: typeName).
Term sch (sch :/: t1) -> FieldValue sch ('TSchematic t1)
FSchematic

instance (UninterpretField sch a) => UninterpretField sch (Maybe a) where
  type Uninterpret (Maybe a) = 'TOption (Uninterpret a)
  toFieldValue :: Maybe a -> FieldValue sch (Uninterpret (Maybe a))
toFieldValue = Maybe (FieldValue sch (Uninterpret a))
-> FieldValue sch ('TOption (Uninterpret a))
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t1 :: FieldType typeName).
Maybe (FieldValue sch t1) -> FieldValue sch ('TOption t1)
FOption (Maybe (FieldValue sch (Uninterpret a))
 -> FieldValue sch ('TOption (Uninterpret a)))
-> (Maybe a -> Maybe (FieldValue sch (Uninterpret a)))
-> Maybe a
-> FieldValue sch ('TOption (Uninterpret a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> FieldValue sch (Uninterpret a))
-> Maybe a -> Maybe (FieldValue sch (Uninterpret a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> FieldValue sch (Uninterpret a)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue

instance (UninterpretField sch a) => UninterpretField sch [a] where
  type Uninterpret [a] = 'TList (Uninterpret a)
  toFieldValue :: [a] -> FieldValue sch (Uninterpret [a])
toFieldValue = [FieldValue sch (Uninterpret a)]
-> FieldValue sch ('TList (Uninterpret a))
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t1 :: FieldType typeName).
[FieldValue sch t1] -> FieldValue sch ('TList t1)
FList ([FieldValue sch (Uninterpret a)]
 -> FieldValue sch ('TList (Uninterpret a)))
-> ([a] -> [FieldValue sch (Uninterpret a)])
-> [a]
-> FieldValue sch ('TList (Uninterpret a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> FieldValue sch (Uninterpret a))
-> [a] -> [FieldValue sch (Uninterpret a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> FieldValue sch (Uninterpret a)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue

instance
  (Ord (FieldValue sch (Uninterpret k)), UninterpretField sch k, UninterpretField sch v) =>
  UninterpretField sch (Map k v)
  where
  type Uninterpret (Map k v) = 'TMap (Uninterpret k) (Uninterpret v)
  toFieldValue :: Map k v -> FieldValue sch (Uninterpret (Map k v))
toFieldValue = Map
  (FieldValue sch (Uninterpret k)) (FieldValue sch (Uninterpret v))
-> FieldValue sch ('TMap (Uninterpret k) (Uninterpret v))
forall typeName fieldName (sch :: Schema typeName fieldName)
       (k :: FieldType typeName) (v :: FieldType typeName).
Ord (FieldValue sch k) =>
Map (FieldValue sch k) (FieldValue sch v)
-> FieldValue sch ('TMap k v)
FMap (Map
   (FieldValue sch (Uninterpret k)) (FieldValue sch (Uninterpret v))
 -> FieldValue sch ('TMap (Uninterpret k) (Uninterpret v)))
-> (Map k v
    -> Map
         (FieldValue sch (Uninterpret k)) (FieldValue sch (Uninterpret v)))
-> Map k v
-> FieldValue sch ('TMap (Uninterpret k) (Uninterpret v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> FieldValue sch (Uninterpret k))
-> Map k (FieldValue sch (Uninterpret v))
-> Map
     (FieldValue sch (Uninterpret k)) (FieldValue sch (Uninterpret v))
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeysMonotonic k -> FieldValue sch (Uninterpret k)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue (Map k (FieldValue sch (Uninterpret v))
 -> Map
      (FieldValue sch (Uninterpret k)) (FieldValue sch (Uninterpret v)))
-> (Map k v -> Map k (FieldValue sch (Uninterpret v)))
-> Map k v
-> Map
     (FieldValue sch (Uninterpret k)) (FieldValue sch (Uninterpret v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> FieldValue sch (Uninterpret v))
-> Map k v -> Map k (FieldValue sch (Uninterpret v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> FieldValue sch (Uninterpret v)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue

instance
  (All (UninterpretField sch) choiceTypes) =>
  UninterpretField sch (NS Identity (choiceTypes :: [Type]))
  where
  type Uninterpret (NS Identity choiceTypes) = 'TUnion (UninterpretList choiceTypes)
  toFieldValue :: NS Identity choiceTypes
-> FieldValue sch (Uninterpret (NS Identity choiceTypes))
toFieldValue = NS (FieldValue sch) (UninterpretList choiceTypes)
-> FieldValue sch ('TUnion (UninterpretList choiceTypes))
forall typeName fieldName (sch :: Schema typeName fieldName)
       (choices :: [FieldType typeName]).
NS (FieldValue sch) choices -> FieldValue sch ('TUnion choices)
FUnion (NS (FieldValue sch) (UninterpretList choiceTypes)
 -> FieldValue sch ('TUnion (UninterpretList choiceTypes)))
-> (NS Identity choiceTypes
    -> NS (FieldValue sch) (UninterpretList choiceTypes))
-> NS Identity choiceTypes
-> FieldValue sch ('TUnion (UninterpretList choiceTypes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS Identity choiceTypes
-> NS (FieldValue sch) (UninterpretList choiceTypes)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (choiceTypes :: [*]).
All (UninterpretField sch) choiceTypes =>
NS Identity choiceTypes
-> NS (FieldValue sch) (UninterpretList choiceTypes)
nsToFieldValues

nsToFieldValues ::
  forall sch choiceTypes.
  (All (UninterpretField sch) choiceTypes) =>
  NS Identity choiceTypes ->
  NS (FieldValue sch) (UninterpretList choiceTypes)
nsToFieldValues :: NS Identity choiceTypes
-> NS (FieldValue sch) (UninterpretList choiceTypes)
nsToFieldValues = \case
  (Z Identity x
val) -> FieldValue sch (Uninterpret x)
-> NS (FieldValue sch) (Uninterpret x : UninterpretList xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (FieldValue sch (Uninterpret x)
 -> NS (FieldValue sch) (Uninterpret x : UninterpretList xs))
-> (Identity x -> FieldValue sch (Uninterpret x))
-> Identity x
-> NS (FieldValue sch) (Uninterpret x : UninterpretList xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> FieldValue sch (Uninterpret x)
forall typeName fieldName (sch :: Schema typeName fieldName) a.
UninterpretField sch a =>
a -> FieldValue sch (Uninterpret a)
toFieldValue (x -> FieldValue sch (Uninterpret x))
-> (Identity x -> x)
-> Identity x
-> FieldValue sch (Uninterpret x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> x
forall a. Identity a -> a
runIdentity (Identity x
 -> NS (FieldValue sch) (Uninterpret x : UninterpretList xs))
-> Identity x
-> NS (FieldValue sch) (Uninterpret x : UninterpretList xs)
forall a b. (a -> b) -> a -> b
$ Identity x
val
  (S NS Identity xs
val) -> NS (FieldValue sch) (UninterpretList xs)
-> NS (FieldValue sch) (Uninterpret x : UninterpretList xs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS Identity xs -> NS (FieldValue sch) (UninterpretList xs)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (choiceTypes :: [*]).
All (UninterpretField sch) choiceTypes =>
NS Identity choiceTypes
-> NS (FieldValue sch) (UninterpretList choiceTypes)
nsToFieldValues NS Identity xs
val)

type family UninterpretList (as :: [Type]) :: [FieldType typeName] where
  UninterpretList '[] = '[]
  UninterpretList (t ': ts) = Uninterpret t ': UninterpretList ts