{-# 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
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