{-# language DataKinds #-}
{-# language DerivingStrategies #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds #-}
{-# language RoleAnnotations #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# language UndecidableSuperClasses #-}

module Rel8.Expr
  ( Expr(..)
  , Col( E, unE )
  )
where

-- base
import Data.Functor.Identity ( Identity )
import Data.Kind ( Type )
import Data.String ( IsString, fromString )
import Prelude hiding ( null )

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

-- rel8
import Rel8.Expr.Function ( function, nullaryFunction )
import Rel8.Expr.Null ( liftOpNull, nullify )
import Rel8.Expr.Opaleye
  ( castExpr
  , fromPrimExpr
  , mapPrimExpr
  , zipPrimExprsWith
  )
import Rel8.Expr.Serialize ( litExpr )
import Rel8.Schema.Context ( Interpretation, Col )
import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
import Rel8.Schema.Reify ( notReify )
import Rel8.Schema.Result ( Result )
import Rel8.Schema.Spec ( Spec( Spec ) )
import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns, reify, unreify
  )
import Rel8.Table.Recontextualize ( Recontextualize )
import Rel8.Type ( DBType )
import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )
import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )


-- | Typed SQL expressions.
type role Expr representational
type Expr :: k -> Type
data Expr a where
  Expr :: k ~ Type => !Opaleye.PrimExpr -> Expr (a :: k)


deriving stock instance Show (Expr a)


instance Sql DBSemigroup a => Semigroup (Expr a) where
  <> :: Expr a -> Expr a -> Expr a
(<>) = case Nullable a => Nullity a
forall a. Nullable a => Nullity a
nullable @a of
    Nullity a
