content: {-# language DataKinds #-}
  {-# language DerivingStrategies #-}
  {-# language FlexibleContexts #-}
  {-# language FlexibleInstances #-}
  {-# language MultiParamTypeClasses #-}
  {-# language OverloadedStrings #-}
  {-# language ScopedTypeVariables #-}
  {-# language StandaloneKindSignatures #-}
  {-# language TypeApplications #-}
  {-# language TypeFamilies #-}
  {-# language UndecidableInstances #-}
  
  module Rel8.Expr
    ( Expr(..)
    )
  where
  
  -- base
  import Data.Functor.Identity ( Identity( Identity ) )
  import Data.Ratio (denominator, numerator)
  import Data.String ( IsString, fromString )
  import Prelude hiding ( null )
  
  -- opaleye
  import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
  
  -- rel8
  import Rel8.Expr.Function (function)
  import Rel8.Expr.Null ( liftOpNull, nullify )
  import Rel8.Expr.Opaleye
    ( castExpr
    , fromPrimExpr
    , mapPrimExpr
    , zipPrimExprsWith
    )
  import Rel8.Expr.Serialize ( litExpr )
  import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
  import qualified Rel8.Schema.Kind as K
  import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
  import Rel8.Table
    ( Table, Columns, Context, fromColumns, toColumns
    , FromExprs, fromResult, toResult
    , Transpose
    )
  import Rel8.Type ( DBType )
  import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
  import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )
  import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
  
  -- scientific
  import Data.Scientific (fromRationalRepetendLimited)
  
  
  -- | Typed SQL expressions.
  type Expr :: K.Context
  newtype Expr a = Expr Opaleye.PrimExpr
    deriving stock Show
  
  
  instance Sql DBSemigroup a => Semigroup (Expr a) where
    (<>) = case nullable @a of
      Null -> liftOpNull (<>.)
      NotNull -> (<>.)
    {-# INLINABLE (<>) #-}
  
  
  instance Sql DBMonoid a => Monoid (Expr a) where
    mempty = case nullable @a of
      Null -> nullify memptyExpr
      NotNull -> memptyExpr
    {-# INLINABLE mempty #-}
  
  
  instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
    fromString = litExpr . case nullable @a of
      Null -> Just . fromString
      NotNull -> fromString
  
  
  instance Sql DBNum a => Num (Expr a) where
    (+) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
    (*) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:*))
    (-) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:-))
  
    abs = mapPrimExpr (Opaleye.UnExpr Opaleye.OpAbs)
    negate = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNegate)
  
    signum = castExpr . mapPrimExpr (Opaleye.UnExpr (Opaleye.UnOpOther "SIGN"))
  
    fromInteger = castExpr . fromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit
  
  
  instance Sql DBFractional a => Fractional (Expr a) where
    (/) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:/))
  
    fromRational = castExpr . Expr . toScientific
      where
        toScientific r = case fromRationalRepetendLimited 20 r of
          Right (s, Nothing) -> Opaleye.ConstExpr (Opaleye.NumericLit s)
          _ -> Opaleye.BinExpr (Opaleye.:/) (int n) (int d)
            where
              int = Opaleye.ConstExpr . Opaleye.NumericLit . fromInteger
              n = numerator r
              d = denominator r
  
  
  instance Sql DBFloating a => Floating (Expr a) where
    pi = function "pi" ()
    exp = function "exp"
    log = function "ln"
    sqrt = function "sqrt"
    (**) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:^))
    logBase a b = function "log" (a, b)
    sin = function "sin"
    cos = function "cos"
    tan = function "tan"
    asin = function "asin"
    acos = function "acos"
    atan = function "atan"
    sinh = function "sinh"
    cosh = function "cosh"
    tanh = function "tanh"
    asinh = function "asinh"
    acosh = function "acosh"
    atanh = function "atanh"
  
  
  instance Sql DBType a => Table Expr (Expr a) where
    type Columns (Expr a) = HIdentity a
    type Context (Expr a) = Expr
    type FromExprs (Expr a) = a
    type Transpose to (Expr a) = to a
  
    toColumns a = HIdentity a
    fromColumns (HIdentity a) = a
    toResult a = HIdentity (Identity a)
    fromResult (HIdentity (Identity a)) = a
  