-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Database.Esqueleto.Utils
  ( true, false
  , justVal, justValList, toValues
  , isJust, alt
  , isInfixOf, hasInfix
  , strConcat, substring
  , (=?.), (?=.)
  , or, and
  , any, all
  , subSelectAnd, subSelectOr
  , mkExactFilter, mkExactFilterWith
  , mkExactFilterLast, mkExactFilterLastWith
  , mkContainsFilter, mkContainsFilterWith
  , mkDayFilter, mkDayFilterFrom, mkDayFilterTo
  , mkExistsFilter
  , anyFilter, allFilter
  , orderByList
  , orderByOrd, orderByEnum
  , strip, lower, ciEq
  , selectExists, selectNotExists
  , SqlHashable
  , sha256
  , maybe, maybe2, maybeEq, guardMaybe, unsafeCoalesce
  , bool
  , max, min
  , greatest, least
  , abs
  , SqlProject(..)
  , (->.), (#>>.)
  , fromSqlKey
  , unKey
  , selectCountRows, selectCountDistinct
  , selectMaybe
  , day, diffDays, diffTimes
  , exprLift
  , explicitUnsafeCoerceSqlExprValue
  , module Database.Esqueleto.Utils.TH
  ) where


import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust, maybe, bool, max, min, abs)
import Data.Universe
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Foldable as F
import Data.List.NonEmpty (NonEmpty(..))
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Experimental as Ex
import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Internal.Internal as E
import Database.Esqueleto.Utils.TH

import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.ByteString.Lazy as Lazy (ByteString)

import Crypto.Hash (Digest, SHA256)

import Data.Coerce (Coercible)

import Data.Time.Clock (NominalDiffTime)

import qualified Data.Text.Lazy.Builder as Text.Builder

import Data.Monoid (Last(..))

