{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MonoLocalBinds        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

module Data.Record.Beam.FromBackendRow (
    GFromLargeBackendRow
  , FromBackendRowI
  ) where

import Data.Functor.Identity
import Data.List (foldl')
import Data.Proxy
import Data.Record.Generic
import Data.Record.Generic.GHC
import Data.Record.Generic.Transform
import Database.Beam.Backend.SQL.Row
import Database.Beam.Schema.Tables
import GHC.Generics hiding (Generic(..), (:.:))

import qualified Data.Record.Generic.Rep as Rep

import Data.Record.Beam.Interpretation

type GFromLargeBackendRow be tbl = (
    Generic (tbl Identity)
  , Generic (tbl Uninterpreted)
  , HasNormalForm (BeamInterpretation Identity) (tbl Identity) (tbl Uninterpreted)
  , Constraints (tbl Uninterpreted) (FromBackendRowI be)
  )

instance GFromLargeBackendRow be tbl
      => GFromBackendRow be (ThroughLRGenerics (tbl Exposed))
                            (ThroughLRGenerics (tbl Identity)) where
  gFromBackendRow :: Proxy (ThroughLRGenerics (tbl Exposed))
-> FromBackendRowM be (ThroughLRGenerics (tbl Identity) ())
gFromBackendRow Proxy (ThroughLRGenerics (tbl Exposed))
_ =
      (Rep (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted)
 -> ThroughLRGenerics (tbl Identity) ())
-> FromBackendRowM
     be
     (Rep (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted))
-> FromBackendRowM be (ThroughLRGenerics (tbl Identity) ())
forall a b.
(a -> b) -> FromBackendRowM be a -> FromBackendRowM be b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (tbl Identity -> ThroughLRGenerics (tbl Identity) ()
forall a p. a -> ThroughLRGenerics a p
WrapThroughLRGenerics (tbl Identity -> ThroughLRGenerics (tbl Identity) ())
-> (Rep
      (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted)
    -> tbl Identity)
-> Rep
     (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted)
-> ThroughLRGenerics (tbl Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep I (tbl Identity) -> tbl Identity
forall a. Generic a => Rep I a -> a
to (Rep I (tbl Identity) -> tbl Identity)
-> (Rep
      (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted)
    -> Rep I (tbl Identity))
-> Rep
     (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted)
-> tbl Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy BeamInterpretation
-> Rep
     (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted)
-> Rep I (tbl Identity)
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)) (FromBackendRowM
   be
   (Rep (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted))
 -> FromBackendRowM be (ThroughLRGenerics (tbl Identity) ()))
-> FromBackendRowM
     be
     (Rep (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted))
-> FromBackendRowM be (ThroughLRGenerics (tbl Identity) ())
forall a b. (a -> b) -> a -> b
$
        Rep
  (FromBackendRowM be :.: Interpret (BeamInterpretation Identity))
  (tbl Uninterpreted)
-> FromBackendRowM
     be
     (Rep (Interpret (BeamInterpretation Identity)) (tbl Uninterpreted))
forall (m :: * -> *) (f :: * -> *) a.
Applicative m =>
Rep (m :.: f) a -> m (Rep f a)
Rep.sequenceA Rep
  (FromBackendRowM be :.: Interpret (BeamInterpretation Identity))
  (tbl Uninterpreted)
perField
    where
      perField :: Rep (FromBackendRowM be :.: Interpret (BeamInterpretation Identity)) (tbl Uninterpreted)
      perField :: Rep
  (FromBackendRowM be :.: Interpret (BeamInterpretation Identity))
  (tbl Uninterpreted)
perField = Proxy (FromBackendRowI be)
-> (forall x.
    FromBackendRowI be x =>
    (:.:)
      (FromBackendRowM be) (Interpret (BeamInterpretation Identity)) x)
-> Rep
     (FromBackendRowM be :.: Interpret (BeamInterpretation Identity))
     (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 @(FromBackendRowI be)) (FromBackendRowM be (Interpret (BeamInterpretation Identity) x)
-> (:.:)
     (FromBackendRowM be) (Interpret (BeamInterpretation Identity)) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp FromBackendRowM be (Interpret (BeamInterpretation Identity) x)
forall be x.
FromBackendRowI be x =>
FromBackendRowM be (Interpret (BeamInterpretation Identity) x)
fromBackendRowI)

  gValuesNeeded :: Proxy be
-> Proxy (ThroughLRGenerics (tbl Exposed))
-> Proxy (ThroughLRGenerics (tbl Identity))
-> Int
gValuesNeeded Proxy be
pBackend Proxy (ThroughLRGenerics (tbl Exposed))
_ Proxy (ThroughLRGenerics (tbl Identity))
_ =
       (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Rep (K Int) (tbl Uninterpreted) -> [Int]
forall a b. Rep (K a) b -> [a]
Rep.collapse Rep (K Int) (tbl Uninterpreted)
perField
   where
      perField :: Rep (K Int) (tbl Uninterpreted)
      perField :: Rep (K Int) (tbl Uninterpreted)
perField = Proxy (FromBackendRowI be)
-> (forall x. FromBackendRowI be x => K Int x)
-> Rep (K Int) (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 @(FromBackendRowI be)) (Proxy be -> K Int x
forall be x. FromBackendRowI be x => Proxy be -> K Int x
valuesNeededI Proxy be
pBackend)

{-------------------------------------------------------------------------------
  Internal

  NOTE: the superclass constraints on the 'FromBackendRowI' instances match
  instance heads in beam, but his is what is used in the definition of
  'GFromBackendRow' itself, so we stick with it (and use @MonoLocalBinds@).
-------------------------------------------------------------------------------}

class FromBackendRowI be x where
  fromBackendRowI :: FromBackendRowM be (Interpret (BeamInterpretation Identity) x)
  valuesNeededI   :: Proxy be -> K Int x

instance FromBackendRow be x => FromBackendRowI be (Uninterpreted x) where
  fromBackendRowI :: FromBackendRowM
  be (Interpret (BeamInterpretation Identity) (Uninterpreted x))
fromBackendRowI = x -> Interpret (BeamInterpretation Identity) (Uninterpreted x)
Interpreted (BeamInterpretation Identity) (Uninterpreted x)
-> Interpret (BeamInterpretation Identity) (Uninterpreted x)
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (x -> Interpret (BeamInterpretation Identity) (Uninterpreted x))
-> (K1 R x () -> x)
-> K1 R x ()
-> Interpret (BeamInterpretation Identity) (Uninterpreted x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R x () -> x
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R x ()
 -> Interpret (BeamInterpretation Identity) (Uninterpreted x))
-> FromBackendRowM be (K1 R x ())
-> FromBackendRowM
     be (Interpret (BeamInterpretation Identity) (Uninterpreted x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM be (K1 R x ())
fromBeam
    where
      fromBeam :: FromBackendRowM be (K1 R x ())
      fromBeam :: FromBackendRowM be (K1 R x ())
fromBeam = Proxy (K1 R (Exposed x)) -> FromBackendRowM be (K1 R x ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (Exposed x)))

  valuesNeededI :: Proxy be -> K Int (Uninterpreted x)
valuesNeededI Proxy be
pBackend = Int -> K Int (Uninterpreted x)
forall k a (b :: k). a -> K a b
K (Int -> K Int (Uninterpreted x)) -> Int -> K Int (Uninterpreted x)
forall a b. (a -> b) -> a -> b
$
      Proxy be -> Proxy (K1 R (Exposed x)) -> Proxy (K1 R x) -> Int
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded
        Proxy be
pBackend
        (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (Exposed x)))
        (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @((K1 R x)))

instance FromBackendRow be (tbl Identity) => FromBackendRowI be (tbl Uninterpreted) where
  fromBackendRowI :: FromBackendRowM
  be (Interpret (BeamInterpretation Identity) (tbl Uninterpreted))
fromBackendRowI = tbl Identity
-> Interpret (BeamInterpretation Identity) (tbl Uninterpreted)
Interpreted (BeamInterpretation Identity) (tbl Uninterpreted)
-> Interpret (BeamInterpretation Identity) (tbl Uninterpreted)
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (tbl Identity
 -> Interpret (BeamInterpretation Identity) (tbl Uninterpreted))
-> (K1 R (tbl Identity) () -> tbl Identity)
-> K1 R (tbl Identity) ()
-> Interpret (BeamInterpretation Identity) (tbl Uninterpreted)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R (tbl Identity) () -> tbl Identity
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R (tbl Identity) ()
 -> Interpret (BeamInterpretation Identity) (tbl Uninterpreted))
-> FromBackendRowM be (K1 R (tbl Identity) ())
-> FromBackendRowM
     be (Interpret (BeamInterpretation Identity) (tbl Uninterpreted))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM be (K1 R (tbl Identity) ())
fromBeam
    where
      fromBeam :: FromBackendRowM be (K1 R (tbl Identity) ())
      fromBeam :: FromBackendRowM be (K1 R (tbl Identity) ())
fromBeam = Proxy (K1 R (tbl Exposed))
-> FromBackendRowM be (K1 R (tbl Identity) ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (tbl Exposed)))

  valuesNeededI :: Proxy be -> K Int (tbl Uninterpreted)
valuesNeededI Proxy be
pBackend = Int -> K Int (tbl Uninterpreted)
forall k a (b :: k). a -> K a b
K (Int -> K Int (tbl Uninterpreted))
-> Int -> K Int (tbl Uninterpreted)
forall a b. (a -> b) -> a -> b
$
      Proxy be
-> Proxy (K1 R (tbl Exposed)) -> Proxy (K1 R (tbl Identity)) -> Int
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded
        Proxy be
pBackend
        (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (tbl Exposed)))
        (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (tbl Identity)))

