{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language GADTs                 #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds             #-}
{-# language StandaloneDeriving    #-}
{-# language TypeOperators         #-}
{-# language UndecidableInstances  #-}
{-|
Description : Anonymous terms for schema types

This module provides "anonymous terms". These
terms can be used when you don't want to write
your own Haskell type, but simply have a quick
and dirty interpretation for a schema type.
An important limitation is that anonymous terms
may only contain primitive fields.

The names of the types exposed in this module
refer to the amount of fields in the record.
Hence, use 'V0' for empty record, 'V1' for a record
with one field, 'V2' for two, and so forth.
-}
module Mu.Schema.Interpretation.Anonymous where

import           Data.SOP

import           Mu.Schema

-- | Anonymous term for a record with zero fields.
data V0 w sch sty where
  V0 :: (sch :/: sty ~ 'DRecord nm '[])
     => V0 w sch sty

deriving instance Show (V0 w sch sty)
deriving instance Eq   (V0 w sch sty)
deriving instance Ord  (V0 w sch sty)

instance (sch :/: sty ~ 'DRecord nm '[])
         => ToSchema w sch sty (V0 w sch sty) where
  toSchema :: V0 w sch sty -> Term w sch (sch :/: sty)
toSchema V0 = NP (Field w sch) '[] -> Term w sch ('DRecord nm '[])
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (name :: typeName).
NP (Field w sch) args -> Term w sch ('DRecord name args)
TRecord NP (Field w sch) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance (sch :/: sty ~ 'DRecord nm '[])
         => FromSchema w sch sty (V0 w sch sty) where
  fromSchema :: Term w sch (sch :/: sty) -> V0 w sch sty
fromSchema (TRecord Nil) = V0 w sch sty
forall k f k (sch :: Schema k f) (sty :: k) (nm :: k) (w :: k).
((sch :/: sty) ~ 'DRecord nm '[]) =>
V0 w sch sty
V0

-- | Anonymous term for a record with one field.
data V1 w sch sty where
  V1 :: (sch :/: sty
           ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a) ])
     => w a -> V1 w sch sty

deriving instance (Show (w a), sch :/: sty
                                 ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a) ])
                  => Show (V1 w sch sty)
deriving instance (Eq (w a), sch :/: sty
                               ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a) ])
                  => Eq (V1 w sch sty)
deriving instance (Ord (w a), sch :/: sty
                                ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a) ])
                  => Ord (V1 w sch sty)

instance ( Functor w
         , sch :/: sty ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a) ] )
         => ToSchema w sch sty (V1 w sch sty) where
  toSchema :: V1 w sch sty -> Term w sch (sch :/: sty)
toSchema (V1 x :: w a
x) = NP (Field w sch) '[ 'FieldDef f ('TPrimitive a)]
-> Term w sch ('DRecord nm '[ 'FieldDef f ('TPrimitive a)])
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (name :: typeName).
NP (Field w sch) args -> Term w sch ('DRecord name args)
TRecord (w (FieldValue w sch ('TPrimitive a))
-> Field w sch ('FieldDef f ('TPrimitive a))
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 (a -> FieldValue w sch ('TPrimitive a)
forall typeName fieldName t (w :: * -> *)
       (sch :: Schema typeName fieldName).
t -> FieldValue w sch ('TPrimitive t)
FPrimitive (a -> FieldValue w sch ('TPrimitive a))
-> w a -> w (FieldValue w sch ('TPrimitive a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w a
x) Field w sch ('FieldDef f ('TPrimitive a))
-> NP (Field w sch) '[]
-> NP (Field w sch) '[ 'FieldDef f ('TPrimitive a)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (Field w sch) '[]
forall k (a :: k -> *). NP a '[]
Nil)
instance ( Functor w
         , sch :/: sty ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a) ] )
         => FromSchema w sch sty (V1 w sch sty) where
  fromSchema :: Term w sch (sch :/: sty) -> V1 w sch sty
fromSchema (TRecord (Field x :: w (FieldValue w sch t)
x :* Nil)) = w a -> V1 w sch sty
forall k f (sch :: Schema k f) (sty :: k) (nm :: k) (f :: f) a
       (w :: * -> *).
((sch :/: sty) ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a)]) =>
w a -> V1 w sch sty
V1 (FieldValue w sch ('TPrimitive a) -> a
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) t.
FieldValue w sch ('TPrimitive t) -> t
unPrimitive (FieldValue w sch ('TPrimitive a) -> a)
-> w (FieldValue w sch ('TPrimitive a)) -> w a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (FieldValue w sch t)
w (FieldValue w sch ('TPrimitive a))
x)
    where unPrimitive :: FieldValue w sch ('TPrimitive t) -> t
          unPrimitive :: FieldValue w sch ('TPrimitive t) -> t
unPrimitive (FPrimitive l :: t
l) = t
t
l

-- | Anonymous term for a record with two fields.
data V2 w sch sty where
  V2 :: (sch :/: sty
           ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a)
                          , 'FieldDef g ('TPrimitive b) ])
     => w a -> w b -> V2 w sch sty

deriving instance (Show (w a), Show (w b),
                   sch :/: sty ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a)
                                              , 'FieldDef g ('TPrimitive b) ])
                  => Show (V2 w sch sty)
deriving instance (Eq (w a), Eq (w b),
                   sch :/: sty ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a)
                                              , 'FieldDef g ('TPrimitive b) ])
                  => Eq (V2 w sch sty)
deriving instance (Ord (w a), Ord (w b),
                   sch :/: sty ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a)
                                              , 'FieldDef g ('TPrimitive b) ])
                  => Ord (V2 w sch sty)

instance ( Functor w
         , sch :/: sty ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a)
                                      , 'FieldDef g ('TPrimitive b) ] )
         => ToSchema w sch sty (V2 w sch sty) where
  toSchema :: V2 w sch sty -> Term w sch (sch :/: sty)