{-# ANN any ("HLint: ignore Use any" :: String) #-}
{-# ANN all ("HLint: ignore Use all" :: String) #-}


{-# ANN any ("HLint: ignore Use any" :: String) #-}
{-# ANN all ("HLint: ignore Use all" :: String) #-}


--
-- Description : Convenience for using `Esqueleto`,
--               intended to be imported qualified
--               just like @Esqueleto@


-- ezero = E.val (0 :: Int64)

-- | Often needed with this concrete type
true :: E.SqlExpr (E.Value Bool)
true  = E.val True

-- | Often needed with this concrete type
false :: E.SqlExpr (E.Value Bool)
false = E.val False

--  Timestamp larger than any other; not sure if this is a good idea to use
-- infinity :: E.SqlExpr (E.Value UTCTime)
-- infinity = unsafeSqlValue "'infinity'"

justVal :: PersistField typ => typ -> E.SqlExpr (E.Value (Maybe typ))
-- justVal = E.val . Just
justVal = E.just . E.val

justValList :: PersistField typ => [typ] -> E.SqlExpr (E.ValueList (Maybe typ))
-- justValList = E.valList . map Just
justValList = E.justList . E.valList

toValues :: PersistField typ => NonEmpty typ -> Ex.From (Ex.SqlExpr (Ex.Value typ)) -- E.From does not work here! Requires Experimental!
toValues = E.values . fmap Ex.val

infixl 4 =?.
(=?.) ::  PersistField typ => E.SqlExpr (E.Value typ) ->  E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
(=?.) = (E.==.) . E.just

infixl 4 ?=.
(?=.) ::  PersistField typ => E.SqlExpr (E.Value (Maybe typ)) ->  E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value Bool)
(?=.) a b = a E.==. E.just b

-- | Negation of `isNothing` which is missing
isJust :: PersistField typ => E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
isJust = E.not_ . E.isNothing

-- | Deprecated, use coalesce directly
alt :: PersistField typ => E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value (Maybe typ))
-- alt a b = E.case_ [(isJust a, a), (isJust b, b)] b
alt a b = E.coalesce [a,b]

infix 4 `isInfixOf`, `hasInfix`

-- | Check if the first string is contained in the text derived from the second argument
isInfixOf :: ( E.SqlString s1
             , E.SqlString s2
             )
          => E.SqlExpr (E.Value s1) -> E.SqlExpr (E.Value s2) -> E.SqlExpr (E.Value Bool)
isInfixOf needle strExpr = E.castString strExpr `E.ilike` (E.%) E.++. needle E.++. (E.%)

hasInfix :: ( E.SqlString s1
            , E.SqlString s2
            )
         => E.SqlExpr (E.Value s2) -> E.SqlExpr (E.Value s1) -> E.SqlExpr (E.Value Bool)
hasInfix = flip isInfixOf

infixl 6 `strConcat`

strConcat :: E.SqlString s
          => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s)
strConcat = E.unsafeSqlBinOp " || "

substring :: ( E.SqlString str
             , Num from, Num for
             )
          => E.SqlExpr (E.Value str)
          -> E.SqlExpr (E.Value from)
          -> E.SqlExpr (E.Value for)
          -> E.SqlExpr (E.Value str)
substring (E.ERaw _m1 f1) (E.ERaw _m2 f2) (E.ERaw _m3 f3)
  = E.ERaw E.noMeta $ \_nParens info ->
      let (strTLB, strVals) = f1 E.Parens info
          (fromiTLB, fromiVals) = f2 E.Parens info
          (foriTLB, foriVals) = f3 E.Parens info
       in ( "SUBSTRING" <> E.parens (E.parens strTLB <> " FROM " <> E.parens fromiTLB <> " FOR " <> E.parens foriTLB)
          , strVals <> fromiVals <> foriVals
          )

explicitUnsafeCoerceSqlExprValue :: forall b a.
                                    Text
                                 -> E.SqlExpr (E.Value a)
                                 -> E.SqlExpr (E.Value b)
explicitUnsafeCoerceSqlExprValue typ (E.ERaw _m1 f1) = E.ERaw E.noMeta $ \_nParens info ->
  let (valTLB, valVals) = f1 E.Parens info
   in ( E.parens valTLB <> " :: " <> Text.Builder.fromText typ
      , valVals
      )

and, or :: Foldable f => f (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
and = F.foldr (E.&&.) true
or = F.foldr (E.||.) false

-- | Given a test and a set of values, check whether anyone succeeds the test
--   WARNING: SQL leaves it explicitely unspecified whether `||` is short curcuited (i.e. lazily evaluated)
any :: MonoFoldable f => (Element f -> E.SqlExpr (E.Value Bool)) -> f -> E.SqlExpr (E.Value Bool)
any test = or . map test . otoList

-- | Given a test and a set of values, check whether all succeeds the test
--   WARNING: SQL leaves it explicitely unspecified whether `&&` is short curcuited (i.e. lazily evaluated)
all :: MonoFoldable f => (Element f -> E.SqlExpr (E.Value Bool)) -> f -> E.SqlExpr (E.Value Bool)
all test = and . map test . otoList

subSelectAnd, subSelectOr :: E.SqlQuery (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
subSelectAnd q = parens . E.subSelectUnsafe $ flip (E.unsafeSqlAggregateFunction "bool_and" E.AggModeAll) [] <$> q
subSelectOr  q = parens . E.subSelectUnsafe $ flip (E.unsafeSqlAggregateFunction "bool_or"  E.AggModeAll) [] <$> q

parens :: E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value a)
parens = E.unsafeSqlFunction ""


-- Allow usage of Tuples as DbtRowKey, i.e. SqlIn instances for tuples
$(sqlInTuples [2..16])

-- | Example for usage of unValueN
_exampleUnValueN :: (E.Value a, E.Value b, E.Value c) -> (a,b,c)
_exampleUnValueN = $(unValueN 3)

-- | Example for usage of unValueNIs
_exampleUnValueNIs :: (E.Value a, b, E.Value c) -> (a,b,c)
_exampleUnValueNIs = $(unValueNIs 3 [1,3])

-- | Example for usage of sqlIJproj
_queryFeaturesDegree :: (a `E.InnerJoin` b `E.InnerJoin` c) -> b
_queryFeaturesDegree  = $(sqlIJproj 3 2)


-- | generic filter creation for dbTable
--   Given a lens-like function, make filter for exact matches in a collection
--   (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere)
mkExactFilter :: (PersistField a)
  => (t -> E.SqlExpr (E.Value a))  -- ^ getter from query to searched element
  -> t                             -- ^ query row
  -> Set.Set a                     -- ^ needle collection
  -> E.SqlExpr (E.Value Bool)
mkExactFilter = mkExactFilterWith id

-- | like `mkExactFilter` but allows for conversion; convenient in conjunction with `anyFilter` and `allFilter`
mkExactFilterWith :: (PersistField b)
  => (a -> b)                      -- ^ type conversion
  -> (t -> E.SqlExpr (E.Value b))  -- ^ getter from query to searched element
  -> t                             -- ^ query row
  -> Set.Set a                     -- ^ needle collection
  -> E.SqlExpr (E.Value Bool)
mkExactFilterWith cast lenslike row criterias
  | Set.null criterias = true
  | otherwise = lenslike row `E.in_` E.valList (cast <$> Set.toList criterias)

-- | generic filter creation for dbTable
--   Given a lens-like function, make filter for exact matches against last element of a collection
mkExactFilterLast :: (PersistField a)
                  => (t -> E.SqlExpr (E.Value a))  -- ^ getter from query to searched element
                  -> t                             -- ^ query row
                  -> Last a                        -- ^ needle
                  -> E.SqlExpr (E.Value Bool)
mkExactFilterLast = mkExactFilterLastWith id

-- | like `mkExactFilterLast` but allows for conversion; convenient in conjunction with `anyFilter` and `allFilter`
mkExactFilterLastWith :: (PersistField b)
                      => (a -> b)                      -- ^ type conversion
                      -> (t -> E.SqlExpr (E.Value b))  -- ^ getter from query to searched element
                      -> t                             -- ^ query row
                      -> Last a                        -- ^ needle
                      -> E.SqlExpr (E.Value Bool)
mkExactFilterLastWith cast lenslike row criterias
  | Last (Just crit) <- criterias = lenslike row E.==. E.val (cast crit)
  | otherwise = true

-- | generic filter creation for dbTable
--   Given a lens-like function, make filter searching for needles in String-like elements
--   (Keep Set here to ensure that there are no duplicates)
mkContainsFilter :: E.SqlString a
                 => (t -> E.SqlExpr (E.Value a))  -- ^ getter from query to searched element
                 -> t                             -- ^ query row
                 -> Set.Set a                     -- ^ needle collection
                 -> E.SqlExpr (E.Value Bool)
mkContainsFilter = mkContainsFilterWith id

-- | like `mkContainsFilter` but allows for conversion; convenient in conjunction with `anyFilter` and `allFilter`
mkContainsFilterWith :: E.SqlString b
                     => (a -> b)
                     -> (t -> E.SqlExpr (E.Value b))  -- ^ getter from query to searched element
                     -> t                             -- ^ query row
                     -> Set.Set a                     -- ^ needle collection
                     -> E.SqlExpr (E.Value Bool)
mkContainsFilterWith cast lenslike row criterias
  | Set.null criterias = true
  | otherwise = any (hasInfix $ lenslike row) (E.val . cast <$> Set.toList criterias)


mkDayFilter :: (t -> E.SqlExpr (E.Value UTCTime))  -- ^ getter from query to searched element
            -> t                                   -- ^ query row
            -> Last Day                            -- ^ a day to filter for
            -> E.SqlExpr (E.Value Bool)
mkDayFilter lenslike row criterias
  | Last (Just crit) <- criterias = day (lenslike row) E.==. E.val crit
  | otherwise = true


mkDayFilterFrom :: (t -> E.SqlExpr (E.Value UTCTime))  -- ^ getter from query to searched element
            -> t                                   -- ^ query row
            -> Last Day                            -- ^ a day range to filter for
            -> E.SqlExpr (E.Value Bool)
mkDayFilterFrom lenslike row criterias
  | Last (Just crit) <- criterias = day (lenslike row) E.>=. E.val crit
  | otherwise = true

mkDayFilterTo :: (t -> E.SqlExpr (E.Value UTCTime))  -- ^ getter from query to searched element
            -> t                                   -- ^ query row
            -> Last Day                            -- ^ a day range to filter for
            -> E.SqlExpr (E.Value Bool)
mkDayFilterTo lenslike row criterias
  | Last (Just crit) <- criterias = day (lenslike row) E.<=. E.val crit
  | otherwise = true


mkExistsFilter :: PathPiece a
               => (t -> a -> E.SqlQuery ())
               -> t
               -> Set.Set a
               -> E.SqlExpr (E.Value Bool)
mkExistsFilter query row criterias
  | Set.null criterias = true
  | otherwise = any (E.exists . query row) $ Set.toList criterias

-- | Combine several filters, using logical or
anyFilter :: Foldable f
          => f (t -> cs -> E.SqlExpr (E.Value Bool))
          -> (t -> cs -> E.SqlExpr (E.Value Bool))
anyFilter fltrs needle criterias = F.foldr aux false fltrs
  where
    aux fltr acc = fltr needle criterias E.||. acc

-- | Combine several filters, using logical and
allFilter :: Foldable f
          => f (t -> cs -> E.SqlExpr (E.Value Bool))
          -> (t -> cs -> E.SqlExpr (E.Value Bool))
allFilter fltrs needle criterias = F.foldr aux true fltrs
  where
    aux fltr acc = fltr needle criterias E.&&. acc


orderByList :: PersistField a => [a] -> E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
orderByList vals
  = let sortUni = zip [1..] vals -- memoize this, might not work due to polymorphism
     in \x -> E.case_ [ (x E.==. E.val u, E.val i) | (i,u) <- sortUni ] (E.val . succ $ List.length vals)

orderByOrd :: (Ord a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
orderByOrd = orderByList $ List.sort universeF

orderByEnum :: (Enum a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
orderByEnum = orderByList $ List.sortOn fromEnum universeF

lower :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s)
lower = E.unsafeSqlFunction "LOWER"

strip :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s)
strip = E.unsafeSqlFunction "TRIM"

infix 4 `ciEq`

ciEq :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool)
ciEq a b = lower a E.==. lower b


selectExists, selectNotExists :: forall m a. MonadIO m => E.SqlQuery a -> E.SqlReadT m Bool
selectExists query = do
  res <- E.select . return . E.exists $ void query

  case res of
    [E.Value b] -> return b
    _other      -> error "SELECT EXISTS ... returned zero or more than one rows"
selectNotExists = fmap not . selectExists


class SqlHashable a
instance SqlHashable Text
instance SqlHashable ByteString
instance SqlHashable Lazy.Text
instance SqlHashable Lazy.ByteString


sha256 :: SqlHashable a => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value (Digest SHA256))
sha256 = E.unsafeSqlFunction "digest" . (, E.val "sha256" :: E.SqlExpr (E.Value Text))