instance FromBackendRow  be (tbl (Nullable Identity))
      => FromBackendRowI be (tbl (Nullable Uninterpreted)) where
  fromBackendRowI :: FromBackendRowM
  be
  (Interpret
     (BeamInterpretation Identity) (tbl (Nullable Uninterpreted)))
fromBackendRowI = tbl (Nullable Identity)
-> Interpret
     (BeamInterpretation Identity) (tbl (Nullable Uninterpreted))
Interpreted
  (BeamInterpretation Identity) (tbl (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation Identity) (tbl (Nullable Uninterpreted))
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (tbl (Nullable Identity)
 -> Interpret
      (BeamInterpretation Identity) (tbl (Nullable Uninterpreted)))
-> (K1 R (tbl (Nullable Identity)) () -> tbl (Nullable Identity))
-> K1 R (tbl (Nullable Identity)) ()
-> Interpret
     (BeamInterpretation Identity) (tbl (Nullable Uninterpreted))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R (tbl (Nullable Identity)) () -> tbl (Nullable Identity)
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R (tbl (Nullable Identity)) ()
 -> Interpret
      (BeamInterpretation Identity) (tbl (Nullable Uninterpreted)))
-> FromBackendRowM be (K1 R (tbl (Nullable Identity)) ())
-> FromBackendRowM
     be
     (Interpret
        (BeamInterpretation Identity) (tbl (Nullable Uninterpreted)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM be (K1 R (tbl (Nullable Identity)) ())
fromBeam
    where
      fromBeam :: FromBackendRowM be (K1 R (tbl (Nullable Identity)) ())
      fromBeam :: FromBackendRowM be (K1 R (tbl (Nullable Identity)) ())
fromBeam = Proxy (K1 R (tbl (Nullable Exposed)))
-> FromBackendRowM be (K1 R (tbl (Nullable Identity)) ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (tbl (Nullable Exposed))))

  valuesNeededI :: Proxy be -> K Int (tbl (Nullable Uninterpreted))
valuesNeededI Proxy be
pBackend = Int -> K Int (tbl (Nullable Uninterpreted))
forall k a (b :: k). a -> K a b
K (Int -> K Int (tbl (Nullable Uninterpreted)))
-> Int -> K Int (tbl (Nullable Uninterpreted))
forall a b. (a -> b) -> a -> b
$
      Proxy be
-> Proxy (K1 R (tbl (Nullable Exposed)))
-> Proxy (K1 R (tbl (Nullable Identity)))
-> Int
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded
        Proxy be
pBackend
        (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (tbl (Nullable Exposed))))
        (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(K1 R (tbl (Nullable Identity))))