{-# LANGUAGE GADTs, OverloadedStrings, ScopedTypeVariables, RecordWildCards #-}
{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE RankNTypes, CPP, MultiParamTypeClasses #-}
-- | SQL AST and parameters for prepared statements.
module Database.Selda.SQL where
import Data.String ( IsString(..) )
import Data.Text (Text)
import Database.Selda.Exp ( Names(..), Exp, SomeCol )
import Database.Selda.SqlType
    ( Lit, SqlType(mkLit), SqlTypeRep, litType, compLit )
import Database.Selda.Types ( TableName )

instance Semigroup QueryFragment where
  <> :: QueryFragment -> QueryFragment -> QueryFragment
(<>) = QueryFragment -> QueryFragment -> QueryFragment
RawCat

data QueryFragment where
  RawText :: !Text -> QueryFragment
  RawExp  :: !(Exp SQL a) -> QueryFragment
  RawCat  :: !QueryFragment -> !QueryFragment -> QueryFragment

instance IsString QueryFragment where
  fromString :: String -> QueryFragment
fromString = Text -> QueryFragment
RawText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

-- | A source for an SQL query.
data SqlSource
 = TableName !TableName
 | Product ![SQL]
 | Union !Bool !SQL !SQL
 | Join !JoinType !(Exp SQL Bool) !SQL !SQL
 | Values ![SomeCol SQL] ![[Param]]
 | RawSql !QueryFragment
 | EmptyTable

-- | Type of join to perform.
data JoinType = InnerJoin | LeftJoin

-- | AST for SQL queries.
data SQL = SQL
  { SQL -> [SomeCol SQL]
cols       :: ![SomeCol SQL]
  , SQL -> SqlSource
source     :: !SqlSource
  , SQL -> [Exp SQL Bool]
restricts  :: ![Exp SQL Bool]
  , SQL -> [SomeCol SQL]
groups     :: ![SomeCol SQL]
  , SQL -> [(Order, SomeCol SQL)]
ordering   :: ![(Order, SomeCol SQL)]
  , SQL -> Maybe (Int, Int)
limits     :: !(Maybe (Int, Int))
  , SQL -> [SomeCol SQL]
liveExtras :: ![SomeCol SQL] -- ^ Columns which are never considered dead.
  , SQL -> Bool
distinct   :: !Bool
  }

instance Names QueryFragment where
  allNamesIn :: QueryFragment -> [ColName]
allNamesIn (RawText Text
_)  = []
  allNamesIn (RawExp Exp SQL a
e)   = forall a. Names a => a -> [ColName]
allNamesIn Exp SQL a
e
  allNamesIn (RawCat QueryFragment
a QueryFragment
b) = forall a. Names a => a -> [ColName]
allNamesIn QueryFragment
a forall a. [a] -> [a] -> [a]
++ forall a. Names a => a -> [ColName]
allNamesIn QueryFragment
b

instance Names SqlSource where
  allNamesIn :: SqlSource -> [ColName]
allNamesIn (Product [SQL]
qs)   = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Names a => a -> [ColName]
allNamesIn [SQL]
qs
  allNamesIn (Join JoinType
_ Exp SQL Bool
e SQL
l SQL
r) = forall a. Names a => a -> [ColName]
allNamesIn Exp SQL Bool
e forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Names a => a -> [ColName]
allNamesIn [SQL
l, SQL
r]
  allNamesIn (Values [SomeCol SQL]
vs [[Param]]
_)  = forall a. Names a => a -> [ColName]
allNamesIn [SomeCol SQL]
vs
  allNamesIn (TableName TableName
_)  = []
  allNamesIn (RawSql QueryFragment
r)     = forall a. Names a => a -> [ColName]
allNamesIn QueryFragment
r
  allNamesIn (SqlSource
EmptyTable)   = []
  allNamesIn (Union Bool
_ SQL
l SQL
r)  = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Names a => a -> [ColName]
allNamesIn [SQL
l, SQL
r]

instance Names SQL where
  -- Note that we don't include @cols@ here: the names in @cols@ are not
  -- necessarily used, only declared.
  allNamesIn :: SQL -> [ColName]
allNamesIn (SQL{Bool
[(Order, SomeCol SQL)]
[Exp SQL Bool]
[SomeCol SQL]
Maybe (Int, Int)
SqlSource
distinct :: Bool
liveExtras :: [SomeCol SQL]
limits :: Maybe (Int, Int)
ordering :: [(Order, SomeCol SQL)]
groups :: [SomeCol SQL]
restricts :: [Exp SQL Bool]
source :: SqlSource
cols :: [SomeCol SQL]
distinct :: SQL -> Bool
liveExtras :: SQL -> [SomeCol SQL]
limits :: SQL -> Maybe (Int, Int)
ordering :: SQL -> [(Order, SomeCol SQL)]
groups :: SQL -> [SomeCol SQL]
restricts :: SQL -> [Exp SQL Bool]
source :: SQL -> SqlSource
cols :: SQL -> [SomeCol SQL]
..}) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall a. Names a => a -> [ColName]
allNamesIn [SomeCol SQL]
groups
    , forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Names a => a -> [ColName]
allNamesIn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Order, SomeCol SQL)]
ordering
    , forall a. Names a => a -> [ColName]
