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

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


import ClassyPrelude.Yesod hiding (isInfixOf, any, all, isJust)
import Data.Universe
import qualified Data.Set as Set
import qualified Data.List as List
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

-- | Negation of `isNothing` which is missing
isJust :: (E.Esqueleto query expr backend, PersistField typ) => expr (E.Value (Maybe typ)) -> expr (E.Value Bool)
isJust = E.not_ . E.isNothing

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

hasInfix :: ( E.Esqueleto query expr backend
            , E.SqlString s1
            , E.SqlString s2
            )
         => expr (E.Value s2) -> expr (E.Value s1) -> 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 a                     -- ^ needle collection
                 -> E.SqlExpr (E.Value Bool)
mkContainsFilter = mkContainsFilterWith id

-- | like `mkContainsFiler` 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)

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


orderByOrd :: (Ord a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
orderByOrd = let sortUni = zipWith (,) [1..] $ List.sort universeF in -- memoize this, might not work due to polymorphism
    \x -> E.case_ [ (x E.==. E.val u, E.val i) | (i,u) <- sortUni ] (E.val (-1))

orderByEnum :: (Enum a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
orderByEnum x = E.case_ [ (x E.==. E.val u, E.val $ fromEnum u) | u <- universeF ] (E.val (-1))