{-# language FlexibleContexts #-}
{-# language OverloadedStrings #-}
{-# language TypeFamilies #-}

{-# options_ghc -fno-warn-redundant-constraints #-}

module Rel8.Expr.Num
  ( fromIntegral
  , realToFrac
  , div, mod, divMod
  , quot, rem, quotRem
  , ceiling, floor, round, truncate
  )
where

-- base
import Prelude ( (+), (-), fst, negate, signum, snd )

-- rel
import Rel8.Expr ( Expr( Expr ) )
import Rel8.Expr.Eq ( (==.) )
import Rel8.Expr.Function (function)
import Rel8.Expr.Opaleye ( castExpr )
import Rel8.Schema.Null ( Homonullable, Sql )
import Rel8.Table.Bool ( bool )
import Rel8.Type.Num ( DBFractional, DBIntegral, DBNum )


-- | Cast 'DBIntegral' types to 'DBNum' types. For example, this can be useful
-- if you need to turn an @Expr Int32@ into an @Expr Double@.
fromIntegral :: (Sql DBIntegral a, Sql DBNum b, Homonullable a b)
  => Expr a -> Expr b
fromIntegral :: forall a b.
(Sql DBIntegral a, Sql DBNum b, Homonullable a b) =>
Expr a -> Expr b
fromIntegral (Expr PrimExpr
a) = Expr b -> Expr b
forall a. Sql DBType a => Expr a -> Expr a
castExpr (PrimExpr -> Expr b
forall a. PrimExpr -> Expr a
Expr PrimExpr
a)


-- | Cast 'DBNum' types to 'DBFractional' types. For example, this can be useful
-- to convert @Expr Float@ to @Expr Double@.
realToFrac :: (Sql DBNum a, Sql DBFractional b, Homonullable a b)
  => Expr a -> Expr b
realToFrac :: forall a b.
(Sql DBNum a, Sql DBFractional b, Homonullable a b) =>
Expr a -> Expr b
realToFrac (Expr PrimExpr
a) = Expr b -> Expr b
forall a. Sql DBType a => Expr a -> Expr a
castExpr (PrimExpr -> Expr b
forall a. PrimExpr -> Expr a
Expr PrimExpr
a)


-- | Round a 'DBFractional' to a 'DBIntegral' by rounding to the nearest larger
-- integer.
--
-- Corresponds to the @ceiling()@ function.
ceiling :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
  => Expr a -> Expr b
ceiling :: forall a b.
(Sql DBFractional a, Sql DBIntegral b, Homonullable a b) =>
Expr a -> Expr b
ceiling = QualifiedName -> Expr a -> Expr b
forall arguments a.
(Arguments arguments, Sql DBType a) =>
QualifiedName -> arguments -> Expr a
function QualifiedName
"ceiling"


-- | Emulates the behaviour of the Haskell function 'Prelude.div' in
-- PostgreSQL.
div :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
div :: forall a. Sql DBIntegral a => Expr a -> Expr a -> Expr a
div Expr a
n Expr a
d = (Expr a, Expr a) -> Expr a
forall a b. (a, b) -> a
fst (Expr a -> Expr a -> (Expr a, Expr a)
forall a. Sql DBIntegral a => Expr a -> Expr a -> (Expr a, Expr a)
divMod Expr a
n Expr a
d)


-- | Emulates the behaviour of the Haskell function 'Prelude.mod' in
-- PostgreSQL.
mod :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
mod :: forall a. Sql DBIntegral a => Expr a -> Expr a -> Expr a
mod Expr a
n Expr a
d = (Expr a, Expr a) -> Expr a
forall a b. (a, b) -> b
snd (Expr a -> Expr a -> (Expr a, Expr a)
forall a. Sql DBIntegral a => Expr a -> Expr a -> (Expr a, Expr a)
divMod Expr a
n Expr a
d)


-- | Simultaneous 'div' and 'mod'.
divMod :: Sql DBIntegral a => Expr a -> Expr a -> (Expr a, Expr a)
divMod :: forall a. Sql DBIntegral a => Expr a -> Expr a -> (Expr a, Expr a)
divMod Expr a
n Expr a
d = (Expr a, Expr a)
-> (Expr a, Expr a) -> Expr Bool -> (Expr a, Expr a)
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool (Expr a, Expr a)
qr (Expr a
q Expr a -> Expr a -> Expr a
forall a. Num a => a -> a -> a
- Expr a
1, Expr a
r Expr a -> Expr a -> Expr a
forall a. Num a => a -> a -> a
+ Expr a
d) (Expr a -> Expr a
forall a. Num a => a -> a
signum Expr a
r Expr a -> Expr a -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. Expr a -> Expr a
forall a. Num a => a -> a
negate (Expr a -> Expr a
forall a. Num a => a -> a
signum Expr a
d))
  where
    qr :: (Expr a, Expr a)
qr@(Expr a
q, Expr a
r) = Expr a -> Expr a -> (Expr a, Expr a)
forall a. Sql DBIntegral a => Expr a -> Expr a -> (Expr a, Expr a)
quotRem Expr a
n Expr a
d


-- | Perform integral division. Corresponds to the @div()@ function in
-- PostgreSQL, which behaves like Haskell's 'Prelude.quot' rather than
-- 'Prelude.div'.
quot :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
quot :: forall a. Sql DBIntegral a => Expr a -> Expr a -> Expr a
quot Expr a
n Expr a
d = QualifiedName -> (Expr a, Expr a) -> Expr a
forall arguments a.
(Arguments arguments, Sql DBType a) =>
QualifiedName -> arguments -> Expr a
function QualifiedName
"div" (Expr a
n, Expr a
d)


-- | Corresponds to the @mod()@ function in PostgreSQL, which behaves like
-- Haskell's 'Prelude.rem' rather than 'Prelude.mod'.
rem :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
rem :: forall a. Sql DBIntegral a => Expr a -> Expr a -> Expr a
rem Expr a
n Expr a
d = QualifiedName -> (Expr a, Expr a) -> Expr a
forall arguments a.
(Arguments arguments, Sql DBType a) =>
QualifiedName -> arguments -> Expr a
function QualifiedName
"mod" (Expr a
n, Expr a
d)


-- | Simultaneous 'quot' and 'rem'.
quotRem :: Sql DBIntegral a => Expr a -> Expr a -> (Expr a, Expr a)
quotRem :: forall a. Sql DBIntegral a => Expr a -> Expr a -> (Expr a, Expr a)
quotRem Expr a
n Expr a
d = (Expr a -> Expr a -> Expr a
forall a. Sql DBIntegral a => Expr a -> Expr a -> Expr a
quot Expr a
n Expr a
d, Expr a -> Expr a -> Expr a
forall a. Sql DBIntegral a => Expr a -> Expr a -> Expr a
rem Expr a
n Expr a
d)


-- | Round a 'DFractional' to a 'DBIntegral' by rounding to the nearest smaller
-- integer. 
--
-- Corresponds to the @floor()@ function.
floor :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
  => Expr a -> Expr b
floor :: forall a b.
(Sql DBFractional a, Sql DBIntegral b, Homonullable a b) =>
Expr a -> Expr b
floor = QualifiedName -> Expr a -> Expr b
forall arguments a.
(Arguments arguments, Sql DBType a) =>
QualifiedName -> arguments -> Expr a
function QualifiedName
"floor"


-- | Round a 'DBFractional' to a 'DBIntegral' by rounding to the nearest
-- integer.
--
-- Corresponds to the @round()@ function.
round :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
  => Expr a -> Expr b
round :: forall a b.
(Sql DBFractional a, Sql DBIntegral b, Homonullable a b) =>
Expr a -> Expr b
round = QualifiedName -> Expr a -> Expr b
forall arguments a.
(Arguments arguments, Sql DBType a) =>
QualifiedName -> arguments -> Expr a
function QualifiedName
"round"


-- | Round a 'DBFractional' to a 'DBIntegral' by rounding to the nearest
-- integer towards zero.
truncate :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
  => Expr a -> Expr b
truncate :: forall a b.
(Sql DBFractional a, Sql DBIntegral b, Homonullable a b) =>
Expr a -> Expr b
truncate = QualifiedName -> Expr a -> Expr b
forall arguments a.
(Arguments arguments, Sql DBType a) =>
QualifiedName -> arguments -> Expr a
function QualifiedName
"trunc"