{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, PolyKinds #-}
{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE DataKinds, UndecidableInstances, MultiParamTypeClasses #-}
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) )
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
newtype Col s a = One (Exp SQL a)
newtype Row s a = Many [UntypedCol SQL]
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)
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