maybe :: (PersistField a, PersistField b)
      => E.SqlExpr (E.Value b)
      -> (E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value b))
      -> E.SqlExpr (E.Value (Maybe a))
      -> E.SqlExpr (E.Value b)
maybe onNothing onJust val = E.case_
  [ E.when_
      (E.not_ $ E.isNothing val)
    E.then_
      (onJust $ E.veryUnsafeCoerceSqlExprValue val)
  ]
  (E.else_ onNothing)

maybe2 :: (PersistField a, PersistField b, PersistField c)
       => E.SqlExpr (E.Value c)
       -> (E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value b) -> E.SqlExpr (E.Value c))
       -> E.SqlExpr (E.Value (Maybe a))
       -> E.SqlExpr (E.Value (Maybe b))
       -> E.SqlExpr (E.Value c)
maybe2 onNothing onJust val1 val2 = E.case_
  [ E.when_
      (isJust val1 E.&&. isJust val2)
    E.then_
      (onJust (E.veryUnsafeCoerceSqlExprValue val1) (E.veryUnsafeCoerceSqlExprValue val2))
  ]
  (E.else_ onNothing)

infix 4 `maybeEq`

maybeEq :: PersistField a
        => E.SqlExpr (E.Value (Maybe a))
        -> E.SqlExpr (E.Value (Maybe a))
        -> E.SqlExpr (E.Value Bool)
