{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE UndecidableInstances  #-}

module Data.Record.Beam.Constraints (
    GLargeFieldsFulfillConstraint
  , WithConstrainedFieldsI
  ) where

import Data.Record.Generic
import Data.Record.Generic.GHC
import Data.Record.Generic.Transform
import Database.Beam.Schema.Tables
import GHC.Generics hiding (Generic(..), (:.:))

import qualified Data.Record.Generic.Rep as Rep

import Data.Record.Beam.Interpretation

type GLargeFieldsFulfillConstraint tbl c = (
    Generic (tbl (HasConstraint c))
  , Generic (tbl Uninterpreted)
  , HasNormalForm (BeamInterpretation (HasConstraint c)) (tbl (HasConstraint c)) (tbl Uninterpreted)
  , Constraints (tbl Uninterpreted) (WithConstrainedFieldsI c)
  )

instance GLargeFieldsFulfillConstraint tbl c
      => GFieldsFulfillConstraint c (ThroughLRGenerics (tbl Exposed))
                                    (ThroughLRGenerics (tbl (HasConstraint c))) where
  gWithConstrainedFields :: Proxy c
-> Proxy (ThroughLRGenerics (tbl Exposed))
-> ThroughLRGenerics (tbl (HasConstraint c)) ()
gWithConstrainedFields Proxy c
pc Proxy (ThroughLRGenerics (tbl Exposed))
_ = tbl (HasConstraint c)
-> ThroughLRGenerics (tbl (HasConstraint c)) ()
forall a p. a -> ThroughLRGenerics a p
WrapThroughLRGenerics (tbl (HasConstraint c)
 -> ThroughLRGenerics (tbl (HasConstraint c)) ())
-> tbl (HasConstraint c)
-> ThroughLRGenerics (tbl (HasConstraint c)) ()
forall a b. (a -> b) -> a -> b
$
      Rep I (tbl (HasConstraint c)) -> tbl (HasConstraint c)
forall a. Generic a => Rep I a -> a
to (Rep I (tbl (HasConstraint c)) -> tbl (HasConstraint c))
-> (Rep
      (Interpret (BeamInterpretation (HasConstraint c)))
      (tbl Uninterpreted)
    -> Rep I (tbl (HasConstraint c)))
-> Rep
     (Interpret (BeamInterpretation (HasConstraint c)))
     (tbl Uninterpreted)
-> tbl (HasConstraint c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy BeamInterpretation
-> Rep
     (Interpret (BeamInterpretation (HasConstraint c)))
     (tbl Uninterpreted)
-> Rep I (tbl (HasConstraint c))
forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *)
       (x :: (k -> *) -> *).
HasNormalForm (d f) (x f) (x Uninterpreted) =>
Proxy d -> Rep (Interpret (d f)) (x Uninterpreted) -> Rep I (x f)
denormalize1 (forall {k} (t :: k). Proxy t
forall (t :: (* -> *) -> *). Proxy t
Proxy @BeamInterpretation) (Rep
   (Interpret (BeamInterpretation (HasConstraint c)))
   (tbl Uninterpreted)
 -> tbl (HasConstraint c))
-> Rep
     (Interpret (BeamInterpretation (HasConstraint c)))
     (tbl Uninterpreted)
-> tbl (HasConstraint c)
forall a b. (a -> b) -> a -> b
$
        Proxy (WithConstrainedFieldsI c)
-> (forall x.
    WithConstrainedFieldsI c x =>
    Interpret (BeamInterpretation (HasConstraint c)) x)
-> Rep
     (Interpret (BeamInterpretation (HasConstraint c)))
     (tbl Uninterpreted)
forall a (c :: * -> Constraint) (f :: * -> *).
(Generic a, Constraints a c) =>
Proxy c -> (forall x. c x => f x) -> Rep f a
Rep.cpure (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @(WithConstrainedFieldsI c)) (Proxy c -> Interpret (BeamInterpretation (HasConstraint c)) x
forall (c :: * -> Constraint) x.
WithConstrainedFieldsI c x =>
Proxy c -> Interpret (BeamInterpretation (HasConstraint c)) x
withConstrainedFieldsI Proxy c
pc)

class WithConstrainedFieldsI c x where
  withConstrainedFieldsI :: Proxy c -> Interpret (BeamInterpretation (HasConstraint c)) x

instance c x => WithConstrainedFieldsI c (Uninterpreted x) where
  withConstrainedFieldsI :: Proxy c
-> Interpret
     (BeamInterpretation (HasConstraint c)) (Uninterpreted x)
withConstrainedFieldsI Proxy c
pc = Interpreted
  (BeamInterpretation (HasConstraint c)) (Uninterpreted x)
-> Interpret
     (BeamInterpretation (HasConstraint c)) (Uninterpreted x)
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted
   (BeamInterpretation (HasConstraint c)) (Uninterpreted x)
 -> Interpret
      (BeamInterpretation (HasConstraint c)) (Uninterpreted x))
