module Database.Beam.Query.Types
( Q, QExpr, QExprToIdentity(..), TopLevelQ, IsQuery
, Projectible(..)
, Aggregation(..)
, queryToSQL'
, allExprOpts, mkSqlField, optimizeExpr, optimizeExpr' ) where
import Database.Beam.Query.Internal
import Database.Beam.Schema.Tables
import Database.Beam.Schema.Fields
import Database.Beam.SQL
import Database.HDBC
import Control.Applicative
import Control.Monad.State
import Control.Monad.Writer hiding (All)
import Control.Monad.Identity
import Data.Monoid hiding (All)
import Data.Proxy
import Data.Coerce
import Data.Data
import Data.Maybe
import Data.String
import qualified Data.Text as T
import Data.Generics.Uniplate.Data
import Unsafe.Coerce
type family QExprToIdentity x
type instance QExprToIdentity (table QExpr) = table Identity
type instance QExprToIdentity (QExpr a) = a
type instance QExprToIdentity (a, b) = (QExprToIdentity a, QExprToIdentity b)
type instance QExprToIdentity (a, b, c) = (QExprToIdentity a, QExprToIdentity b, QExprToIdentity c)
instance IsQuery Q where
toQ = id
instance IsQuery TopLevelQ where
toQ (TopLevelQ q) = q
data Aggregation a = GroupAgg (SQLExpr' QField)
| GenericAgg T.Text [SQLExpr' QField]
booleanOpts :: SQLExpr -> Maybe SQLExpr
booleanOpts (SQLBinOpE "AND" (SQLValE (SqlBool False)) _) = Just (SQLValE (SqlBool False))
booleanOpts (SQLBinOpE "AND" _ (SQLValE (SqlBool False))) = Just (SQLValE (SqlBool False))
booleanOpts (SQLBinOpE "AND" (SQLValE (SqlBool True)) q) = Just q
booleanOpts (SQLBinOpE "AND" q (SQLValE (SqlBool True))) = Just q
booleanOpts (SQLBinOpE "OR" q (SQLValE (SqlBool False))) = Just q
booleanOpts (SQLBinOpE "OR" (SQLValE (SqlBool False)) q) = Just q
booleanOpts (SQLBinOpE "OR" (SQLValE (SqlBool True)) (SQLValE (SqlBool True))) = Just (SQLValE (SqlBool True))
booleanOpts x = Nothing
allExprOpts e = pure (booleanOpts e)
optimizeExpr' :: SQLExpr' QField -> SQLExpr
optimizeExpr' = runIdentity . rewriteM allExprOpts . fmap mkSqlField
optimizeExpr :: QExpr a -> SQLExpr
optimizeExpr (QExpr e) = optimizeExpr' e
mkSqlField :: QField -> SQLFieldName
mkSqlField (QField tblName (Just tblOrd) fieldName) = SQLQualifiedFieldName fieldName ("t" <> fromString (show tblOrd))
mkSqlField (QField tblName Nothing fieldName) = SQLFieldName fieldName
queryToSQL' :: Projectible a => Q db s a -> (a, SQLSelect)
queryToSQL' q = let (res, qb) = runState (runQ q) emptyQb
emptyQb = QueryBuilder 0 Nothing (QExpr (SQLValE (SqlBool True))) Nothing Nothing [] Nothing
projection = map (\q -> SQLAliased (optimizeExpr' q) Nothing) (project res)
sel = SQLSelect
{ selProjection = SQLProj projection
, selFrom = qbFrom qb
, selWhere = optimizeExpr (qbWhere qb)
, selGrouping = qbGrouping qb
, selOrderBy = qbOrdering qb
, selLimit = qbLimit qb
, selOffset = qbOffset qb }
in (res, sel)