-- ^ `E.==.` but treat `E.nothing` as identical
maybeEq a b = E.case_
  [ E.when_
      (E.isNothing a)
    E.then_
      (E.isNothing b)
  , E.when_
      (E.isNothing b)
    E.then_
      false -- (E.isNothing a)
  ]
  (E.else_ $ a E.==. b)

guardMaybe :: PersistField a
           => E.SqlExpr (E.Value (Maybe a))
           -> E.SqlQuery (E.SqlExpr (E.Value a))
guardMaybe mVal = do
  E.where_ $ isJust mVal
  return $ E.veryUnsafeCoerceSqlExprValue mVal

bool :: PersistField a
     => E.SqlExpr (E.Value a)
     -> E.SqlExpr (E.Value a)
     -> E.SqlExpr (E.Value Bool)
     -> E.SqlExpr (E.Value a)
bool onFalse onTrue val = E.case_
  [ E.when_
      val
    E.then_
      onTrue
  ]
  (E.else_ onFalse)

-- called see greatest and least within postgresql
-- TODO: this is buggy! Both return always the first argument if any argument is NULL!
max, min :: PersistField a
         => E.SqlExpr (E.Value a)
         -> E.SqlExpr (E.Value a)
         -> E.SqlExpr (E.Value a)
max a b = bool a b $ b E.>. a
min a b = bool a b $ b E.<. a

