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

module Database.Esqueleto.Utils
  ( true, false
  , isInfixOf, hasInfix
  , any, all
  , SqlIn(..)
  , mkExactFilter, mkExactFilterWith
  , mkContainsFilter
  , anyFilter, allFilter
  ) where

import ClassyPrelude.Yesod hiding (isInfixOf, any, all)
import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Database.Esqueleto as E
import Database.Esqueleto.Utils.TH


--
-- 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

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

hasInfix :: (E.Esqueleto query expr backend, E.SqlString s2) =>
   expr (E.Value s2) -> Text -> expr (E.Value Bool)
hasInfix = flip isInfixOf

-- | 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 :: Foldable f =>
  (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
any test = F.foldr (\needle acc -> acc E.||. test needle) false

-- | 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 :: Foldable f =>
  (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
all test = F.foldr (\needle acc -> acc E.&&. test needle) true


-- 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 @mkExactFiler@ 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 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 Text                  -- ^ needle collection
  -> E.SqlExpr (E.Value Bool)
mkContainsFilter lenslike row criterias
  | Set.null criterias = true
  | otherwise = any (hasInfix $ lenslike row) criterias

-- | Combine several filters, using logical or
anyFilter :: (Foldable f)
  => f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool))
  -> t
  -> Set.Set Text
  -> 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 -> Set.Set Text-> E.SqlExpr (E.Value Bool))
  -> t
  -> Set.Set Text
  -> E.SqlExpr (E.Value Bool)
allFilter fltrs needle criterias = F.foldr aux true fltrs
  where
    aux fltr acc = fltr needle criterias E.&&. acc