{-# language AllowAmbiguousTypes   #-}
{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language GADTs                 #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds             #-}
{-# language ScopedTypeVariables   #-}
{-# language StandaloneDeriving    #-}
{-# language TypeApplications      #-}
{-# language TypeOperators         #-}
{-# language UndecidableInstances  #-}
{-|
Description : Terms without an associated schema

In the edges of your application it's useful to
consider terms for which a type-level schema has
not yet been applied. Think of receiving a JSON
document: you can parse it but checking the schema
is an additional step.
-}
module Mu.Schema.Interpretation.Schemaless (
  -- * Terms without an associated schema
  Term(..), Field(..), FieldValue(..)
  -- * Checking and conversion against a schema
, checkSchema, fromSchemalessTerm
  -- * For deserialization to schemaless terms
, ToSchemalessTerm(..), ToSchemalessValue(..)
  -- * For implementors
, CheckSchema
) where

import           Control.Applicative      ((<|>))
import           Data.List                (find)
import qualified Data.Map                 as M
import           Data.Proxy
import           Data.SOP
import qualified Data.Text                as T
import           Data.Typeable

import           Mu.Schema.Class
import           Mu.Schema.Definition
import qualified Mu.Schema.Interpretation as S

-- | Interpretation of a type in a schema.
data Term where
  -- | A record given by the value of its fields.
  TRecord :: [Field]    -> Term
  -- | An enumeration given by one choice.
  TEnum   :: Int        -> Term
  -- | A primitive value.
  TSimple :: FieldValue -> Term

deriving instance Eq   Term
deriving instance Ord  Term
deriving instance Show Term

-- | Interpretation of a field.
data Field where
  -- | A single field given by its name and its value.
  Field :: T.Text -> FieldValue -> Field

deriving instance Eq   Field
deriving instance Ord  Field
deriving instance Show Field

-- | Interpretation of a field type, by giving a value of that type.
data FieldValue where
  FNull      :: FieldValue
  FPrimitive :: (Typeable t, Eq t, Ord t, Show t) => t -> FieldValue
  FSchematic :: Term -> FieldValue
  FOption    :: Maybe FieldValue -> FieldValue
  FList      :: [FieldValue] -> FieldValue
  FMap       :: M.Map FieldValue FieldValue -> FieldValue

-- | Checks that a schemaless 'Term' obbeys the
--   restrictions for tyoe @t@ of schema @s@.
--   If successful, returns a 'S.Term' indexed
--   by the corresponding schema and type.
--
--   Use this function to check a schemaless terms
--   at the "borders" of your application.
checkSchema
  :: forall tn fn (s :: Schema tn fn) (t :: tn).
     (CheckSchema s (s :/: t))
  => Proxy t -> Term -> Maybe (S.Term s (s :/: t))
checkSchema :: Proxy t -> Term -> Maybe (Term s (s :/: t))
checkSchema Proxy t
_ = Term -> Maybe (Term s (s :/: t))
forall tn fn (s :: Schema tn fn) (t :: TypeDef tn fn).
CheckSchema s t =>
Term -> Maybe (Term s t)
checkSchema'

-- | Converts a schemaless term to a Haskell type
--   by going through the corresponding schema type.
fromSchemalessTerm
  :: forall sch t sty.
     (FromSchema sch sty t, CheckSchema sch (sch :/: sty))
  => Term -> Maybe t
fromSchemalessTerm :: Term -> Maybe t
fromSchemalessTerm Term
t = forall (sty :: t) t.
FromSchema sch sty t =>
Term sch (sch :/: sty) -> t
forall typeName fieldName (sch :: Schema typeName fieldName)
       (sty :: typeName) t.
FromSchema sch sty t =>
Term sch (sch :/: sty) -> t
fromSchema @_ @_ @sch (Term sch (sch :/: sty) -> t)
-> Maybe (Term sch (sch :/: sty)) -> Maybe t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy sty -> Term -> Maybe (Term sch (sch :/: sty))
forall tn fn (s :: Schema tn fn) (t :: tn).
CheckSchema s (s :/: t) =>
Proxy t -> Term -> Maybe (Term s (s :/: t))
checkSchema (Proxy sty
forall k (t :: k). Proxy t
Proxy @sty) Term
t

-- | Deserialization to schemaless terms.
class ToSchemalessTerm t where
  -- | Turns a document (such as JSON) into a schemaless term.
  --   This function should handle the "compound" types in that format,
  --   such as records and enumerations.
  toSchemalessTerm  :: t -> Term
-- | Deserialization to schemaless values.
class ToSchemalessValue t where
  -- | Turns a document (such as JSON) into a schemaless term.
  --   This function should handle the "primitive" types in that format.
  toSchemalessValue :: t -> FieldValue

-- | Type class used to define the generic 'checkSchema'.
--
--   Exposed for usage in other modules,
--   in particular 'Mu.Schema.Registry'.
class CheckSchema (s :: Schema tn fn) (t :: TypeDef tn fn) where
  checkSchema' :: Term -> Maybe (S.Term s t)
class CheckSchemaFields (s :: Schema tn fn) (fields :: [FieldDef tn fn]) where
  checkSchemaFields :: [Field] -> Maybe (NP (S.Field s) fields)
class CheckSchemaEnum (choices :: [ChoiceDef fn]) where
  checkSchemaEnumInt  :: Int -> Maybe (NS Proxy choices)
  checkSchemaEnumText :: T.Text -> Maybe (NS Proxy choices)
class CheckSchemaValue (s :: Schema tn fn) (field :: FieldType tn) where
  checkSchemaValue :: FieldValue -> Maybe (S.FieldValue s field)
class CheckSchemaUnion (s :: Schema tn fn) (ts :: [FieldType tn]) where
  checkSchemaUnion :: FieldValue -> Maybe (NS (S.FieldValue s) ts)

instance CheckSchemaFields s fields => CheckSchema s ('DRecord nm fields) where
  checkSchema' :: Term -> Maybe (Term s ('DRecord nm fields))
checkSchema' (TRecord [Field]
fields) = NP (Field s) fields -> Term s ('DRecord nm fields)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (choices :: typeName).
NP (Field sch) args -> Term sch ('DRecord choices args)
S.TRecord (NP (Field s) fields -> Term s ('DRecord nm fields))
-> Maybe (NP (Field s) fields)
-> Maybe (Term s ('DRecord nm fields))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field] -> Maybe (NP (Field s) fields)
forall tn fn (s :: Schema tn fn) (fields :: [FieldDef tn fn]).
CheckSchemaFields s fields =>
[Field] -> Maybe (NP (Field s) fields)
checkSchemaFields [Field]
fields
  checkSchema' Term
_                = Maybe (Term s ('DRecord nm fields))
forall a. Maybe a
Nothing
instance CheckSchemaFields s '[] where
  checkSchemaFields :: [Field] -> Maybe (NP (Field s) '[])
checkSchemaFields [Field]
_ = NP (Field s) '[] -> Maybe (NP (Field s) '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure NP (Field s) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance (KnownName nm, CheckSchemaValue s ty, CheckSchemaFields s rest)
         => CheckSchemaFields s ('FieldDef nm ty ': rest) where
  checkSchemaFields :: [Field] -> Maybe (NP (Field s) ('FieldDef nm ty : rest))
checkSchemaFields [Field]
fs
    = do let name :: Text
name = String -> Text
T.pack (Proxy nm -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy nm
forall k (t :: k). Proxy t
Proxy @nm))
         Field Text
_ FieldValue
v <- (Field -> Bool) -> [Field] -> Maybe Field
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Field Text
fieldName FieldValue
_) -> Text
fieldName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) [Field]
fs
         FieldValue s ty
v' <- FieldValue -> Maybe (FieldValue s ty)
forall tn fn (s :: Schema tn fn) (field :: FieldType tn).
CheckSchemaValue s field =>
FieldValue -> Maybe (FieldValue s field)
checkSchemaValue FieldValue
v
         NP (Field s) rest
r' <- [Field] -> Maybe (NP (Field s) rest)
forall tn fn (s :: Schema tn fn) (fields :: [FieldDef tn fn]).
CheckSchemaFields s fields =>
[Field] -> Maybe (NP (Field s) fields)
checkSchemaFields @_ @_ @s @rest [Field]
fs
         NP (Field s) ('FieldDef nm ty : rest)
-> Maybe (NP (Field s) ('FieldDef nm ty : rest))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue s ty -> Field s ('FieldDef nm ty)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
S.Field FieldValue s ty
v' Field s ('FieldDef nm ty)
-> NP (Field s) rest -> NP (Field s) ('FieldDef nm ty : rest)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (Field s) rest
r')

instance CheckSchemaEnum choices => CheckSchema s ('DEnum nm choices) where
  checkSchema' :: Term -> Maybe (Term s ('DEnum nm choices))
checkSchema' (TEnum Int
n) = NS Proxy choices -> Term s ('DEnum nm choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
S.TEnum (NS Proxy choices -> Term s ('DEnum nm choices))
-> Maybe (NS Proxy choices) -> Maybe (Term s ('DEnum nm choices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe (NS Proxy choices)
forall fn (choices :: [ChoiceDef fn]).
CheckSchemaEnum choices =>
Int -> Maybe (NS Proxy choices)
checkSchemaEnumInt Int
n
  checkSchema' (TSimple (FPrimitive (t
n :: a)))
    = case ((Typeable t, Typeable Int) => Maybe (t :~: Int)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @Int, (Typeable t, Typeable Text) => Maybe (t :~: Text)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @T.Text, (Typeable t, Typeable String) => Maybe (t :~: String)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @String) of
        (Just t :~: Int
Refl, Maybe (t :~: Text)
_, Maybe (t :~: String)
_) -> NS Proxy choices -> Term s ('DEnum nm choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
S.TEnum (NS Proxy choices -> Term s ('DEnum nm choices))
-> Maybe (NS Proxy choices) -> Maybe (Term s ('DEnum nm choices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe (NS Proxy choices)
forall fn (choices :: [ChoiceDef fn]).
CheckSchemaEnum choices =>
Int -> Maybe (NS Proxy choices)
checkSchemaEnumInt t
Int
n
        (Maybe (t :~: Int)
_, Just t :~: Text
Refl, Maybe (t :~: String)
_) -> NS Proxy choices -> Term s ('DEnum nm choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
S.TEnum (NS Proxy choices -> Term s ('DEnum nm choices))
-> Maybe (NS Proxy choices) -> Maybe (Term s ('DEnum nm choices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (NS Proxy choices)
forall fn (choices :: [ChoiceDef fn]).
CheckSchemaEnum choices =>
Text -> Maybe (NS Proxy choices)
checkSchemaEnumText t
Text
n
        (Maybe (t :~: Int)
_, Maybe (t :~: Text)
_, Just t :~: String
Refl) -> NS Proxy choices -> Term s ('DEnum nm choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
S.TEnum (NS Proxy choices -> Term s ('DEnum nm choices))
-> Maybe (NS Proxy choices) -> Maybe (Term s ('DEnum nm choices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (NS Proxy choices)
forall fn (choices :: [ChoiceDef fn]).
CheckSchemaEnum choices =>
Text -> Maybe (NS Proxy choices)
checkSchemaEnumText (String -> Text
T.pack t
String
n)
        (Maybe (t :~: Int), Maybe (t :~: Text), Maybe (t :~: String))
_                 -> Maybe (Term s ('DEnum nm choices))
forall a. Maybe a
Nothing
  checkSchema' Term
_ = Maybe (Term s ('DEnum nm choices))
forall a. Maybe a
Nothing
instance CheckSchemaEnum '[] where
  checkSchemaEnumInt :: Int -> Maybe (NS Proxy '[])
checkSchemaEnumInt  Int
_ = Maybe (NS Proxy '[])
forall a. Maybe a
Nothing
  checkSchemaEnumText :: Text -> Maybe (NS Proxy '[])
checkSchemaEnumText Text
_ = Maybe (NS Proxy '[])
forall a. Maybe a
Nothing
instance (KnownName c, CheckSchemaEnum cs)
         => CheckSchemaEnum ('ChoiceDef c ': cs) where
  checkSchemaEnumInt :: Int -> Maybe (NS Proxy ('ChoiceDef c : cs))
checkSchemaEnumInt Int
0 = NS Proxy ('ChoiceDef c : cs)
-> Maybe (NS Proxy ('ChoiceDef c : cs))
forall a. a -> Maybe a
Just (Proxy ('ChoiceDef c) -> NS Proxy ('ChoiceDef c : cs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z Proxy ('ChoiceDef c)
forall k (t :: k). Proxy t
Proxy)
  checkSchemaEnumInt Int
n = NS Proxy cs -> NS Proxy ('ChoiceDef c : cs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS Proxy cs -> NS Proxy ('ChoiceDef c : cs))
-> Maybe (NS Proxy cs) -> Maybe (NS Proxy ('ChoiceDef c : cs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe (NS Proxy cs)
forall fn (choices :: [ChoiceDef fn]).
CheckSchemaEnum choices =>
Int -> Maybe (NS Proxy choices)
checkSchemaEnumInt (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  checkSchemaEnumText :: Text -> Maybe (NS Proxy ('ChoiceDef c : cs))
checkSchemaEnumText Text
t
    | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack (Proxy c -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy c
forall k (t :: k). Proxy t
Proxy @c)) = NS Proxy ('ChoiceDef c : cs)
-> Maybe (NS Proxy ('ChoiceDef c : cs))
forall a. a -> Maybe a
Just (Proxy ('ChoiceDef c) -> NS Proxy ('ChoiceDef c : cs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z Proxy ('ChoiceDef c)
forall k (t :: k). Proxy t
Proxy)
    | Bool
otherwise                        = NS Proxy cs -> NS Proxy ('ChoiceDef c : cs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS Proxy cs -> NS Proxy ('ChoiceDef c : cs))
-> Maybe (NS Proxy cs) -> Maybe (NS Proxy ('ChoiceDef c : cs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (NS Proxy cs)
forall fn (choices :: [ChoiceDef fn]).
CheckSchemaEnum choices =>
Text -> Maybe (NS Proxy choices)
checkSchemaEnumText Text
t

instance CheckSchemaValue s f => CheckSchema s ('DSimple f) where
  checkSchema' :: Term -> Maybe (Term s ('DSimple f))
checkSchema' (TSimple FieldValue
t) = FieldValue s f -> Term s ('DSimple f)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName).
FieldValue sch t -> Term sch ('DSimple t)
S.TSimple (FieldValue s f -> Term s ('DSimple f))
-> Maybe (FieldValue s f) -> Maybe (Term s ('DSimple f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldValue -> Maybe (FieldValue s f)
forall tn fn (s :: Schema tn fn) (field :: FieldType tn).
CheckSchemaValue s field =>
FieldValue -> Maybe (FieldValue s field)
checkSchemaValue FieldValue
t
  checkSchema' Term
_           = Maybe (Term s ('DSimple f))
forall a. Maybe a
Nothing
instance CheckSchemaValue s 'TNull where
  checkSchemaValue :: FieldValue -> Maybe (FieldValue s 'TNull)
checkSchemaValue FieldValue
FNull = FieldValue s 'TNull -> Maybe (FieldValue s 'TNull)
forall a. a -> Maybe a
Just FieldValue s 'TNull
forall typeName fieldName (sch :: Schema typeName fieldName).
FieldValue sch 'TNull
S.FNull
  checkSchemaValue FieldValue
_     = Maybe (FieldValue s 'TNull)
forall a. Maybe a
Nothing
instance Typeable t => CheckSchemaValue s ('TPrimitive t) where
  checkSchemaValue :: FieldValue -> Maybe (FieldValue s ('TPrimitive t))
checkSchemaValue (FPrimitive (t
t :: a))
    = case (Typeable t, Typeable t) => Maybe (t :~: t)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @t of
        Just t :~: t
Refl -> FieldValue s ('TPrimitive t)
-> Maybe (FieldValue s ('TPrimitive t))
forall a. a -> Maybe a
Just (t -> FieldValue s ('TPrimitive t)
forall typeName fieldName t (sch :: Schema typeName fieldName).
t -> FieldValue sch ('TPrimitive t)
S.FPrimitive t
t)
        Maybe (t :~: t)
Nothing   -> Maybe (FieldValue s ('TPrimitive t))
forall a. Maybe a
Nothing
  checkSchemaValue FieldValue
_              = Maybe (FieldValue s ('TPrimitive t))
forall a. Maybe a
Nothing
-- TODO: handle enums better by an if with typedef
instance (CheckSchema s (s :/: t))
         => CheckSchemaValue s ('TSchematic t) where
  checkSchemaValue :: FieldValue -> Maybe (FieldValue s ('TSchematic t))
checkSchemaValue (FSchematic Term
t) = Term s (s :/: t) -> FieldValue s ('TSchematic t)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: typeName).
Term sch (sch :/: t) -> FieldValue sch ('TSchematic t)
S.FSchematic (Term s (s :/: t) -> FieldValue s ('TSchematic t))
-> Maybe (Term s (s :/: t)) -> Maybe (FieldValue s ('TSchematic t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe (Term s (s :/: t))
forall tn fn (s :: Schema tn fn) (t :: TypeDef tn fn).
CheckSchema s t =>
Term -> Maybe (Term s t)
checkSchema' Term
t
  checkSchemaValue FieldValue
_              = Maybe (FieldValue s ('TSchematic t))
forall a. Maybe a
Nothing
instance CheckSchemaValue s t => CheckSchemaValue s ('TOption t) where
  checkSchemaValue :: FieldValue -> Maybe (FieldValue s ('TOption t))
checkSchemaValue (FOption Maybe FieldValue
x) = Maybe (FieldValue s t) -> FieldValue s ('TOption t)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName).
Maybe (FieldValue sch t) -> FieldValue sch ('TOption t)
S.FOption (Maybe (FieldValue s t) -> FieldValue s ('TOption t))
-> Maybe (Maybe (FieldValue s t))
-> Maybe (FieldValue s ('TOption t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldValue -> Maybe (FieldValue s t))
-> Maybe FieldValue -> Maybe (Maybe (FieldValue s t))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldValue -> Maybe (FieldValue s t)
forall tn fn (s :: Schema tn fn) (field :: FieldType tn).
CheckSchemaValue s field =>
FieldValue -> Maybe (FieldValue s field)
checkSchemaValue Maybe FieldValue
x
  checkSchemaValue FieldValue
_           = Maybe (FieldValue s ('TOption t))
forall a. Maybe a
Nothing
instance CheckSchemaValue s t => CheckSchemaValue s ('TList t) where
  checkSchemaValue :: FieldValue -> Maybe (FieldValue s ('TList t))
checkSchemaValue (FList [FieldValue]
xs) = [FieldValue s t] -> FieldValue s ('TList t)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName).
[FieldValue sch t] -> FieldValue sch ('TList t)
S.FList ([FieldValue s t] -> FieldValue s ('TList t))
-> Maybe [FieldValue s t] -> Maybe (FieldValue s ('TList t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldValue -> Maybe (FieldValue s t))
-> [FieldValue] -> Maybe [FieldValue s t]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldValue -> Maybe (FieldValue s t)
forall tn fn (s :: Schema tn fn) (field :: FieldType tn).
CheckSchemaValue s field =>
FieldValue -> Maybe (FieldValue s field)
checkSchemaValue [FieldValue]
xs
  checkSchemaValue FieldValue
_          = Maybe (FieldValue s ('TList t))
forall a. Maybe a
Nothing
-- TODO: how to deal with maps??
instance CheckSchemaUnion s ts => CheckSchemaValue s ('TUnion ts) where
  checkSchemaValue :: FieldValue -> Maybe (FieldValue s ('TUnion ts))
checkSchemaValue FieldValue
x = NS (FieldValue s) ts -> FieldValue s ('TUnion ts)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (choices :: [FieldType typeName]).
NS (FieldValue sch) choices -> FieldValue sch ('TUnion choices)
S.FUnion (NS (FieldValue s) ts -> FieldValue s ('TUnion ts))
-> Maybe (NS (FieldValue s) ts)
-> Maybe (FieldValue s ('TUnion ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldValue -> Maybe (NS (FieldValue s) ts)
forall tn fn (s :: Schema tn fn) (ts :: [FieldType tn]).
CheckSchemaUnion s ts =>
FieldValue -> Maybe (NS (FieldValue s) ts)
checkSchemaUnion FieldValue
x

instance CheckSchemaUnion s '[] where
  checkSchemaUnion :: FieldValue -> Maybe (NS (FieldValue s) '[])
checkSchemaUnion FieldValue
_ = Maybe (NS (FieldValue s) '[])
forall a. Maybe a
Nothing
instance (CheckSchemaValue s t, CheckSchemaUnion s ts)
         => CheckSchemaUnion s (t ': ts) where
  checkSchemaUnion :: FieldValue -> Maybe (NS (FieldValue s) (t : ts))
checkSchemaUnion FieldValue
x = FieldValue s t -> NS (FieldValue s) (t : ts)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (FieldValue s t -> NS (FieldValue s) (t : ts))
-> Maybe (FieldValue s t) -> Maybe (NS (FieldValue s) (t : ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldValue -> Maybe (FieldValue s t)
forall tn fn (s :: Schema tn fn) (field :: FieldType tn).
CheckSchemaValue s field =>
FieldValue -> Maybe (FieldValue s field)
checkSchemaValue @_ @_ @s @t FieldValue
x Maybe (NS (FieldValue s) (t : ts))
-> Maybe (NS (FieldValue s) (t : ts))
-> Maybe (NS (FieldValue s) (t : ts))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NS (FieldValue s) ts -> NS (FieldValue s) (t : ts)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS (FieldValue s) ts -> NS (FieldValue s) (t : ts))
-> Maybe (NS (FieldValue s) ts)
-> Maybe (NS (FieldValue s) (t : ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldValue -> Maybe (NS (FieldValue s) ts)
forall tn fn (s :: Schema tn fn) (ts :: [FieldType tn]).
CheckSchemaUnion s ts =>
FieldValue -> Maybe (NS (FieldValue s) ts)
checkSchemaUnion FieldValue
x

-- Boring instances
deriving instance Show FieldValue
instance Eq FieldValue where
  FieldValue
FNull == :: FieldValue -> FieldValue -> Bool
== FieldValue
FNull = Bool
True
  FPrimitive (t
x :: a) == FPrimitive (t
y :: b)
    = case (Typeable t, Typeable t) => Maybe (t :~: t)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @b of
        Maybe (t :~: t)
Nothing   -> Bool
False
        Just t :~: t
Refl -> t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
t
y
  FSchematic Term
x == FSchematic Term
y = Term
x Term -> Term -> Bool
forall a. Eq a => a -> a -> Bool
== Term
y
  FOption    Maybe FieldValue
x == FOption    Maybe FieldValue
y = Maybe FieldValue
x Maybe FieldValue -> Maybe FieldValue -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe FieldValue
y
  FList      [FieldValue]
x == FList      [FieldValue]
y = [FieldValue]
x [FieldValue] -> [FieldValue] -> Bool
forall a. Eq a => a -> a -> Bool
== [FieldValue]
y
  FMap       Map FieldValue FieldValue
x == FMap       Map FieldValue FieldValue
y = Map FieldValue FieldValue
x Map FieldValue FieldValue -> Map FieldValue FieldValue -> Bool
forall a. Eq a => a -> a -> Bool
== Map FieldValue FieldValue
y
  FieldValue
_            == FieldValue
_            = Bool
False
instance Ord FieldValue where
  FieldValue
FNull <= :: FieldValue -> FieldValue -> Bool
<= FieldValue
_ = Bool
True
  FPrimitive t
_ <= FieldValue
FNull = Bool
False
  FPrimitive (t
x :: a) <= FPrimitive (t
y :: b)
    = case (Typeable t, Typeable t) => Maybe (t :~: t)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @b of
        Maybe (t :~: t)
Nothing   -> t -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf t
x TypeRep -> TypeRep -> Bool
forall a. Ord a => a -> a -> Bool
<= t -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf t
y
        Just t :~: t
Refl -> t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
t
y
  FPrimitive t
_ <= FieldValue
_            = Bool
True
  FSchematic Term
_ <= FieldValue
FNull        = Bool
False
  FSchematic Term
_ <= FPrimitive t
_ = Bool
False
  FSchematic Term
x <= FSchematic Term
y = Term
x Term -> Term -> Bool
forall a. Ord a => a -> a -> Bool
<= Term
y
  FSchematic Term
_ <= FieldValue
_            = Bool
True
  FOption    Maybe FieldValue
_ <= FieldValue
FNull        = Bool
False
  FOption    Maybe FieldValue
_ <= FPrimitive t
_ = Bool
False
  FOption    Maybe FieldValue
_ <= FSchematic Term
_ = Bool
False
  FOption    Maybe FieldValue
x <= FOption    Maybe FieldValue
y = Maybe FieldValue
x Maybe FieldValue -> Maybe FieldValue -> Bool
forall a. Ord a => a -> a -> Bool
<= Maybe FieldValue
y
  FOption    Maybe FieldValue
_ <= FieldValue
_            = Bool
True
  FList      [FieldValue]
_ <= FieldValue
FNull        = Bool
False
  FList      [FieldValue]
_ <= FPrimitive t
_ = Bool
False
  FList      [FieldValue]
_ <= FSchematic Term
_ = Bool
False
  FList      [FieldValue]
_ <= FOption    Maybe FieldValue
_ = Bool
False
  FList      [FieldValue]
x <= FList      [FieldValue]
y = [FieldValue]
x [FieldValue] -> [FieldValue] -> Bool
forall a. Ord a => a -> a -> Bool
<= [FieldValue]
y
  FList      [FieldValue]
_ <= FieldValue
_            = Bool
True
  FMap       Map FieldValue FieldValue
_ <= FieldValue
FNull        = Bool
False
  FMap       Map FieldValue FieldValue
_ <= FPrimitive t
_ = Bool
False
  FMap       Map FieldValue FieldValue
_ <= FSchematic Term
_ = Bool
False
  FMap       Map FieldValue FieldValue
_ <= FOption    Maybe FieldValue
_ = Bool
False
  FMap       Map FieldValue FieldValue
_ <= FList      [FieldValue]
_ = Bool
False
  FMap       Map FieldValue FieldValue
x <= FMap       Map FieldValue FieldValue
y = Map FieldValue FieldValue
x Map FieldValue FieldValue -> Map FieldValue FieldValue -> Bool
forall a. Ord a => a -> a -> Bool
<= Map FieldValue FieldValue
y
  -- FMap       _ <= _            = True