-> Interpreted
     (BeamInterpretation (HasConstraint c)) (Uninterpreted x)
-> Interpret
     (BeamInterpretation (HasConstraint c)) (Uninterpreted x)
forall a b. (a -> b) -> a -> b
$ K1 R (HasConstraint c x) () -> HasConstraint c x
forall k i c (p :: k). K1 i c p -> c
unK1 K1 R (HasConstraint c x) ()
fromBeam
    where
      fromBeam :: K1 R (HasConstraint c x) ()
      fromBeam :: K1 R (HasConstraint c x) ()
fromBeam = Proxy c -> Proxy (K1 R (Exposed x)) -> K1 R (HasConstraint c x) ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields Proxy c
pc (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (Exposed x)))

instance FieldsFulfillConstraint c tbl
      => WithConstrainedFieldsI c (tbl Uninterpreted) where
  withConstrainedFieldsI :: Proxy c
-> Interpret
     (BeamInterpretation (HasConstraint c)) (tbl Uninterpreted)
withConstrainedFieldsI Proxy c
pc = Interpreted
  (BeamInterpretation (HasConstraint c)) (tbl Uninterpreted)
-> Interpret
     (BeamInterpretation (HasConstraint c)) (tbl Uninterpreted)
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted
   (BeamInterpretation (HasConstraint c)) (tbl Uninterpreted)
 -> Interpret
      (BeamInterpretation (HasConstraint c)) (tbl Uninterpreted))
-> Interpreted
     (BeamInterpretation (HasConstraint c)) (tbl Uninterpreted)
-> Interpret
     (BeamInterpretation (HasConstraint c)) (tbl Uninterpreted)
forall a b. (a -> b) -> a -> b
$ K1 R (tbl (HasConstraint c)) () -> tbl (HasConstraint c)
forall k i c (p :: k). K1 i c p -> c
unK1 K1 R (tbl (HasConstraint c)) ()
fromBeam
    where
      fromBeam :: K1 R (tbl (HasConstraint c)) ()
      fromBeam :: K1 R (tbl (HasConstraint c)) ()
fromBeam = Proxy c
-> Proxy (K1 R (tbl Exposed)) -> K1 R (tbl (HasConstraint c)) ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields Proxy c
pc (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (tbl Exposed)))

instance FieldsFulfillConstraintNullable c tbl
      => WithConstrainedFieldsI c (tbl (Nullable Uninterpreted)) where
  withConstrainedFieldsI :: Proxy c
-> Interpret
     (BeamInterpretation (HasConstraint c))
     (tbl (Nullable Uninterpreted))
withConstrainedFieldsI Proxy c
pc = Interpreted
  (BeamInterpretation (HasConstraint c))
  (tbl (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation (HasConstraint c))
     (tbl (Nullable Uninterpreted))
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted
   (BeamInterpretation (HasConstraint c))
   (tbl (Nullable Uninterpreted))
 -> Interpret
      (BeamInterpretation (HasConstraint c))
      (tbl (Nullable Uninterpreted)))
-> Interpreted
     (BeamInterpretation (HasConstraint c))
     (tbl (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation (HasConstraint c))
     (tbl (Nullable Uninterpreted))
forall a b. (a -> b) -> a -> b
$ K1 R (tbl (Nullable (HasConstraint c))) ()
-> tbl (Nullable (HasConstraint c))
forall k i c (p :: k). K1 i c p -> c
unK1 K1 R (tbl (Nullable (HasConstraint c))) ()
fromBeam
    where
      fromBeam :: K1 R (tbl (Nullable (HasConstraint c))) ()
      fromBeam :: K1 R (tbl (Nullable (HasConstraint c))) ()
fromBeam = Proxy c
-> Proxy (K1 R (tbl (Nullable Exposed)))
-> K1 R (tbl (Nullable (HasConstraint c))) ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields Proxy c
pc (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (tbl (Nullable Exposed))))