{-# LANGUAGE ConstraintKinds #-}

module Opaleye.Internal.Column where

import Data.String

import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ

-- | A column of a @Query@, of type @pgType@.  For example 'Column'
-- @SqlInt4@ is an @int4@ column and a 'Column' @SqlText@ is a @text@
-- column.
--
-- The name @Column@ will be replaced by @Field@ in version 0.8.
-- There already exists a @Field@ type family to help smooth the
-- transition.  We recommend that you use @Field_@, @Field@ or
-- @FieldNullable@ instead of @Column@ everywhere that it is
-- sufficient.
newtype Column pgType = Column HPQ.PrimExpr

-- | Only used within a 'Column', to indicate that it can be @NULL@.
-- For example, a 'Column' ('Nullable' @SqlText@) can be @NULL@ but a
-- 'Column' @SqlText@ cannot.
data Nullable a = Nullable

unColumn :: Column a -> HPQ.PrimExpr
unColumn :: Column a -> PrimExpr
unColumn (Column PrimExpr
e) = PrimExpr
e

-- | Treat a 'Column' as though it were of a different type.  If such
-- a treatment is not valid then Postgres may fail with an error at
-- SQL run time.
unsafeCoerceColumn :: Column a -> Column b
unsafeCoerceColumn :: Column a -> Column b
unsafeCoerceColumn (Column PrimExpr
e) = PrimExpr -> Column b
forall pgType. PrimExpr -> Column pgType
Column PrimExpr
e

-- | Cast a column to any other type. Implements Postgres's @::@ or
-- @CAST( ... AS ... )@ operations.  This is safe for some
-- conversions, such as uuid to text.
unsafeCast :: String -> Column a -> Column b
unsafeCast :: String -> Column a -> Column b
unsafeCast = (PrimExpr -> PrimExpr) -> Column a -> Column b
forall c a. (PrimExpr -> PrimExpr) -> Column c -> Column a
mapColumn ((PrimExpr -> PrimExpr) -> Column a -> Column b)
-> (String -> PrimExpr -> PrimExpr)
-> String
-> Column a
-> Column b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PrimExpr -> PrimExpr
HPQ.CastExpr
  where
    mapColumn :: (HPQ.PrimExpr -> HPQ.PrimExpr) -> Column c -> Column a
    mapColumn :: (PrimExpr -> PrimExpr) -> Column c -> Column a
mapColumn PrimExpr -> PrimExpr
primExpr Column c
c = PrimExpr -> Column a
forall pgType. PrimExpr -> Column pgType
Column (PrimExpr -> PrimExpr
primExpr (Column c -> PrimExpr
forall a. Column a -> PrimExpr
unColumn Column c
c))

unsafeCompositeField :: Column a -> String -> Column b
unsafeCompositeField :: Column a -> String -> Column b
unsafeCompositeField (Column PrimExpr
e) String
fieldName =
  PrimExpr -> Column b
forall pgType. PrimExpr -> Column pgType
Column (PrimExpr -> String -> PrimExpr
HPQ.CompositeExpr PrimExpr
e String
fieldName)

binOp :: HPQ.BinOp -> Column a -> Column b -> Column c
binOp :: BinOp -> Column a -> Column b -> Column c
binOp BinOp
op (Column PrimExpr
e) (Column PrimExpr
e') = PrimExpr -> Column c
forall pgType. PrimExpr -> Column pgType
Column (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
HPQ.BinExpr BinOp
op PrimExpr
e PrimExpr
e')

unOp :: HPQ.UnOp -> Column a -> Column b
unOp :: UnOp -> Column a -> Column b
unOp UnOp
op (Column PrimExpr
e) = PrimExpr -> Column b
forall pgType. PrimExpr -> Column pgType
Column (UnOp -> PrimExpr -> PrimExpr
HPQ.UnExpr UnOp
op PrimExpr
e)

-- For import order reasons we can't make the return type SqlBool
unsafeCase_ :: [(Column pgBool, Column a)] -> Column a -> Column a
unsafeCase_ :: [(Column pgBool, Column a)] -> Column a -> Column a
unsafeCase_ [(Column pgBool, Column a)]
alts (Column PrimExpr
otherwise_) = PrimExpr -> Column a
forall pgType. PrimExpr -> Column pgType
Column ([(PrimExpr, PrimExpr)] -> PrimExpr -> PrimExpr
HPQ.CaseExpr ([(Column pgBool, Column a)] -> [(PrimExpr, PrimExpr)]
forall pgType pgType.
[(Column pgType, Column pgType)] -> [(PrimExpr, PrimExpr)]
unColumns [(Column pgBool, Column a)]
alts) PrimExpr
otherwise_)
  where unColumns :: [(Column pgType, Column pgType)] -> [(PrimExpr, PrimExpr)]
unColumns = ((Column pgType, Column pgType) -> (PrimExpr, PrimExpr))
-> [(Column pgType, Column pgType)] -> [(PrimExpr, PrimExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Column PrimExpr
e, Column PrimExpr
e') -> (PrimExpr
e, PrimExpr
e'))

unsafeIfThenElse :: Column pgBool -> Column a -> Column a -> Column a
unsafeIfThenElse :: Column pgBool -> Column a -> Column a -> Column a
unsafeIfThenElse Column pgBool
cond Column a
t Column a
f = [(Column pgBool, Column a)] -> Column a -> Column a
forall pgBool a.
[(Column pgBool, Column a)] -> Column a -> Column a
unsafeCase_ [(Column pgBool
cond, Column a
t)] Column a
f

unsafeGt :: Column a -> Column a -> Column pgBool
unsafeGt :: Column a -> Column a -> Column pgBool
unsafeGt = BinOp -> Column a -> Column a -> Column pgBool
forall a b c. BinOp -> Column a -> Column b -> Column c
binOp BinOp
(HPQ.:>)

unsafeEq :: Column a -> Column a -> Column pgBool
unsafeEq :: Column a -> Column a -> Column pgBool
unsafeEq = BinOp -> Column a -> Column a -> Column pgBool
forall a b c. BinOp -> Column a -> Column b -> Column c
binOp BinOp
(HPQ.:==)

class SqlNum a where
  pgFromInteger :: Integer -> Column a
  pgFromInteger = Integer -> Column a
forall a. SqlNum a => Integer -> Column a
sqlFromInteger

  sqlFromInteger :: Integer -> Column a

type PGNum = SqlNum

instance SqlNum a => Num (Column a) where
  fromInteger :: Integer -> Column a
fromInteger = Integer -> Column a
forall a. SqlNum a => Integer -> Column a
pgFromInteger
  * :: Column a -> Column a -> Column a
(*) = BinOp -> Column a -> Column a -> Column a
forall a b c. BinOp -> Column a -> Column b -> Column c
binOp BinOp
(HPQ.:*)
  + :: Column a -> Column a -> Column a
(+) = BinOp -> Column a -> Column a -> Column a
forall a b c. BinOp -> Column a -> Column b -> Column c
binOp BinOp
(HPQ.:+)
  (-) = BinOp -> Column a -> Column a -> Column a
forall a b c. BinOp -> Column a -> Column b -> Column c
binOp BinOp
(HPQ.:-)

  abs :: Column a -> Column a
abs = UnOp -> Column a -> Column a
forall a b. UnOp -> Column a -> Column b
unOp UnOp
HPQ.OpAbs
  negate :: Column a -> Column a
negate = UnOp -> Column a -> Column a
forall a b. UnOp -> Column a -> Column b
unOp UnOp
HPQ.OpNegate

  -- We can't use Postgres's 'sign' function because it returns only a
  -- numeric or a double
  signum :: Column a -> Column a
signum Column a
c = [(Column Any, Column a)] -> Column a -> Column a
forall pgBool a.
[(Column pgBool, Column a)] -> Column a -> Column a
unsafeCase_ [(Column a
c Column a -> Column a -> Column Any
forall a pgBool. Column a -> Column a -> Column pgBool
`unsafeGt` Column a
0, Column a
1), (Column a
c Column a -> Column a -> Column Any
forall a pgBool. Column a -> Column a -> Column pgBool
`unsafeEq` Column a
0, Column a
0)] (-Column a
1)

class SqlFractional a where
  pgFromRational :: Rational -> Column a
  pgFromRational = Rational -> Column a
forall a. SqlFractional a => Rational -> Column a
sqlFromRational

  sqlFromRational :: Rational -> Column a

type PGFractional = SqlFractional

instance (SqlNum a, SqlFractional a) => Fractional (Column a) where
  fromRational :: Rational -> Column a
fromRational = Rational -> Column a
forall a. SqlFractional a => Rational -> Column a
sqlFromRational
  / :: Column a -> Column a -> Column a
(/) = BinOp -> Column a -> Column a -> Column a
forall a b c. BinOp -> Column a -> Column b -> Column c
binOp BinOp
(HPQ.:/)

-- | A dummy typeclass whose instances support integral operations.
class SqlIntegral a

type PGIntegral = SqlIntegral

class SqlString a where
    pgFromString :: String -> Column a
    pgFromString = String -> Column a
forall a. SqlString a => String -> Column a
sqlFromString

    sqlFromString :: String -> Column a

type PGString = SqlString

instance SqlString a => IsString (Column a) where
  fromString :: String -> Column a
fromString = String -> Column a
forall a. SqlString a => String -> Column a
sqlFromString