{-# language AllowAmbiguousTypes #-}
{-# language BlockArguments #-}
{-# language DataKinds #-}
{-# language DefaultSignatures #-}
{-# language DisambiguateRecordFields #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
{-# language ViewPatterns #-}

module Rel8.Table.Eq
  ( EqTable( eqTable ), (==:), (/=:)
  )
where

-- base
import Data.Foldable ( foldl' )
import Data.Functor.Const ( Const( Const ), getConst )
import Data.Kind ( Constraint, Type )
import Data.List.NonEmpty ( NonEmpty( (:|) ) )
import GHC.Generics ( Rep )
import Prelude

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Expr.Bool ( (||.), (&&.) )
import Rel8.Expr.Eq ( (==.), (/=.) )
import Rel8.FCF ( Eval, Exp )
import Rel8.Generic.Record ( Record )
import Rel8.Generic.Table.Record ( GTable, GColumns, gtable )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable ( htabulateA, hfield )
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import Rel8.Schema.Null ( Sql )
import Rel8.Table ( Table, Columns, toColumns, TColumns )
import Rel8.Type.Eq ( DBEq )


-- | The class of 'Table's that can be compared for equality. Equality on
-- tables is defined by equality of all columns all columns, so this class
-- means "all columns in a 'Table' have an instance of 'DBEq'".
type EqTable :: Type -> Constraint
class Table Expr a => EqTable a where
  eqTable :: Columns a (Dict (Sql DBEq))

  default eqTable ::
    ( GTable TEqTable TColumns (Rep (Record a))
    , Columns a ~ GColumns TColumns (Rep (Record a))
    )
    => Columns a (Dict (Sql DBEq))
  eqTable = forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (rep :: Context)
       (context :: Context).
GTable _Table _Columns rep =>
(forall a (proxy :: Context).
 Eval (_Table a) =>
 proxy a -> Eval (_Columns a) context)
-> GColumns _Columns rep context
gtable @TEqTable @TColumns @(Rep (Record a)) proxy a -> Eval (TColumns a) (Dict (Sql DBEq))
proxy a -> Columns a (Dict (Sql DBEq))
forall {x} {proxy :: Context}.
(Context x ~ Expr, Transpose Expr x ~ x, EqTable x) =>
proxy x -> Columns x (Dict (Sql DBEq))
forall a (proxy :: Context).
Eval (TEqTable a) =>
proxy a -> Eval (TColumns a) (Dict (Sql DBEq))
table
    where
      table :: proxy x -> Columns x (Dict (Sql DBEq))
table (proxy x
_ :: proxy x) = forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @x


data TEqTable :: Type -> Exp Constraint
type instance Eval (TEqTable a) = EqTable a


instance Sql DBEq a => EqTable (Expr a) where
  eqTable :: Columns (Expr a) (Dict (Sql DBEq))
eqTable = Dict (Sql DBEq) a -> HIdentity a (Dict (Sql DBEq))
forall a (context :: Context). context a -> HIdentity a context
HIdentity Dict (Sql DBEq) a
forall {a} (c :: a -> Constraint) (a1 :: a). c a1 => Dict c a1
Dict


instance (EqTable a, EqTable b) => EqTable (a, b)


instance (EqTable a, EqTable b, EqTable c) => EqTable (a, b, c)


instance (EqTable a, EqTable b, EqTable c, EqTable d) => EqTable (a, b, c, d)


instance (EqTable a, EqTable b, EqTable c, EqTable d, EqTable e) =>
  EqTable (a, b, c, d, e)


instance (EqTable a, EqTable b, EqTable c, EqTable d, EqTable e, EqTable f) =>
  EqTable (a, b, c, d, e, f)


instance
  ( EqTable a, EqTable b, EqTable c, EqTable d, EqTable e, EqTable f
  , EqTable g
  )
  => EqTable (a, b, c, d, e, f, g)


-- | Compare two 'Table's for equality. This corresponds to comparing all
-- columns inside each table for equality, and combining all comparisons with
-- @AND@.
(==:) :: forall a. EqTable a => a -> a -> Expr Bool
(a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) ==: :: forall a. EqTable a => a -> a -> Expr Bool
==: (a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
bs) =
  (Expr Bool -> Expr Bool -> Expr Bool)
-> NonEmpty (Expr Bool) -> Expr Bool
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' Expr Bool -> Expr Bool -> Expr Bool
(&&.) (NonEmpty (Expr Bool) -> Expr Bool)
-> NonEmpty (Expr Bool) -> Expr Bool
forall a b. (a -> b) -> a -> b
$ Const (NonEmpty (Expr Bool)) (Columns a Any)
-> NonEmpty (Expr Bool)
forall {k} a (b :: k). Const a b -> a
getConst (Const (NonEmpty (Expr Bool)) (Columns a Any)
 -> NonEmpty (Expr Bool))
-> Const (NonEmpty (Expr Bool)) (Columns a Any)
-> NonEmpty (Expr Bool)
forall a b. (a -> b) -> a -> b
$ (forall a.
 HField (Columns a) a -> Const (NonEmpty (Expr Bool)) (Any a))
-> Const (NonEmpty (Expr Bool)) (Columns a Any)
forall (t :: HTable) (m :: Context) (context :: Context).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (Columns a) a -> Const (NonEmpty (Expr Bool)) (Any a))
 -> Const (NonEmpty (Expr Bool)) (Columns a Any))
-> (forall a.
    HField (Columns a) a -> Const (NonEmpty (Expr Bool)) (Any a))
-> Const (NonEmpty (Expr Bool)) (Columns a Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field ->
    case (Columns a Expr -> HField (Columns a) a -> Expr a
forall (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
as HField (Columns a) a
field, Columns a Expr -> HField (Columns a) a -> Expr a
forall (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
bs HField (Columns a) a
field) of
      (Expr a
a, Expr a
b) -> case Columns a (Dict (Sql DBEq))
-> HField (Columns a) a -> Dict (Sql DBEq) a
forall (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @a) HField (Columns a) a
field of
        Dict (Sql DBEq) a
Dict -> NonEmpty (Expr Bool) -> Const (NonEmpty (Expr Bool)) (Any a)
forall {k} a (b :: k). a -> Const a b
Const (Expr Bool -> NonEmpty (Expr Bool)
forall a. a -> NonEmpty a
forall (f :: Context) a. Applicative f => a -> f a
pure (Expr a
a Expr a -> Expr a -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. Expr a
b))
infix 4 ==:


-- | Test if two 'Table's are different. This corresponds to comparing all
-- columns inside each table for inequality, and combining all comparisons with
-- @OR@.
(/=:) :: forall a. EqTable a => a -> a -> Expr Bool
(a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) /=: :: forall a. EqTable a => a -> a -> Expr Bool
/=: (a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
bs) =
  (Expr Bool -> Expr Bool -> Expr Bool)
-> NonEmpty (Expr Bool) -> Expr Bool
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' Expr Bool -> Expr Bool -> Expr Bool
(||.) (NonEmpty (Expr Bool) -> Expr Bool)
-> NonEmpty (Expr Bool) -> Expr Bool
forall a b. (a -> b) -> a -> b
$ Const (NonEmpty (Expr Bool)) (Columns a Any)
-> NonEmpty (Expr Bool)
forall {k} a (b :: k). Const a b -> a
getConst (Const (NonEmpty (Expr Bool)) (Columns a Any)
 -> NonEmpty (Expr Bool))
-> Const (NonEmpty (Expr Bool)) (Columns a Any)
-> NonEmpty (Expr Bool)
forall a b. (a -> b) -> a -> b
$ (forall a.
 HField (Columns a) a -> Const (NonEmpty (Expr Bool)) (Any a))
-> Const (NonEmpty (Expr Bool)) (Columns a Any)
forall (t :: HTable) (m :: Context) (context :: Context).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (Columns a) a -> Const (NonEmpty (Expr Bool)) (Any a))
 -> Const (NonEmpty (Expr Bool)) (Columns a Any))
-> (forall a.
    HField (Columns a) a -> Const (NonEmpty (Expr Bool)) (Any a))
-> Const (NonEmpty (Expr Bool)) (Columns a Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field ->
    case (Columns a Expr -> HField (Columns a) a -> Expr a
forall (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
as HField (Columns a) a
field, Columns a Expr -> HField (Columns a) a -> Expr a
forall (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
bs HField (Columns a) a
field) of
      (Expr a
a, Expr a
b) -> case Columns a (Dict (Sql DBEq))
-> HField (Columns a) a -> Dict (Sql DBEq) a
forall (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @a) HField (Columns a) a
field of
        Dict (Sql DBEq) a
Dict -> NonEmpty (Expr Bool) -> Const (NonEmpty (Expr Bool)) (Any a)
forall {k} a (b :: k). a -> Const a b
Const (Expr Bool -> NonEmpty (Expr Bool)
forall a. a -> NonEmpty a
forall (f :: Context) a. Applicative f => a -> f a
pure (Expr a
a Expr a -> Expr a -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
/=. Expr a
b))
infix 4 /=:


foldl1' :: (a -> a -> a) -> NonEmpty a -> a
foldl1' :: forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' a -> a -> a
f (a
a :| [a]
as) = (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Context) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
f a
a [a]
as