{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, PolyKinds #-}
{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE DataKinds, UndecidableInstances, MultiParamTypeClasses #-}
-- | Columns and associated utility functions, specialized to 'SQL'.
module Database.Selda.Column
  ( Columns, Same
  , Row (..), Col (..), SomeCol (..), UntypedCol (..)
  , Exp (..), NulOp (..), UnOp (..), BinOp (..)
  , toTup, fromTup, liftC, liftC2, liftC3
  , allNamesIn
  , hideRenaming
  , literal
  ) where
import Database.Selda.Exp
    ( Names(allNamesIn),
      BinOp(..),
      UnOp(..),
      NulOp(..),
      Exp(..),
      UntypedCol(..),
      SomeCol(..),
      hideRenaming )
import Database.Selda.SQL ( SQL )
import Database.Selda.SqlType ( SqlType(mkLit) )
import Database.Selda.SqlRow ( SqlRow(nestedCols) )
import Database.Selda.Types ( type (:*:)(..), ColName )
import Data.Proxy ( Proxy(..) )
import Data.String ( IsString(..) )
import Data.Text (Text)
import GHC.TypeLits as TL ( TypeError, ErrorMessage(Text) )

-- | Any column tuple.
class Columns a where
  toTup :: [ColName] -> a
  fromTup :: a -> [UntypedCol SQL]

instance (SqlType a, Columns b) => Columns (Col s a :*: b) where
  toTup :: [ColName] -> Col s a :*: b
toTup (ColName
x:[ColName]
xs) = forall {k} (s :: k) a. Exp SQL a -> Col s a
One (forall sql a. ColName -> Exp sql a
Col ColName
x) forall a b. a -> b -> a :*: b
:*: forall a. Columns a => [ColName] -> a
toTup [ColName]
xs
  toTup []     = forall a. HasCallStack => [Char] -> a
error [Char]
"too few elements to toTup"
  fromTup :: (Col s a :*: b) -> [UntypedCol SQL]
fromTup (One Exp SQL a
x :*: b
xs) = forall sql a. Exp sql a -> UntypedCol sql
Untyped Exp SQL a
x forall a. a -> [a] -> [a]
: forall a. Columns a => a -> [UntypedCol SQL]
fromTup b
xs

instance (SqlRow a, Columns b) => Columns (Row s a :*: b) where
  toTup :: [ColName] -> Row s a :*: b
toTup [ColName]
xs =
    case forall a. SqlRow a => Proxy a -> Int
nestedCols (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) of
      Int
n -> forall {k} {k} (s :: k) (a :: k). [UntypedCol SQL] -> Row s a
Many (forall a b. (a -> b) -> [a] -> [b]
map (forall sql a. Exp sql a -> UntypedCol sql
Untyped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql a. ColName -> Exp sql a
Col) (forall a. Int -> [a] -> [a]
take Int
n [ColName]
xs)) forall a b. a -> b -> a :*: b
:*: forall a. Columns a => [ColName] -> a
toTup (forall a. Int -> [a] -> [a]
drop Int
n [ColName]
xs)
  fromTup :: (Row s a :*: b) -> [UntypedCol SQL]
fromTup (Many [UntypedCol SQL]
xs :*: b
xss) = [UntypedCol SQL]
xs forall a. [a] -> [a] -> [a]
++ forall a. Columns a => a -> [UntypedCol SQL]
fromTup b
xss

instance Columns (Col s a) where
  toTup :: [ColName] -> Col s a
toTup [ColName
x] = forall {k} (s :: k) a. Exp SQL a -> Col s a
One (forall sql a. ColName -> Exp sql a
Col ColName
x)
  toTup []  = forall a. HasCallStack => [Char] -> a
error [Char]
"too few elements to toTup"
  toTup [ColName]
_   = forall a. HasCallStack => [Char] -> a
error [Char]
"too many elements to toTup"
  fromTup :: Col s a -> [UntypedCol SQL]
fromTup (One Exp SQL a
x) = [forall sql a. Exp sql a -> UntypedCol sql
Untyped Exp SQL a
x]

instance Columns (Row s a) where
  toTup :: [ColName] -> Row s a
toTup [ColName]
xs = forall {k} {k} (s :: k) (a :: k). [UntypedCol SQL] -> Row s a
Many (forall a b. (a -> b) -> [a] -> [b]
map (forall sql a. Exp sql a -> UntypedCol sql
Untyped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql a. ColName -> Exp sql a
Col) [ColName]
xs)
  fromTup :: Row s a -> [UntypedCol SQL]
fromTup (Many [UntypedCol SQL]
xs) = [UntypedCol SQL]
xs

-- | A database column. A column is often a literal column table, but can also
--   be an expression over such a column or a constant expression.
newtype Col s a = One (Exp SQL a)

-- | A database row. A row is a collection of one or more columns.
newtype Row s a = Many [UntypedCol SQL]

-- | A literal expression.
literal :: SqlType a => a -> Col s a
literal :: forall {k} a (s :: k). SqlType a => a -> Col s a
literal = forall {k} (s :: k) a. Exp SQL a -> Col s a
One forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a sql. Lit a -> Exp sql a
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SqlType a => a -> Lit a
mkLit

instance IsString (Col s Text) where
  fromString :: [Char] -> Col s Text
fromString = forall {k} a (s :: k). SqlType a => a -> Col s a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => [Char] -> a
fromString

liftC3 :: (Exp SQL a -> Exp SQL b -> Exp SQL c -> Exp SQL d)
       -> Col s a
       -> Col s b
       -> Col s c
       -> Col s d
liftC3 :: forall {k} a b c d (s :: k).
(Exp SQL a -> Exp SQL b -> Exp SQL c -> Exp SQL d)
-> Col s a -> Col s b -> Col s c -> Col s d
liftC3 Exp SQL a -> Exp SQL b -> Exp SQL c -> Exp SQL d
f (One Exp SQL a
a) (One Exp SQL b
b) (One Exp SQL c
c) = forall {k} (s :: k) a. Exp SQL a -> Col s a
One (Exp SQL a -> Exp SQL b -> Exp SQL c -> Exp SQL d
f Exp SQL a
a Exp SQL b
b Exp SQL c
c)

-- | Denotes that scopes @s@ and @t@ are identical.
class s ~ t => Same s t where
  liftC2 :: (Exp SQL a -> Exp SQL b -> Exp SQL c) -> Col s a -> Col t b -> Col s c
  liftC2 Exp SQL a -> Exp SQL b -> Exp SQL c
f (One Exp SQL a
a) (One Exp SQL b
b) = forall {k} (s :: k) a. Exp SQL a -> Col s a
One (Exp SQL a -> Exp SQL b -> Exp SQL c
f Exp SQL a
a Exp SQL b
b)

instance {-# OVERLAPPING #-} Same s s
instance {-# OVERLAPPABLE #-} (s ~ t, TypeError
  ('TL.Text "An identifier from an outer scope may not be used in an inner query."))
  => Same s t

liftC :: (Exp SQL a -> Exp SQL b) -> Col s a -> Col s b
liftC :: forall {k} a b (s :: k).
(Exp SQL a -> Exp SQL b) -> Col s a -> Col s b
liftC Exp SQL a -> Exp SQL b
f (One Exp SQL a
x) = forall {k} (s :: k) a. Exp SQL a -> Col s a
One (Exp SQL a -> Exp SQL b
f Exp SQL a
x)

instance (SqlType a, Num a) => Num (Col s a) where
  fromInteger :: Integer -> Col s a
fromInteger = forall {k} a (s :: k). SqlType a => a -> Col s a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
  + :: Col s a -> Col s a -> Col s a
(+) = forall {k} (s :: k) (t :: k) a b c.
Same s t =>
(Exp SQL a -> Exp SQL b -> Exp SQL c)
-> Col s a -> Col t b -> Col s c
liftC2 forall a b. (a -> b) -> a -> b
$ forall a b c sql.
BinOp a b c -> Exp sql a -> Exp sql b -> Exp sql c
BinOp forall a. BinOp a a a
Add
  (-) = forall {k} (s :: k) (t :: k) a b c.
Same s t =>
(Exp SQL a -> Exp SQL b -> Exp SQL c)
-> Col s a -> Col t b -> Col s c
liftC2 forall a b. (a -> b) -> a -> b
$ forall a b c sql.
BinOp a b c -> Exp sql a -> Exp sql b -> Exp sql c
BinOp forall a. BinOp a a a
Sub
  * :: Col s a -> Col s a -> Col s a
(*) = forall {k} (s :: k) (t :: k) a b c.
Same s t =>
(Exp SQL a -> Exp SQL b -> Exp SQL c)
-> Col s a -> Col t b -> Col s c
liftC2 forall a b. (a -> b) -> a -> b
$ forall a b c sql.
BinOp a b c -> Exp sql a -> Exp sql b -> Exp sql c
BinOp forall a. BinOp a a a
Mul
  negate :: Col s a -> Col s a
negate = forall {k} a b (s :: k).
(Exp SQL a -> Exp SQL b) -> Col s a -> Col s b
liftC forall a b. (a -> b) -> a -> b
$ forall a b sql. UnOp a b -> Exp sql a -> Exp sql b
UnOp forall a. UnOp a a
Neg
  abs :: Col s a -> Col s a
abs = forall {k} a b (s :: k).
(Exp SQL a -> Exp SQL b) -> Col s a -> Col s b
liftC forall a b. (a -> b) -> a -> b
$ forall a b sql. UnOp a b -> Exp sql a -> Exp sql b
UnOp forall a. UnOp a a
Abs
  signum :: Col s a -> Col s a
signum = forall {k} a b (s :: k).
(Exp SQL a -> Exp SQL b) -> Col s a -> Col s b
liftC forall a b. (a -> b) -> a -> b
$ forall a b sql. UnOp a b -> Exp sql a -> Exp sql b
UnOp forall a. UnOp a a
Sgn

instance Fractional (Col s Double) where
  fromRational :: Rational -> Col s Double
fromRational = forall {k} a (s :: k). SqlType a => a -> Col s a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
  / :: Col s Double -> Col s Double -> Col s Double
(/) = forall {k} (s :: k) (t :: k) a b c.
Same s t =>
(Exp SQL a -> Exp SQL b -> Exp SQL c)
-> Col s a -> Col t b -> Col s c
liftC2 forall a b. (a -> b) -> a -> b
$ forall a b c sql.
BinOp a b c -> Exp sql a -> Exp sql b -> Exp sql c
BinOp forall a. BinOp a a a
Div

instance Fractional (Col s Int) where
  fromRational :: Rational -> Col s Int
fromRational = forall {k} a (s :: k). SqlType a => a -> Col s a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
truncate :: Double -> Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
  / :: Col s Int -> Col s Int -> Col s Int
(/) = forall {k} (s :: k) (t :: k) a b c.
Same s t =>
(Exp SQL a -> Exp SQL b -> Exp SQL c)
-> Col s a -> Col t b -> Col s c
liftC2 forall a b. (a -> b) -> a -> b
$ forall a b c sql.
BinOp a b c -> Exp sql a -> Exp sql b -> Exp sql c
BinOp forall a. BinOp a a a
Div