{-|
Module: Squeal.PostgreSQL.Expression.Math
Description: math functions
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

math functions
-}

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

module Squeal.PostgreSQL.Expression.Math
  ( -- * Math Function
    atan2_
  , quot_
  , rem_
  , trunc
  , round_
  , ceiling_
  ) where

import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Type.Schema

-- $setup
-- >>> import Squeal.PostgreSQL

-- | >>> :{
-- let
--   expression :: Expr (null 'PGfloat4)
--   expression = atan2_ (pi *: 2)
-- in printSQL expression
-- :}
-- atan2(pi(), (2.0 :: float4))
atan2_ :: float `In` PGFloating => '[ null float, null float] ---> null float
atan2_ :: '[null float, null float] ---> null float
atan2_ = ByteString -> '[null float, null float] ---> null float
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"atan2"


-- | integer division, truncates the result
--
-- >>> :{
-- let
--   expression :: Expression grp lat with db params from (null 'PGint2)
--   expression = 5 `quot_` 2
-- in printSQL expression
-- :}
-- ((5 :: int2) / (2 :: int2))
quot_
  :: int `In` PGIntegral
  => Operator (null int) (null int) (null int)
quot_ :: Operator (null int) (null int) (null int)
quot_ = ByteString -> Operator (null int) (null int) (null int)
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"/"

-- | remainder upon integer division
--
-- >>> :{
-- let
--   expression :: Expression grp lat with db params from (null 'PGint2)
--   expression = 5 `rem_` 2
-- in printSQL expression
-- :}
-- ((5 :: int2) % (2 :: int2))
rem_
  :: int `In` PGIntegral
  => Operator (null int) (null int) (null int)
rem_ :: Operator (null int) (null int) (null int)
rem_ = ByteString -> Operator (null int) (null int) (null int)
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"%"

-- | >>> :{
-- let
--   expression :: Expression grp lat with db params from (null 'PGfloat4)
--   expression = trunc pi
-- in printSQL expression
-- :}
-- trunc(pi())
trunc :: frac `In` PGFloating => null frac --> null frac
trunc :: null frac --> null frac
trunc = ByteString -> null frac --> null frac
forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"trunc"

-- | >>> :{
-- let
--   expression :: Expression grp lat with db params from (null 'PGfloat4)
--   expression = round_ pi
-- in printSQL expression
-- :}
-- round(pi())
round_ :: frac `In` PGFloating => null frac --> null frac
round_ :: null frac --> null frac
round_ = ByteString -> null frac --> null frac
forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"round"

-- | >>> :{
-- let
--   expression :: Expression grp lat with db params from (null 'PGfloat4)
--   expression = ceiling_ pi
-- in printSQL expression
-- :}
-- ceiling(pi())
ceiling_ :: frac `In` PGFloating => null frac --> null frac
ceiling_ :: null frac --> null frac
ceiling_ = ByteString -> null frac --> null frac
forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"ceiling"