git.iko.soy/rel8
on 11bcbbb help sign in
rel8/src/Rel8/Table/Eq.hs
78 lines 2.4 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language NamedFieldPuns #-}
5{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
8{-# language TypeFamilies #-}
9{-# language UndecidableInstances #-}
10{-# language UndecidableSuperClasses #-}
11{-# language ViewPatterns #-}
13module Rel8.Table.Eq
14 ( EqTable, (==:), (/=:)
15 )
16where
18-- base
19import Data.Foldable ( foldl' )
20import Data.Functor.Const ( Const( Const ), getConst )
21import Data.Kind ( Constraint, Type )
22import Data.List.NonEmpty ( NonEmpty( (:|) ) )
23import Prelude
25-- rel8
26import Rel8.Expr ( Expr, Col(..) )
27import Rel8.Expr.Bool ( (||.), (&&.) )
28import Rel8.Expr.Eq ( (==.), (/=.) )
29import Rel8.Opaque ( Opaque )
30import Rel8.Schema.Dict ( Dict( Dict ) )
31import Rel8.Schema.HTable ( HConstrainTable, htabulateA, hfield, hdicts )
32import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
33import Rel8.Table ( Table, Columns, toColumns )
34import Rel8.Type.Eq ( DBEq )
37type EqTable :: Type -> Constraint
38class
39 ( Table Expr a
40 , HConstrainTable (Columns a) (ConstrainDBType DBEq)
41 ) => EqTable a
42instance
43 ( Table Expr a
44 , HConstrainTable (Columns a) (ConstrainDBType DBEq)
45 ) => EqTable a
46instance {-# OVERLAPPING #-} EqTable Opaque
49-- | Compare two 'Table's for equality. This corresponds to comparing all
50-- columns inside each table for equality, and combining all comparisons with
51-- @AND@.
52(==:) :: forall a. EqTable a => a -> a -> Expr Bool
53(toColumns -> as) ==: (toColumns -> bs) =
54 foldl1' (&&.) $ getConst $ htabulateA $ \field ->
55 case (hfield as field, hfield bs field) of
56 (DB a, DB b) -> case hfield dicts field of
57 Dict -> Const (pure (a ==. b))
58 where
59 dicts = hdicts @(Columns a) @(ConstrainDBType DBEq)
60infix 4 ==:
63-- | Test if two 'Table's are different. This corresponds to comparing all
64-- columns inside each table for inequality, and combining all comparisons with
65-- @OR@.
66(/=:) :: forall a. EqTable a => a -> a -> Expr Bool
67(toColumns -> as) /=: (toColumns -> bs) =
68 foldl1' (||.) $ getConst $ htabulateA $ \field ->
69 case (hfield as field, hfield bs field) of
70 (DB a, DB b) -> case hfield dicts field of
71 Dict -> Const (pure (a /=. b))
72 where
73 dicts = hdicts @(Columns a) @(ConstrainDBType DBEq)
74infix 4 /=:
77foldl1' :: (a -> a -> a) -> NonEmpty a -> a
78foldl1' f (a :| as) = foldl' f a as