toSchema (V2 x :: w a
x y :: w b
y) = NP
  (Field w sch)
  '[ 'FieldDef f ('TPrimitive a), 'FieldDef g ('TPrimitive b)]
-> Term
     w
     sch
     ('DRecord
        nm '[ 'FieldDef f ('TPrimitive a), 'FieldDef g ('TPrimitive b)])
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (name :: typeName).
NP (Field w sch) args -> Term w sch ('DRecord name args)
TRecord (w (FieldValue w sch ('TPrimitive a))
-> Field w sch ('FieldDef f ('TPrimitive a))
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 (a -> FieldValue w sch ('TPrimitive a)
forall typeName fieldName t (w :: * -> *)
       (sch :: Schema typeName fieldName).
t -> FieldValue w sch ('TPrimitive t)
FPrimitive (a -> FieldValue w sch ('TPrimitive a))
-> w a -> w (FieldValue w sch ('TPrimitive a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w a
x) Field w sch ('FieldDef f ('TPrimitive a))
-> NP (Field w sch) '[ 'FieldDef g ('TPrimitive b)]
-> NP
     (Field w sch)
     '[ 'FieldDef f ('TPrimitive a), 'FieldDef g ('TPrimitive b)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* w (FieldValue w sch ('TPrimitive b))
-> Field w sch ('FieldDef g ('TPrimitive b))
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 (b -> FieldValue w sch ('TPrimitive b)
forall typeName fieldName t (w :: * -> *)
       (sch :: Schema typeName fieldName).
t -> FieldValue w sch ('TPrimitive t)
FPrimitive (b -> FieldValue w sch ('TPrimitive b))
-> w b -> w (FieldValue w sch ('TPrimitive b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w b
y) Field w sch ('FieldDef g ('TPrimitive b))
-> NP (Field w sch) '[]
-> NP (Field w sch) '[ 'FieldDef g ('TPrimitive b)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (Field w sch) '[]
forall k (a :: k -> *). NP a '[]
Nil)
instance ( Functor w
         , sch :/: sty ~ 'DRecord nm '[ 'FieldDef f ('TPrimitive a)
                                      , 'FieldDef g ('TPrimitive b) ] )
         => FromSchema w sch sty (V2 w sch sty) where
  fromSchema :: Term w sch (sch :/: sty) -> V2 w sch sty
fromSchema (TRecord (Field x :: w (FieldValue w sch t)
x :* Field y :: w (FieldValue w sch t)
y :* Nil)) = w a -> w b -> V2 w sch sty
forall k f (sch :: Schema k f) (sty :: k) (nm :: k) (f :: f) a
       (g :: f) b (w :: * -> *).
((sch :/: sty)
 ~ 'DRecord
     nm '[ 'FieldDef f ('TPrimitive a), 'FieldDef g ('TPrimitive b)]) =>
w a -> w b -> V2 w sch sty
V2 (FieldValue w sch ('TPrimitive a) -> a
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) t.
FieldValue w sch ('TPrimitive t) -> t
unPrimitive (FieldValue w sch ('TPrimitive a) -> a)
-> w (FieldValue w sch ('TPrimitive a)) -> w a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (FieldValue w sch t)
w (FieldValue w sch ('TPrimitive a))
x) (FieldValue w sch ('TPrimitive b) -> b
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) t.
FieldValue w sch ('TPrimitive t) -> t
unPrimitive (FieldValue w sch ('TPrimitive b) -> b)
-> w (FieldValue w sch ('TPrimitive b)) -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (FieldValue w sch t)
w (FieldValue w sch ('TPrimitive b))
y)
    where unPrimitive :: FieldValue w sch ('TPrimitive t) -> t
          unPrimitive :: FieldValue w sch ('TPrimitive t) -> t
unPrimitive (FPrimitive l :: t
l) = t
t
l