{-|
Module: Squeal.PostgreSQL.Expression.Logic
Description: logical expressions and operators
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

logical expressions and operators
-}

{-# LANGUAGE
    DataKinds
  , OverloadedStrings
  , TypeOperators
#-}

module Squeal.PostgreSQL.Expression.Logic
  ( -- * Condition
    Condition
  , true
  , false
    -- * Logic
  , not_
  , (.&&)
  , (.||)
    -- * Conditional
  , caseWhenThenElse
  , ifThenElse
  ) where

import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema

-- | A `Condition` is an `Expression`, which can evaluate
-- to `true`, `false` or `Squeal.PostgreSQL.Null.null_`. This is because SQL uses
-- a three valued logic.
type Condition grp lat with db params from =
  Expression grp lat with db params from ('Null 'PGbool)

-- | >>> printSQL true
-- TRUE
true :: Expr (null 'PGbool)
true :: Expression grp lat with db params from (null 'PGbool)
true = ByteString -> Expression grp lat with db params from (null 'PGbool)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression ByteString
"TRUE"

-- | >>> printSQL false
-- FALSE
false :: Expr (null 'PGbool)
false :: Expression grp lat with db params from (null 'PGbool)
false = ByteString -> Expression grp lat with db params from (null 'PGbool)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression ByteString
"FALSE"

-- | >>> printSQL $ not_ true
-- (NOT TRUE)
not_ :: null 'PGbool --> null 'PGbool
not_ :: Expression grp lat with db params from (null 'PGbool)
-> Expression grp lat with db params from (null 'PGbool)
not_ = ByteString -> null 'PGbool --> null 'PGbool
forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeLeftOp ByteString
"NOT"

-- | >>> printSQL $ true .&& false
-- (TRUE AND FALSE)
(.&&) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
infixr 3 .&&
.&& :: Expression grp lat with db params from (null 'PGbool)
-> Expression grp lat with db params from (null 'PGbool)
-> Expression grp lat with db params from (null 'PGbool)
(.&&) = ByteString -> Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"AND"

-- | >>> printSQL $ true .|| false
-- (TRUE OR FALSE)
(.||) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
infixr 2 .||
.|| :: Expression grp lat with db params from (null 'PGbool)
-> Expression grp lat with db params from (null 'PGbool)
-> Expression grp lat with db params from (null 'PGbool)
(.||) = ByteString -> Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"OR"

-- | >>> :{
-- let
--   expression :: Expression grp lat with db params from (null 'PGint2)
--   expression = caseWhenThenElse [(true, 1), (false, 2)] 3
-- in printSQL expression
-- :}
-- CASE WHEN TRUE THEN (1 :: int2) WHEN FALSE THEN (2 :: int2) ELSE (3 :: int2) END
caseWhenThenElse
  :: [ ( Condition grp lat with db params from
       , Expression grp lat with db params from ty
     ) ]
  -- ^ whens and thens
  -> Expression grp lat with db params from ty
  -- ^ else
  -> Expression grp lat with db params from ty
caseWhenThenElse :: [(Condition grp lat with db params from,
  Expression grp lat with db params from ty)]
-> Expression grp lat with db params from ty
-> Expression grp lat with db params from ty
caseWhenThenElse [(Condition grp lat with db params from,
  Expression grp lat with db params from ty)]
whenThens Expression grp lat with db params from ty
else_ = ByteString -> Expression grp lat with db params from ty
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression (ByteString -> Expression grp lat with db params from ty)
-> ByteString -> Expression grp lat with db params from ty
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
  [ ByteString
"CASE"
  , [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
    [ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
      [ ByteString
" WHEN ", Condition grp lat with db params from -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Condition grp lat with db params from
when_
      , ByteString
" THEN ", Expression grp lat with db params from ty -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ty
then_
      ]
    | (Condition grp lat with db params from
when_,Expression grp lat with db params from ty
then_) <- [(Condition grp lat with db params from,
  Expression grp lat with db params from ty)]
whenThens
    ]
  , ByteString
" ELSE ", Expression grp lat with db params from ty -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ty
else_
  , ByteString
" END"
  ]

-- | >>> :{
-- let
--   expression :: Expression grp lat with db params from (null 'PGint2)
--   expression = ifThenElse true 1 0
-- in printSQL expression
-- :}
-- CASE WHEN TRUE THEN (1 :: int2) ELSE (0 :: int2) END
ifThenElse
  :: Condition grp lat with db params from
  -> Expression grp lat with db params from ty -- ^ then
  -> Expression grp lat with db params from ty -- ^ else
  -> Expression grp lat with db params from ty
ifThenElse :: Condition grp lat with db params from
-> Expression grp lat with db params from ty
-> Expression grp lat with db params from ty
-> Expression grp lat with db params from ty
ifThenElse Condition grp lat with db params from
if_ Expression grp lat with db params from ty
then_ Expression grp lat with db params from ty
else_ = [(Condition grp lat with db params from,
  Expression grp lat with db params from ty)]
-> Expression grp lat with db params from ty
-> Expression grp lat with db params from ty
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
[(Condition grp lat with db params from,
  Expression grp lat with db params from ty)]
-> Expression grp lat with db params from ty
-> Expression grp lat with db params from ty
caseWhenThenElse [(Condition grp lat with db params from
if_,Expression grp lat with db params from ty
then_)] Expression grp lat with db params from ty
else_