module Database.Beam.Query.Internal where
import Database.Beam.SQL.Types
import Database.Beam.Schema
import qualified Data.Text as T
import Data.Typeable
import Data.Coerce
import Control.Applicative
import Control.Monad.State
import Control.Monad.Writer hiding (All)
import Control.Monad.Identity
import Database.HDBC
class IsQuery q where
toQ :: q db s a -> Q db s a
newtype Q (db :: (((* -> *) -> *) -> *) -> *) s a = Q { runQ :: State QueryBuilder a}
deriving (Monad, Applicative, Functor, MonadFix, MonadState QueryBuilder)
newtype TopLevelQ db s a = TopLevelQ (Q db s a)
data QueryBuilder = QueryBuilder
{ qbNextTblRef :: Int
, qbFrom :: Maybe SQLFrom
, qbWhere :: QExpr Bool
, qbLimit :: Maybe Integer
, qbOffset :: Maybe Integer
, qbOrdering :: [SQLOrdering]
, qbGrouping :: Maybe SQLGrouping }
data QField = QField
{ qFieldTblName :: T.Text
, qFieldTblOrd :: Maybe Int
, qFieldName :: T.Text }
deriving (Show, Eq, Ord)
newtype QExpr t = QExpr (SQLExpr' QField)
deriving (Show, Eq)
class Projectible a where
project :: a -> [SQLExpr' QField]
instance Typeable a => Projectible (QExpr a) where
project (QExpr x) = [x]
instance (Projectible a, Projectible b) => Projectible (a, b) where
project (a, b) = project a ++ project b
instance ( Projectible a
, Projectible b
, Projectible c ) => Projectible (a, b, c) where
project (a, b, c) = project a ++ project b ++ project c
instance ( Projectible a
, Projectible b
, Projectible c
, Projectible d ) => Projectible (a, b, c, d) where
project (a, b, c, d) = project a ++ project b ++ project c ++ project d
instance ( Projectible a
, Projectible b
, Projectible c
, Projectible d
, Projectible e ) => Projectible (a, b, c, d, e) where
project (a, b, c, d, e) = project a ++ project b ++ project c ++ project d ++ project e
instance Table t => Projectible (t QExpr) where
project t = fieldAllValues (\(Columnar' (QExpr e)) -> e) t
tableVal :: Table tbl => tbl Identity -> tbl QExpr
tableVal = changeRep valToQExpr . makeSqlValues
where valToQExpr :: Columnar' SqlValue' a -> Columnar' QExpr a
valToQExpr (Columnar' (SqlValue' v)) = Columnar' (QExpr (SQLValE v))