module Database.SQLDeps.Engine
(
runEngine
, change
, query
, CompId
, DepsM
)
where
import Database.SQLDeps.Types
import Database.SQLDeps.Diff
import Database.SQLDeps.QueryWriter
import Database.HDBC
import Control.Monad.RWS
import qualified Data.HashMap.Strict as HM
data QueryContainer conn
= QueryContainer
{ _qc_stmt :: Select
, _qc_compId :: CompId
, _qc_comp :: DepsM conn ()
}
type CompId = String
type QueryCollection conn = HM.HashMap Select (CompCollection conn)
type CompCollection conn = HM.HashMap String (QueryContainer conn)
type DepsM conn a = RWST conn () (QueryCollection conn) IO a
storeQC :: (IConnection conn) => QueryContainer conn -> DepsM conn ()
storeQC qc@(QueryContainer stmt compId _) =
do coll <- get
let new = HM.insertWith update stmt val coll
put new
where
update _ compColl =
case HM.lookup compId compColl of
Just _ -> compColl
Nothing -> HM.insert compId qc compColl
val = HM.fromList [(compId, qc)]
runEngine :: (IConnection conn) => conn -> DepsM conn a -> IO a
runEngine conn action =
do (a, _) <- evalRWST action conn HM.empty
return a
change :: forall conn. (IConnection conn) => Upsert -> DepsM conn ()
change upsert =
do conn <- ask
let (q, vals) = preparedStmt upsert
liftIO $ do _ <- run conn q vals
commit conn
selects <- gets HM.keys
let aff = affectedSelects upsert selects
mapM_ executeAllComps aff
return ()
where
executeAllComps :: Select -> DepsM conn ()
executeAllComps s =
do Just kvComps <- gets (HM.lookup s)
let comps = HM.toList kvComps
mapM_ (\(_, QueryContainer _ _ comp) ->
comp
) comps
return ()
query :: (IConnection conn) => Select -> CompId -> (DepsM conn ()) -> DepsM conn ([[SqlValue]])
query stmt compId comp =
do conn <- ask
let (q, vals) = preparedStmt stmt
res <- liftIO $ quickQuery' conn q vals
storeQC (QueryContainer stmt compId comp)
return res