-- these alternatives for max/min ought to be more efficient; note that NULL is avoided by greatest/least
greatest :: PersistField a => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value a)
greatest a b = E.unsafeSqlFunction "GREATEST" $ E.toArgList (a,b)

least :: PersistField a => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value a)
least a b = E.unsafeSqlFunction "LEAST" $ E.toArgList (a,b)

abs :: (PersistField a, Num a)
    => E.SqlExpr (E.Value a)
    -> E.SqlExpr (E.Value a)
abs x = bool (E.val 0 E.-. x) x $ x E.>. E.val 0

unsafeCoalesce :: E.PersistField a => [E.SqlExpr (E.Value (Maybe a))] -> E.SqlExpr (E.Value a)
unsafeCoalesce = E.veryUnsafeCoerceSqlExprValue . E.coalesce


class (PersistEntity entity, PersistField value, PersistField value') => SqlProject entity value entity' value' | entity value entity' -> value', entity value value' -> entity' where
  sqlProject :: E.SqlExpr entity' -> EntityField entity value -> E.SqlExpr (E.Value value')
  unSqlProject :: forall p1 p2. p1 entity -> p2 entity' -> value -> value'
  unSqlProjectExpr :: forall p1 p2. p1 entity -> p2 entity' -> E.SqlExpr (E.Value value) -> E.SqlExpr (E.Value value')

instance (PersistEntity val, PersistField typ) => SqlProject val typ (E.Entity val) typ where
  sqlProject = (E.^.)
  unSqlProject _ _ = id
  unSqlProjectExpr _ _ = id

instance (PersistEntity val, PersistField typ) => SqlProject val typ (Maybe (E.Entity val)) (Maybe typ) where
  sqlProject = (E.?.)
  unSqlProject _ _ = Just
  unSqlProjectExpr _ _ = E.just