Null -> (Expr (Unnullify' (IsMaybe a) a)
 -> Expr (Unnullify' (IsMaybe a) a)
 -> Expr (Unnullify' (IsMaybe a) a))
-> Expr (Maybe (Unnullify' (IsMaybe a) a))
-> Expr (Maybe (Unnullify' (IsMaybe a) a))
-> Expr (Maybe (Unnullify' (IsMaybe a) a))
forall c a b.
DBType c =>
(Expr a -> Expr b -> Expr c)
-> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)
liftOpNull Expr (Unnullify' (IsMaybe a) a)
-> Expr (Unnullify' (IsMaybe a) a)
-> Expr (Unnullify' (IsMaybe a) a)
forall a. DBSemigroup a => Expr a -> Expr a -> Expr a
(<>.)
    Nullity a
NotNull -> Expr a -> Expr a -> Expr a
forall a. DBSemigroup a => Expr a -> Expr a -> Expr a
(<>.)
  {-# INLINABLE (<>) #-}


instance Sql DBMonoid a => Monoid (Expr a) where
  mempty :: Expr a
mempty = case Nullable a => Nullity a
forall a. Nullable a => Nullity a
nullable @a of
    Nullity a
Null -> Expr (Unnullify' (IsMaybe a) a)
-> Expr (Maybe (Unnullify' (IsMaybe a) a))
forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify Expr (Unnullify' (IsMaybe a) a)
forall a. DBMonoid a => Expr a
memptyExpr
    Nullity a
NotNull -> Expr a
forall a. DBMonoid a => Expr a
memptyExpr
  {-# INLINABLE mempty #-}


instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
  fromString :: String -> Expr a
fromString = a -> Expr a
forall a. Sql DBType a => a -> Expr a
litExpr (a -> Expr a) -> (String -> a) -> String -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Nullable a => Nullity a
forall a. Nullable a => Nullity a
nullable @a of
    Nullity a
Null -> Unnullify' (IsMaybe a) a -> Maybe (Unnullify' (IsMaybe a) a)
forall a. a -> Maybe a
Just (Unnullify' (IsMaybe a) a -> Maybe (Unnullify' (IsMaybe a) a))
-> (String -> Unnullify' (IsMaybe a) a)
-> String
-> Maybe (Unnullify' (IsMaybe a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Unnullify' (IsMaybe a) a
forall a. IsString a => String -> a
fromString
    Nullity a
NotNull -> String -> a
forall a. IsString a => String -> a
fromString


instance Sql DBNum a => Num (Expr a) where
  + :: Expr a -> Expr a -> Expr a
(+) = (PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr a -> Expr a
forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:+))
  * :: Expr a -> Expr a -> Expr a
(*) = (PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr a -> Expr a
forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:*))
  (-) = (PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr a -> Expr a
forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:-))

  abs :: Expr a -> Expr a
abs = (PrimExpr -> PrimExpr) -> Expr a -> Expr a
forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr (UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr UnOp
Opaleye.OpAbs)
  negate :: Expr a -> Expr a
negate = (PrimExpr -> PrimExpr) -> Expr a -> Expr a
forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr (UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr UnOp
Opaleye.OpNegate)

  signum :: Expr a -> Expr a
signum = Expr a -> Expr a
forall a. Sql DBType a => Expr a -> Expr a
castExpr (Expr a -> Expr a) -> (Expr a -> Expr a) -> Expr a -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrimExpr -> PrimExpr) -> Expr a -> Expr a
forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr (UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr (String -> UnOp
Opaleye.UnOpOther String
"SIGN"))

  fromInteger :: Integer -> Expr a
fromInteger = Expr a -> Expr a
forall a. Sql DBType a => Expr a -> Expr a
castExpr (Expr a -> Expr a) -> (Integer -> Expr a) -> Integer -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a) -> (Integer -> PrimExpr) -> Integer -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (Integer -> Literal) -> Integer -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
Opaleye.IntegerLit


instance Sql DBFractional a => Fractional (Expr a) where
  / :: Expr a -> Expr a -> Expr a
(/) = (PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr a -> Expr a
forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:/))

  fromRational :: Rational -> Expr a
fromRational =
    Expr a -> Expr a
forall a. Sql DBType a => Expr a -> Expr a
castExpr (Expr a -> Expr a) -> (Rational -> Expr a) -> Rational -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> Expr a
forall k (a :: k). (k ~ *) => PrimExpr -> Expr a
Expr (PrimExpr -> Expr a)
-> (Rational -> PrimExpr) -> Rational -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (Rational -> Literal) -> Rational -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Literal
Opaleye.NumericLit (Scientific -> Literal)
-> (Rational -> Scientific) -> Rational -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac


instance Sql DBFloating a => Floating (Expr a) where
  pi :: Expr a
pi = String -> Expr a
forall a. Sql DBType a => String -> Expr a
nullaryFunction String
"PI"
  exp :: Expr a -> Expr a
exp = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"exp"
  log :: Expr a -> Expr a
log = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"ln"
  sqrt :: Expr a -> Expr a
sqrt = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"sqrt"
  ** :: Expr a -> Expr a -> Expr a
(**) = (PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr a -> Expr a
forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:^))
  logBase :: Expr a -> Expr a -> Expr a
logBase = String -> Expr a -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"log"
  sin :: Expr a -> Expr a
sin = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"sin"
  cos :: Expr a -> Expr a
cos = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"cos"
  tan :: Expr a -> Expr a
tan = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"tan"
  asin :: Expr a -> Expr a
asin = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"asin"
  acos :: Expr a -> Expr a
acos = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"acos"
  atan :: Expr a -> Expr a
atan = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"atan"
  sinh :: Expr a -> Expr a
sinh = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"sinh"
  cosh :: Expr a -> Expr a
cosh = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"cosh"
  tanh :: Expr a -> Expr a
tanh = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"tanh"
  asinh :: Expr a -> Expr a
asinh = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"asinh"
  acosh :: Expr a -> Expr a
acosh = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"acosh"
  atanh :: Expr a -> Expr a
atanh = String -> Expr a -> Expr a
forall args result.
Function args result =>
String -> args -> result
function String
"atanh"


instance Interpretation Expr where
  data Col Expr _spec where
    E :: {Col Expr ('Spec labels necessity a) -> Expr a
unE :: !(Expr a)} -> Col Expr ('Spec labels necessity a)


instance Sql DBType a => Table Expr (Expr a) where
  type Columns (Expr a) = HType a
  type Context (Expr a) = Expr

  toColumns :: Expr a -> Columns (Expr a) (Col Expr)
toColumns Expr a
a = Col Expr ('Spec '[] 'Required a) -> HType a (Col Expr)
forall (context :: Spec -> *) a.
context ('Spec '[] 'Required a) -> HType a context
HType (Expr a -> Col Expr ('Spec '[] 'Required a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E Expr a
a)
  fromColumns :: Columns (Expr a) (Col Expr) -> Expr a
fromColumns (HType (E a)) = Expr a
Expr a
a
  reify :: (Expr :~: Reify ctx) -> Unreify (Expr a) -> Expr a
reify = (Expr :~: Reify ctx) -> Unreify (Expr a) -> Expr a
forall (context :: Context) (ctx :: Context) a.
NotReify context =>
(context :~: Reify ctx) -> a
notReify
  unreify :: (Expr :~: Reify ctx) -> Expr a -> Unreify (Expr a)
unreify = (Expr :~: Reify ctx) -> Expr a -> Unreify (Expr a)
forall (context :: Context) (ctx :: Context) a.
NotReify context =>
(context :~: Reify ctx) -> a
notReify


instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)


instance Sql DBType a => Recontextualize Expr Result (Expr a) (Identity a)


instance Sql DBType a => Recontextualize Result Expr (Identity a) (Expr a)


instance Labelable Expr where
  labeler :: Col Expr ('Spec labels necessity a)
-> Col Expr ('Spec (label : labels) necessity a)
labeler (E a) = Expr a -> Col Expr ('Spec (label : labels) necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E Expr a
a
  unlabeler :: Col Expr ('Spec (label : labels) necessity a)
-> Col Expr ('Spec labels necessity a)
unlabeler (E a) = Expr a -> Col Expr ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E Expr a
a