{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language GADTs                 #-}
{-# language PolyKinds             #-}
{-# language QuantifiedConstraints #-}
{-# language RankNTypes            #-}
{-# language ScopedTypeVariables   #-}
{-# language TypeApplications      #-}
{-# language TypeFamilies          #-}
{-# language TypeOperators         #-}
{-# language UndecidableInstances  #-}
{-|
Description : Interpretation of schemas

This module defines 'Term's which comply with
a given 'Schema'. These 'Term's are the main
form of values used internally by @mu-haskell@.

This module follows the ideas of
<https://reasonablypolymorphic.com/blog/higher-kinded-data/ higher-kinded data>.
In particular, each interpretation of a 'Field'
wraps its contents into a "wrapper" type @w@,
which may add additional behavior to it.
For example, in Protocol Buffers every field is
optional, and this is expressed by setting
@w@ to 'Maybe'.

In this module we make use of 'NP' and 'NS'
as defined by <https://hackage.haskell.org/package/sop-core sop-core>.
These are the n-ary versions of a pair and
'Either', respectively. In other words, 'NP'
puts together a bunch of values of different
types, 'NS' allows you to choose from a bunch
of types.
-}
module Mu.Schema.Interpretation (
  -- * Interpretation
  Term(..), Field(..), FieldValue(..)
, NS(..), NP(..), Proxy(..)
  -- * Transforming the wrapper type
, transWrap, transWrapNoMaps
  -- ** For internal use only
, transFields, transFieldsNoMaps
, transValue, transValueNoMaps
) where

import           Data.Map
import           Data.Proxy
import           Data.SOP

import           Mu.Schema.Definition

-- | Interpretation of a type in a schema.
data Term w (sch :: Schema typeName fieldName) (t :: TypeDef typeName fieldName) where
  -- | A record given by the value of its fields.
  TRecord :: NP (Field w sch) args -> Term w sch ('DRecord name args)
  -- | An enumeration given by one choice.
  TEnum   :: NS Proxy choices      -> Term w sch ('DEnum name choices)
  -- | A primitive value.
  TSimple :: FieldValue w sch t    -> Term w sch ('DSimple t)

-- | Interpretation of a field.
data Field w (sch :: Schema typeName fieldName) (f :: FieldDef typeName fieldName) where
  -- | A single field. Note that the contents are wrapped in a @w@ type constructor.
  Field :: w (FieldValue w sch t) -> Field w sch ('FieldDef name t)

-- | Interpretation of a field type, by giving a value of that type.
data FieldValue w (sch :: Schema typeName fieldName) (t :: FieldType typeName) where
  -- | Null value, as found in Avro and JSON.
  FNull      :: FieldValue w sch 'TNull
  -- | Value of a primitive type.
  FPrimitive :: t -> FieldValue w sch ('TPrimitive t)
  -- | Term of another type in the schema.
  FSchematic :: Term w sch (sch :/: t)
             -> FieldValue w sch ('TSchematic t)
  -- | Optional value.
  FOption    :: Maybe (FieldValue w sch t)
             -> FieldValue w sch ('TOption t)
  -- | List of values.
  FList      :: [FieldValue w sch t]
             -> FieldValue w sch ('TList   t)
  -- | Dictionary (key-value map) of values.
  FMap       :: Ord (FieldValue w sch k)
             => Map (FieldValue w sch k) (FieldValue w sch v)
             -> FieldValue w sch ('TMap k v)
  -- | One single value of one of the specified types.
  FUnion     :: NS (FieldValue w sch) choices
             -> FieldValue w sch ('TUnion choices)

-- | Change the underlying wrapper of a term.
transWrap
  :: forall tn fn (sch :: Schema tn fn) t u v.
     (Functor u, forall k. Ord (FieldValue u sch k) => Ord (FieldValue v sch k))
  => (forall a. u a -> v a)
  -> Term u sch t -> Term v sch t
transWrap :: (forall a. u a -> v a) -> Term u sch t -> Term v sch t
transWrap n :: forall a. u a -> v a
n x :: Term u sch t
x = case Term u sch t
x of
  TRecord f :: NP (Field u sch) args
f -> NP (Field v sch) args -> Term v sch ('DRecord name args)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (choices :: typeName).
NP (Field w sch) args -> Term w sch ('DRecord choices args)
TRecord ((forall a. u a -> v a)
-> NP (Field u sch) args -> NP (Field v sch) args
forall tn fn (sch :: Schema tn fn) (args :: [FieldDef tn fn])
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a)
-> NP (Field u sch) args -> NP (Field v sch) args
transFields forall a. u a -> v a
n NP (Field u sch) args
f)
  TEnum   c :: NS Proxy choices
c -> NS Proxy choices -> Term v sch ('DEnum name choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (w :: * -> *) (sch :: Schema typeName fieldName)
       (name :: typeName).
NS Proxy choices -> Term w sch ('DEnum name choices)
TEnum NS Proxy choices
c
  TSimple v :: FieldValue u sch t
v -> FieldValue v sch t -> Term v sch ('DSimple t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName).
FieldValue w sch t -> Term w sch ('DSimple t)
TSimple ((forall a. u a -> v a) -> FieldValue u sch t -> FieldValue v sch t
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValue forall a. u a -> v a
n FieldValue u sch t
v)

-- | Change the underlying wrapper of a term.
--   This version assumes that no field is a map,
--   which allows for a more general type.
--   If a map is found, an exception is raised.
transWrapNoMaps
  :: forall tn fn (sch :: Schema tn fn) t u v.
     (Functor u)
  => (forall a. u a -> v a)
  -> Term u sch t -> Term v sch t
transWrapNoMaps :: (forall a. u a -> v a) -> Term u sch t -> Term v sch t
transWrapNoMaps n :: forall a. u a -> v a
n x :: Term u sch t
x = case Term u sch t
x of
  TRecord f :: NP (Field u sch) args
f -> NP (Field v sch) args -> Term v sch ('DRecord name args)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (choices :: typeName).
NP (Field w sch) args -> Term w sch ('DRecord choices args)
TRecord ((forall a. u a -> v a)
-> NP (Field u sch) args -> NP (Field v sch) args
forall tn fn (sch :: Schema tn fn) (args :: [FieldDef tn fn])
       (u :: * -> *) (v :: * -> *).
Functor u =>
(forall a. u a -> v a)
-> NP (Field u sch) args -> NP (Field v sch) args
transFieldsNoMaps forall a. u a -> v a
n NP (Field u sch) args
f)
  TEnum   c :: NS Proxy choices
c -> NS Proxy choices -> Term v sch ('DEnum name choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (w :: * -> *) (sch :: Schema typeName fieldName)
       (name :: typeName).
NS Proxy choices -> Term w sch ('DEnum name choices)
TEnum NS Proxy choices
c
  TSimple v :: FieldValue u sch t
v -> FieldValue v sch t -> Term v sch ('DSimple t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName).
FieldValue w sch t -> Term w sch ('DSimple t)
TSimple ((forall a. u a -> v a) -> FieldValue u sch t -> FieldValue v sch t
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
Functor u =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValueNoMaps forall a. u a -> v a
n FieldValue u sch t
v)

-- | Change the underlying wrapper of a list of fields.
transFields
  :: forall tn fn (sch :: Schema tn fn) args u v.
     (Functor u, forall k. Ord (FieldValue u sch k) => Ord (FieldValue v sch k))
  => (forall a. u a -> v a)
  -> NP (Field u sch) args -> NP (Field v sch) args
transFields :: (forall a. u a -> v a)
-> NP (Field u sch) args -> NP (Field v sch) args
transFields _ Nil = NP (Field v sch) args
forall k (a :: k -> *). NP a '[]
Nil
transFields n :: forall a. u a -> v a
n (Field v :: u (FieldValue u sch t)
v :* rest :: NP (Field u sch) xs
rest)
  = v (FieldValue v sch t) -> Field v sch ('FieldDef name t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName)
       (name :: fieldName).
w (FieldValue w sch t) -> Field w sch ('FieldDef name t)
Field (u (FieldValue v sch t) -> v (FieldValue v sch t)
forall a. u a -> v a
n ((FieldValue u sch t -> FieldValue v sch t)
-> u (FieldValue u sch t) -> u (FieldValue v sch t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. u a -> v a) -> FieldValue u sch t -> FieldValue v sch t
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValue forall a. u a -> v a
n) u (FieldValue u sch t)
v)) Field v sch ('FieldDef name t)
-> NP (Field v sch) xs -> NP (Field v sch) ('FieldDef name t : xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* (forall a. u a -> v a)
-> NP (Field u sch) xs -> NP (Field v sch) xs
forall tn fn (sch :: Schema tn fn) (args :: [FieldDef tn fn])
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a)
-> NP (Field u sch) args -> NP (Field v sch) args
transFields forall a. u a -> v a
n NP (Field u sch) xs
rest

-- | Change the underlying wrapper of a list of fields.
--   This version assumes no maps are present as fields.
transFieldsNoMaps
  :: forall tn fn (sch :: Schema tn fn) args u v.
     (Functor u)
  => (forall a. u a -> v a)
  -> NP (Field u sch) args -> NP (Field v sch) args
transFieldsNoMaps :: (forall a. u a -> v a)
-> NP (Field u sch) args -> NP (Field v sch) args
transFieldsNoMaps _ Nil = NP (Field v sch) args
forall k (a :: k -> *). NP a '[]
Nil
transFieldsNoMaps n :: forall a. u a -> v a
n (Field v :: u (FieldValue u sch t)
v :* rest :: NP (Field u sch) xs
rest)
  = v (FieldValue v sch t) -> Field v sch ('FieldDef name t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName)
       (name :: fieldName).
w (FieldValue w sch t) -> Field w sch ('FieldDef name t)
Field (u (FieldValue v sch t) -> v (FieldValue v sch t)
forall a. u a -> v a
n ((FieldValue u sch t -> FieldValue v sch t)
-> u (FieldValue u sch t) -> u (FieldValue v sch t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. u a -> v a) -> FieldValue u sch t -> FieldValue v sch t
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
Functor u =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValueNoMaps forall a. u a -> v a
n) u (FieldValue u sch t)
v)) Field v sch ('FieldDef name t)
-> NP (Field v sch) xs -> NP (Field v sch) ('FieldDef name t : xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* (forall a. u a -> v a)
-> NP (Field u sch) xs -> NP (Field v sch) xs
forall tn fn (sch :: Schema tn fn) (args :: [FieldDef tn fn])
       (u :: * -> *) (v :: * -> *).
Functor u =>
(forall a. u a -> v a)
-> NP (Field u sch) args -> NP (Field v sch) args
transFieldsNoMaps forall a. u a -> v a
n NP (Field u sch) xs
rest

-- | Change the underlying wrapper of a value.
transValue
  :: forall tn fn (sch :: Schema tn fn) l u v.
     (Functor u, forall k. Ord (FieldValue u sch k) => Ord (FieldValue v sch k))
  => (forall a. u a -> v a)
  -> FieldValue u sch l -> FieldValue v sch l
transValue :: (forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValue _ FNull          = FieldValue v sch l
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName).
FieldValue w sch 'TNull
FNull
transValue _ (FPrimitive y :: t
y) = t -> FieldValue v sch ('TPrimitive t)
forall typeName fieldName t (w :: * -> *)
       (sch :: Schema typeName fieldName).
t -> FieldValue w sch ('TPrimitive t)
FPrimitive t
y
transValue n :: forall a. u a -> v a
n (FSchematic t :: Term u sch (sch :/: t)
t) = Term v sch (sch :/: t) -> FieldValue v sch ('TSchematic t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: typeName).
Term w sch (sch :/: t) -> FieldValue w sch ('TSchematic t)
FSchematic ((forall a. u a -> v a)
-> Term u sch (sch :/: t) -> Term v sch (sch :/: t)
forall tn fn (sch :: Schema tn fn) (t :: TypeDef tn fn)
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a) -> Term u sch t -> Term v sch t
transWrap forall a. u a -> v a
n Term u sch (sch :/: t)
t)
transValue n :: forall a. u a -> v a
n (FOption    o :: Maybe (FieldValue u sch t)
o) = Maybe (FieldValue v sch t) -> FieldValue v sch ('TOption t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName).
Maybe (FieldValue w sch t) -> FieldValue w sch ('TOption t)
FOption ((forall a. u a -> v a) -> FieldValue u sch t -> FieldValue v sch t
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValue forall a. u a -> v a
n (FieldValue u sch t -> FieldValue v sch t)
-> Maybe (FieldValue u sch t) -> Maybe (FieldValue v sch t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FieldValue u sch t)
o)
transValue n :: forall a. u a -> v a
n (FList      l :: [FieldValue u sch t]
l) = [FieldValue v sch t] -> FieldValue v sch ('TList t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName).
[FieldValue w sch t] -> FieldValue w sch ('TList t)
FList ((forall a. u a -> v a) -> FieldValue u sch t -> FieldValue v sch t
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValue forall a. u a -> v a
n (FieldValue u sch t -> FieldValue v sch t)
-> [FieldValue u sch t] -> [FieldValue v sch t]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldValue u sch t]
l)
transValue n :: forall a. u a -> v a
n (FMap       m :: Map (FieldValue u sch k) (FieldValue u sch v)
m) = Map (FieldValue v sch k) (FieldValue v sch v)
-> FieldValue v sch ('TMap k v)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (k :: FieldType typeName)
       (v :: FieldType typeName).
Ord (FieldValue w sch k) =>
Map (FieldValue w sch k) (FieldValue w sch v)
-> FieldValue w sch ('TMap k v)
FMap ((FieldValue u sch k -> FieldValue v sch k)
-> Map (FieldValue u sch k) (FieldValue v sch v)
-> Map (FieldValue v sch k) (FieldValue v sch v)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeys ((forall a. u a -> v a) -> FieldValue u sch k -> FieldValue v sch k
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValue forall a. u a -> v a
n) ((forall a. u a -> v a) -> FieldValue u sch v -> FieldValue v sch v
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValue forall a. u a -> v a
n (FieldValue u sch v -> FieldValue v sch v)
-> Map (FieldValue u sch k) (FieldValue u sch v)
-> Map (FieldValue u sch k) (FieldValue v sch v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (FieldValue u sch k) (FieldValue u sch v)
m))
transValue n :: forall a. u a -> v a
n (FUnion     u :: NS (FieldValue u sch) choices
u) = NS (FieldValue v sch) choices -> FieldValue v sch ('TUnion choices)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName)
       (choices :: [FieldType typeName]).
NS (FieldValue w sch) choices -> FieldValue w sch ('TUnion choices)
FUnion (NS (FieldValue u sch) choices -> NS (FieldValue v sch) choices
forall (us :: [FieldType tn]).
NS (FieldValue u sch) us -> NS (FieldValue v sch) us
transUnion NS (FieldValue u sch) choices
u)
  where
    transUnion :: NS (FieldValue u sch) us -> NS (FieldValue v sch) us
    transUnion :: NS (FieldValue u sch) us -> NS (FieldValue v sch) us
transUnion (Z z :: FieldValue u sch x
z) = FieldValue v sch x -> NS (FieldValue v sch) (x : xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z ((forall a. u a -> v a) -> FieldValue u sch x -> FieldValue v sch x
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
(Functor u,
 forall (k :: FieldType tn).
 Ord (FieldValue u sch k) =>
 Ord (FieldValue v sch k)) =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValue forall a. u a -> v a
n FieldValue u sch x
z)
    transUnion (S s :: NS (FieldValue u sch) xs
s) = NS (FieldValue v sch) xs -> NS (FieldValue v sch) (x : xs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS (FieldValue u sch) xs -> NS (FieldValue v sch) xs
forall (us :: [FieldType tn]).
NS (FieldValue u sch) us -> NS (FieldValue v sch) us
transUnion NS (FieldValue u sch) xs
s)

-- | Change the underlying wrapper of a value.
--   This version assumes that the value is not a map.
transValueNoMaps
  :: forall tn fn (sch :: Schema tn fn) l u v.
     (Functor u)
  => (forall a. u a -> v a)
  -> FieldValue u sch l -> FieldValue v sch l
transValueNoMaps :: (forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValueNoMaps _ FNull          = FieldValue v sch l
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName).
FieldValue w sch 'TNull
FNull
transValueNoMaps _ (FPrimitive y :: t
y) = t -> FieldValue v sch ('TPrimitive t)
forall typeName fieldName t (w :: * -> *)
       (sch :: Schema typeName fieldName).
t -> FieldValue w sch ('TPrimitive t)
FPrimitive t
y
transValueNoMaps n :: forall a. u a -> v a
n (FSchematic t :: Term u sch (sch :/: t)
t) = Term v sch (sch :/: t) -> FieldValue v sch ('TSchematic t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: typeName).
Term w sch (sch :/: t) -> FieldValue w sch ('TSchematic t)
FSchematic ((forall a. u a -> v a)
-> Term u sch (sch :/: t) -> Term v sch (sch :/: t)
forall tn fn (sch :: Schema tn fn) (t :: TypeDef tn fn)
       (u :: * -> *) (v :: * -> *).
Functor u =>
(forall a. u a -> v a) -> Term u sch t -> Term v sch t
transWrapNoMaps forall a. u a -> v a
n Term u sch (sch :/: t)
t)
transValueNoMaps n :: forall a. u a -> v a
n (FOption    o :: Maybe (FieldValue u sch t)
o) = Maybe (FieldValue v sch t) -> FieldValue v sch ('TOption t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName).
Maybe (FieldValue w sch t) -> FieldValue w sch ('TOption t)
FOption ((forall a. u a -> v a) -> FieldValue u sch t -> FieldValue v sch t
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
Functor u =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValueNoMaps forall a. u a -> v a
n (FieldValue u sch t -> FieldValue v sch t)
-> Maybe (FieldValue u sch t) -> Maybe (FieldValue v sch t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FieldValue u sch t)
o)
transValueNoMaps n :: forall a. u a -> v a
n (FList      l :: [FieldValue u sch t]
l) = [FieldValue v sch t] -> FieldValue v sch ('TList t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName).
[FieldValue w sch t] -> FieldValue w sch ('TList t)
FList ((forall a. u a -> v a) -> FieldValue u sch t -> FieldValue v sch t
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
Functor u =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValueNoMaps forall a. u a -> v a
n (FieldValue u sch t -> FieldValue v sch t)
-> [FieldValue u sch t] -> [FieldValue v sch t]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldValue u sch t]
l)
transValueNoMaps _ (FMap       _) = [Char] -> FieldValue v sch l
forall a. HasCallStack => [Char] -> a
error "this should never happen"
transValueNoMaps n :: forall a. u a -> v a
n (FUnion     u :: NS (FieldValue u sch) choices
u) = NS (FieldValue v sch) choices -> FieldValue v sch ('TUnion choices)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName)
       (choices :: [FieldType typeName]).
NS (FieldValue w sch) choices -> FieldValue w sch ('TUnion choices)
FUnion (NS (FieldValue u sch) choices -> NS (FieldValue v sch) choices
forall (us :: [FieldType tn]).
NS (FieldValue u sch) us -> NS (FieldValue v sch) us
transUnion NS (FieldValue u sch) choices
u)
  where
    transUnion :: NS (FieldValue u sch) us -> NS (FieldValue v sch) us
    transUnion :: NS (FieldValue u sch) us -> NS (FieldValue v sch) us
transUnion (Z z :: FieldValue u sch x
z) = FieldValue v sch x -> NS (FieldValue v sch) (x : xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z ((forall a. u a -> v a) -> FieldValue u sch x -> FieldValue v sch x
forall tn fn (sch :: Schema tn fn) (l :: FieldType tn)
       (u :: * -> *) (v :: * -> *).
Functor u =>
(forall a. u a -> v a) -> FieldValue u sch l -> FieldValue v sch l
transValueNoMaps forall a. u a -> v a
n FieldValue u sch x
z)
    transUnion (S s :: NS (FieldValue u sch) xs
s) = NS (FieldValue v sch) xs -> NS (FieldValue v sch) (x : xs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS (FieldValue u sch) xs -> NS (FieldValue v sch) xs
forall (us :: [FieldType tn]).
NS (FieldValue u sch) us -> NS (FieldValue v sch) us
transUnion NS (FieldValue u sch) xs
s)

-- ===========================
-- CRAZY EQ AND SHOW INSTANCES
-- ===========================

instance All (Eq `Compose` Field w sch) args
         => Eq (Term w sch ('DRecord name args)) where
  TRecord xs :: NP (Field w sch) args
xs == :: Term w sch ('DRecord name args)
-> Term w sch ('DRecord name args) -> Bool
== TRecord ys :: NP (Field w sch) args
ys = NP (Field w sch) args
xs NP (Field w sch) args -> NP (Field w sch) args -> Bool
forall a. Eq a => a -> a -> Bool
== NP (Field w sch) args
NP (Field w sch) args
ys
instance (KnownName name, All (Show `Compose` Field w sch) args)
         => Show (Term w sch ('DRecord name args)) where
  show :: Term w sch ('DRecord name args) -> [Char]
show (TRecord xs :: NP (Field w sch) args
xs) = "record " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy name -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " { " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ NP (Field w sch) args -> [Char]
forall (fs :: [FieldDef typeName fieldName]).
All (Compose Show (Field w sch)) fs =>
NP (Field w sch) fs -> [Char]
printFields NP (Field w sch) args
xs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " }"
    where printFields :: forall fs. All (Show `Compose` Field w sch) fs
                      => NP (Field w sch) fs -> String
          printFields :: NP (Field w sch) fs -> [Char]
printFields Nil         = ""
          printFields (x :: Field w sch x
x :* Nil)  = Field w sch x -> [Char]
forall a. Show a => a -> [Char]
show Field w sch x
x
          printFields (x :: Field w sch x
x :* rest :: NP (Field w sch) xs
rest) = Field w sch x -> [Char]
forall a. Show a => a -> [Char]
show Field w sch x
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ", " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ NP (Field w sch) xs -> [Char]
forall (fs :: [FieldDef typeName fieldName]).
All (Compose Show (Field w sch)) fs =>
NP (Field w sch) fs -> [Char]
printFields NP (Field w sch) xs
rest
instance All (Eq `Compose` Proxy) choices => Eq (Term w sch ('DEnum name choices)) where
  TEnum x :: NS Proxy choices
x == :: Term w sch ('DEnum name choices)
-> Term w sch ('DEnum name choices) -> Bool
== TEnum y :: NS Proxy choices
y = NS Proxy choices
x NS Proxy choices -> NS Proxy choices -> Bool
forall a. Eq a => a -> a -> Bool
== NS Proxy choices
NS Proxy choices
y
instance (KnownName name, All KnownName choices, All (Show `Compose` Proxy) choices)
         => Show (Term w sch ('DEnum name choices)) where
  show :: Term w sch ('DEnum name choices) -> [Char]
show (TEnum choice :: NS Proxy choices
choice) = "enum " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy name -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " { " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ NS Proxy choices -> [Char]
forall k (cs :: [k]). All KnownName cs => NS Proxy cs -> [Char]
printChoice NS Proxy choices
choice [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " }"
    where printChoice :: forall cs. All KnownName cs => NS Proxy cs -> String
          printChoice :: NS Proxy cs -> [Char]
printChoice (Z p :: Proxy x
p) = Proxy x -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal Proxy x
p
          printChoice (S n :: NS Proxy xs
n) = NS Proxy xs -> [Char]
forall k (cs :: [k]). All KnownName cs => NS Proxy cs -> [Char]
printChoice NS Proxy xs
n
instance Eq (FieldValue w sch t) => Eq (Term w sch ('DSimple t)) where
  TSimple x :: FieldValue w sch t
x == :: Term w sch ('DSimple t) -> Term w sch ('DSimple t) -> Bool
== TSimple y :: FieldValue w sch t
y = FieldValue w sch t
x FieldValue w sch t -> FieldValue w sch t -> Bool
forall a. Eq a => a -> a -> Bool
== FieldValue w sch t
FieldValue w sch t
y
instance Show (FieldValue w sch t) => Show (Term w sch ('DSimple t)) where
  show :: Term w sch ('DSimple t) -> [Char]
show (TSimple x :: FieldValue w sch t
x) = FieldValue w sch t -> [Char]
forall a. Show a => a -> [Char]
show FieldValue w sch t
x

instance (Eq (w (FieldValue w sch t))) => Eq (Field w sch ('FieldDef name t)) where
  Field x :: w (FieldValue w sch t)
x == :: Field w sch ('FieldDef name t)
-> Field w sch ('FieldDef name t) -> Bool
== Field y :: w (FieldValue w sch t)
y = w (FieldValue w sch t)
x w (FieldValue w sch t) -> w (FieldValue w sch t) -> Bool
forall a. Eq a => a -> a -> Bool
== w (FieldValue w sch t)
w (FieldValue w sch t)
y
instance (KnownName name, Show (w (FieldValue w sch t)))
         => Show (Field w sch ('FieldDef name t)) where
  show :: Field w sch ('FieldDef name t) -> [Char]
show (Field x :: w (FieldValue w sch t)
x) = Proxy name -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ w (FieldValue w sch t) -> [Char]
forall a. Show a => a -> [Char]
show w (FieldValue w sch t)
x

instance Eq (FieldValue w sch 'TNull) where
  _ == :: FieldValue w sch 'TNull -> FieldValue w sch 'TNull -> Bool
== _ = Bool
True
instance Eq t => Eq (FieldValue w sch ('TPrimitive t)) where
  FPrimitive x :: t
x == :: FieldValue w sch ('TPrimitive t)
-> FieldValue w sch ('TPrimitive t) -> Bool
== FPrimitive y :: t
y = t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
t
y
instance Eq (Term w sch (sch :/: t)) => Eq (FieldValue w sch ('TSchematic t)) where
  FSchematic x :: Term w sch (sch :/: t)
x == :: FieldValue w sch ('TSchematic t)
-> FieldValue w sch ('TSchematic t) -> Bool
== FSchematic y :: Term w sch (sch :/: t)
y = Term w sch (sch :/: t)
Term w sch (sch :/: t)
x Term w sch (sch :/: t) -> Term w sch (sch :/: t) -> Bool
forall a. Eq a => a -> a -> Bool
== Term w sch (sch :/: t)
Term w sch (sch :/: t)
y
instance Eq (FieldValue w sch t) => Eq (FieldValue w sch ('TOption t)) where
  FOption x :: Maybe (FieldValue w sch t)
x == :: FieldValue w sch ('TOption t)
-> FieldValue w sch ('TOption t) -> Bool
== FOption y :: Maybe (FieldValue w sch t)
y = Maybe (FieldValue w sch t)
x Maybe (FieldValue w sch t) -> Maybe (FieldValue w sch t) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (FieldValue w sch t)
Maybe (FieldValue w sch t)
y
instance Eq (FieldValue w sch t) => Eq (FieldValue w sch ('TList t)) where
  FList x :: [FieldValue w sch t]
x == :: FieldValue w sch ('TList t) -> FieldValue w sch ('TList t) -> Bool
== FList y :: [FieldValue w sch t]
y = [FieldValue w sch t]
x [FieldValue w sch t] -> [FieldValue w sch t] -> Bool
forall a. Eq a => a -> a -> Bool
== [FieldValue w sch t]
[FieldValue w sch t]
y
instance (Eq (FieldValue w sch k), Eq (FieldValue w sch v))
         => Eq (FieldValue w sch ('TMap k v)) where
  FMap x :: Map (FieldValue w sch k) (FieldValue w sch v)
x == :: FieldValue w sch ('TMap k v)
-> FieldValue w sch ('TMap k v) -> Bool
== FMap y :: Map (FieldValue w sch k) (FieldValue w sch v)
y = Map (FieldValue w sch k) (FieldValue w sch v)
x Map (FieldValue w sch k) (FieldValue w sch v)
-> Map (FieldValue w sch k) (FieldValue w sch v) -> Bool
forall a. Eq a => a -> a -> Bool
== Map (FieldValue w sch k) (FieldValue w sch v)
Map (FieldValue w sch k) (FieldValue w sch v)
y
instance All (Eq `Compose` FieldValue w sch) choices
         => Eq (FieldValue w sch ('TUnion choices)) where
  FUnion x :: NS (FieldValue w sch) choices
x == :: FieldValue w sch ('TUnion choices)
-> FieldValue w sch ('TUnion choices) -> Bool
== FUnion y :: NS (FieldValue w sch) choices
y = NS (FieldValue w sch) choices
x NS (FieldValue w sch) choices
-> NS (FieldValue w sch) choices -> Bool
forall a. Eq a => a -> a -> Bool
== NS (FieldValue w sch) choices
NS (FieldValue w sch) choices
y

instance Ord (FieldValue w sch 'TNull) where
  compare :: FieldValue w sch 'TNull -> FieldValue w sch 'TNull -> Ordering
compare _ _ = Ordering
EQ
instance Ord t => Ord (FieldValue w sch ('TPrimitive t)) where
  compare :: FieldValue w sch ('TPrimitive t)
-> FieldValue w sch ('TPrimitive t) -> Ordering
compare (FPrimitive x :: t
x) (FPrimitive y :: t
y) = t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
x t
t
y
instance Ord (Term w sch (sch :/: t)) => Ord (FieldValue w sch ('TSchematic t)) where
  compare :: FieldValue w sch ('TSchematic t)
-> FieldValue w sch ('TSchematic t) -> Ordering
compare (FSchematic x :: Term w sch (sch :/: t)
x) (FSchematic y :: Term w sch (sch :/: t)
y) = Term w sch (sch :/: t) -> Term w sch (sch :/: t) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Term w sch (sch :/: t)
Term w sch (sch :/: t)
x Term w sch (sch :/: t)
Term w sch (sch :/: t)
y
instance Ord (FieldValue w sch t) => Ord (FieldValue w sch ('TOption t)) where
  compare :: FieldValue w sch ('TOption t)
-> FieldValue w sch ('TOption t) -> Ordering
compare (FOption x :: Maybe (FieldValue w sch t)
x) (FOption y :: Maybe (FieldValue w sch t)
y) = Maybe (FieldValue w sch t)
-> Maybe (FieldValue w sch t) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe (FieldValue w sch t)
x Maybe (FieldValue w sch t)
Maybe (FieldValue w sch t)
y
instance Ord (FieldValue w sch t) => Ord (FieldValue w sch ('TList t)) where
  compare :: FieldValue w sch ('TList t)
-> FieldValue w sch ('TList t) -> Ordering
compare (FList x :: [FieldValue w sch t]
x) (FList y :: [FieldValue w sch t]
y) = [FieldValue w sch t] -> [FieldValue w sch t] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [FieldValue w sch t]
x [FieldValue w sch t]
[FieldValue w sch t]
y
instance (Ord (FieldValue w sch k), Ord (FieldValue w sch v))
         => Ord (FieldValue w sch ('TMap k v)) where
  compare :: FieldValue w sch ('TMap k v)
-> FieldValue w sch ('TMap k v) -> Ordering
compare (FMap x :: Map (FieldValue w sch k) (FieldValue w sch v)
x) (FMap y :: Map (FieldValue w sch k) (FieldValue w sch v)
y) = Map (FieldValue w sch k) (FieldValue w sch v)
-> Map (FieldValue w sch k) (FieldValue w sch v) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Map (FieldValue w sch k) (FieldValue w sch v)
x Map (FieldValue w sch k) (FieldValue w sch v)
Map (FieldValue w sch k) (FieldValue w sch v)
y
instance ( All (Ord `Compose` FieldValue w sch) choices
         , All (Eq  `Compose` FieldValue w sch) choices )
         => Ord (FieldValue w sch ('TUnion choices)) where
  compare :: FieldValue w sch ('TUnion choices)
-> FieldValue w sch ('TUnion choices) -> Ordering
compare (FUnion x :: NS (FieldValue w sch) choices
x) (FUnion y :: NS (FieldValue w sch) choices
y) = NS (FieldValue w sch) choices
-> NS (FieldValue w sch) choices -> Ordering
forall a. Ord a => a -> a -> Ordering
compare NS (FieldValue w sch) choices
x NS (FieldValue w sch) choices
NS (FieldValue w sch) choices
y

instance Show (FieldValue w sch 'TNull) where
  show :: FieldValue w sch 'TNull -> [Char]
show _ = "null"
instance Show t => Show (FieldValue w sch ('TPrimitive t)) where
  show :: FieldValue w sch ('TPrimitive t) -> [Char]
show (FPrimitive x :: t
x) = t -> [Char]
forall a. Show a => a -> [Char]
show t
x
instance Show (Term w sch (sch :/: t)) => Show (FieldValue w sch ('TSchematic t)) where
  show :: FieldValue w sch ('TSchematic t) -> [Char]
show (FSchematic x :: Term w sch (sch :/: t)
x) = Term w sch (sch :/: t) -> [Char]
forall a. Show a => a -> [Char]
show Term w sch (sch :/: t)
Term w sch (sch :/: t)
x
instance Show (FieldValue w sch t) => Show (FieldValue w sch ('TOption t)) where
  show :: FieldValue w sch ('TOption t) -> [Char]
show (FOption Nothing)  = "none"
  show (FOption (Just x :: FieldValue w sch t
x)) = "some(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldValue w sch t -> [Char]
forall a. Show a => a -> [Char]
show FieldValue w sch t
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Show (FieldValue w sch t) => Show (FieldValue w sch ('TList t)) where
  show :: FieldValue w sch ('TList t) -> [Char]
show (FList xs :: [FieldValue w sch t]
xs) = [FieldValue w sch t] -> [Char]
forall a. Show a => a -> [Char]
show [FieldValue w sch t]
xs
instance (Show (FieldValue w sch k), Show (FieldValue w sch v))
         => Show (FieldValue w sch ('TMap k v)) where
  show :: FieldValue w sch ('TMap k v) -> [Char]
show (FMap x :: Map (FieldValue w sch k) (FieldValue w sch v)
x) = Map (FieldValue w sch k) (FieldValue w sch v) -> [Char]
forall a. Show a => a -> [Char]
show Map (FieldValue w sch k) (FieldValue w sch v)
x
instance All (Show `Compose` FieldValue w sch) choices
         => Show (FieldValue w sch ('TUnion choices)) where
  show :: FieldValue w sch ('TUnion choices) -> [Char]
show (FUnion x :: NS (FieldValue w sch) choices
x) = NS (FieldValue w sch) choices -> [Char]
forall a. Show a => a -> [Char]
show NS (FieldValue w sch) choices
x