{-# 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 sch sty where
  V0 :: (sch :/: sty ~ 'DRecord nm '[])
     => V0 sch sty

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

instance (sch :/: sty ~ 'DRecord nm '[])
         => ToSchema sch sty (V0 sch sty) where
  toSchema :: V0 sch sty -> Term sch (sch :/: sty)
toSchema V0 sch sty
V0 = NP (Field sch) '[] -> Term sch ('DRecord nm '[])
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) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance (sch :/: sty ~ 'DRecord nm '[])
         => FromSchema sch sty (V0 sch sty) where
  fromSchema :: Term sch (sch :/: sty) -> V0 sch sty
fromSchema (TRecord NP (Field sch) args
Nil) = V0 sch sty
forall k f (sch :: Schema k f) (sty :: k) (nm :: k).
((sch :/: sty) ~ 'DRecord nm '[]) =>
V0 sch sty
V0

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

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

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

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

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

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