infixl 8 ->.

(->.) :: E.SqlExpr (E.Value a) -> Text -> E.SqlExpr (E.Value b)
(->.) expr t = E.unsafeSqlBinOp "->" expr $ E.val t

infixl 8 #>>.

(#>>.) :: E.SqlExpr (E.Value a) -> Text -> E.SqlExpr (E.Value (Maybe Text))
(#>>.) expr t = E.unsafeSqlBinOp "#>>" expr $ E.val t


fromSqlKey :: (ToBackendKey SqlBackend entity, PersistField (Key entity)) => E.SqlExpr (E.Value (Key entity)) -> E.SqlExpr (E.Value Int64)
fromSqlKey = E.veryUnsafeCoerceSqlExprValue

unKey :: ( Coercible (Key entity) a
         , PersistField (Key entity), PersistField a
         )
      => E.SqlExpr (E.Value (Key entity)) -> E.SqlExpr (E.Value a)
unKey = E.veryUnsafeCoerceSqlExprValue


selectCountRows :: (Num a, PersistField a, MonadIO m) => E.SqlQuery ignored -> E.SqlReadT m a
selectCountRows q = do
  res <- E.select $ E.countRows <$ q
  case res of
    [E.Value res']
      -> return res'
    _other
      -> error "E.countRows did not return exactly one result"

selectCountDistinct :: (Num a, PersistField a, MonadIO m) => E.SqlQuery (E.SqlExpr (E.Value typ)) -> E.SqlReadT m a
selectCountDistinct q = do
  res <- E.select $ E.countDistinct <$> q
  case res of
    [E.Value res']
      -> return res'
    _other
      -> error "E.countDistinct did not return exactly one result"

selectMaybe :: (E.SqlSelect a r, MonadIO m) => E.SqlQuery a -> E.SqlReadT m (Maybe r)
selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)


day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day)
day = E.unsafeSqlCastAs "date"

infixl 6 `diffDays`, `diffTimes`

diffDays :: E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Int)
-- ^ PostgreSQL is weird.
diffDays a b = E.veryUnsafeCoerceSqlExprValue $ a E.-. b

diffTimes :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value NominalDiffTime)
diffTimes a b = unsafeExtract "EPOCH" $ a E.-. b

unsafeExtract :: String -> E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value b)
unsafeExtract extr (E.ERaw _mF vF) = E.ERaw E.noMeta $ \_nParens info ->
  let (vTLB, vVals) = vF E.Parens info
   in ( "EXTRACT" <> E.parens (fromString extr <> " FROM " <> E.parens vTLB)
      , vVals
      )


class ExprLift e a | e -> a where
  exprLift :: a -> e

instance PersistField a => ExprLift (E.SqlExpr (E.Value a)) a where
  exprLift = E.val

instance (PersistField a, PersistField b, Finite a) => ExprLift (E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value b)) (a -> b) where
  exprLift f v = E.case_
    [ E.when_ (v E.==. E.val v') E.then_ (E.val $ f v')
    | v' <- universeF
    ]
    (E.else_ $ E.veryUnsafeCoerceSqlExprValue (E.nothing :: E.SqlExpr (E.Value (Maybe ()))))

instance (PersistField a1, PersistField a2, PersistField b, Finite a1, Finite a2) => ExprLift (E.SqlExpr (E.Value a1) -> E.SqlExpr (E.Value a2) -> E.SqlExpr (E.Value b)) (a1 -> a2 -> b) where
  exprLift f v1 v2 = E.case_
    [ E.when_ (       v1 E.==. E.val v1'
                E.&&. v2 E.==. E.val v2'
              )
      E.then_ (E.val $ f v1' v2')
    | v1' <- universeF
    , v2' <- universeF
    ]
    (E.else_ $ E.else_ $ E.veryUnsafeCoerceSqlExprValue (E.nothing :: E.SqlExpr (E.Value (Maybe ()))))