allNamesIn [Exp SQL Bool]
restricts
    , forall a. Names a => a -> [ColName]
allNamesIn SqlSource
source
    ]

-- | Build a plain SQL query with the given columns and source, with no filters,
--   ordering, etc.
sqlFrom :: [SomeCol SQL] -> SqlSource -> SQL
sqlFrom :: [SomeCol SQL] -> SqlSource -> SQL
sqlFrom [SomeCol SQL]
cs SqlSource
src = SQL
  { cols :: [SomeCol SQL]
cols = [SomeCol SQL]
cs
  , source :: SqlSource
source = SqlSource
src
  , restricts :: [Exp SQL Bool]
restricts = []
  , groups :: [SomeCol SQL]
groups = []
  , ordering :: [(Order, SomeCol SQL)]
ordering = []
  , limits :: Maybe (Int, Int)
limits = forall a. Maybe a
Nothing
  , liveExtras :: [SomeCol SQL]
liveExtras = []
  , distinct :: Bool
distinct = Bool
False
  }

-- | The order in which to sort result rows.
data Order = Asc | Desc
  deriving (Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> String
$cshow :: Order -> String
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show, Eq Order
Order -> Order -> Bool
Order -> Order -> Ordering
Order -> Order -> Order
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Order -> Order -> Order
$cmin :: Order -> Order -> Order
max :: Order -> Order -> Order
$cmax :: Order -> Order -> Order
>= :: Order -> Order -> Bool
$c>= :: Order -> Order -> Bool
> :: Order -> Order -> Bool
$c> :: Order -> Order -> Bool
<= :: Order -> Order -> Bool
$c<= :: Order -> Order -> Bool
< :: Order -> Order -> Bool
$c< :: Order -> Order -> Bool
compare :: Order -> Order -> Ordering
$ccompare :: Order -> Order -> Ordering
Ord, Order -> Order -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq)

-- | A parameter to a prepared SQL statement.
data Param where
  Param :: !(Lit a) -> Param

instance Show Param where
  show :: Param -> String
show (Param Lit a
l) = String
"Param " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Lit a
l

instance Eq Param where
  Param Lit a
a == :: Param -> Param -> Bool
== Param Lit a
b = forall a b. Lit a -> Lit b -> Ordering
compLit Lit a
a Lit a
b forall a. Eq a => a -> a -> Bool
== Ordering
EQ
instance Ord Param where
  compare :: Param -> Param -> Ordering
compare (Param Lit a
a) (Param Lit a
b) = forall a b. Lit a -> Lit b -> Ordering
compLit Lit a
a Lit a
b

-- | Create a parameter from the given value.
param :: SqlType a => a -> Param
param :: forall a. SqlType a => a -> Param
param = forall a. Lit a -> Param
Param forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SqlType a => a -> Lit a
mkLit

-- | The SQL type of the given parameter.
paramType :: Param -> SqlTypeRep
paramType :: Param -> SqlTypeRep
paramType (Param Lit a
p) = forall a. Lit a -> SqlTypeRep
litType Lit a
p