{- |
   Module     : Database.SQLDeps.Engine
   Copyright  : Copyright (C) 2013 Alexander Thiemann
   License    : BSD3

   Maintainer : Alexander Thiemann <mail@agrafix.net>
   Stability  : provisional
   Portability: portable

The core engine for keeping track of computations and their dependencies. Check the Example.hs for
an example use.
-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Database.SQLDeps.Engine
(
-- * Core functions
  runEngine
, change
, query
-- * Types
, 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 ()
   }

-- | Unique identifier given by the user to a computation
type CompId = String
type QueryCollection conn = HM.HashMap Select (CompCollection conn)
type CompCollection conn = HM.HashMap String (QueryContainer conn)

-- | The engines monad, keeping track of queries, dependencies, computations
-- and the connection
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 -- computation already stored
            Nothing -> HM.insert compId qc compColl
      val = HM.fromList [(compId, qc)]

-- | Start the frameworks engine with a given HDBC-Connection
runEngine :: (IConnection conn) => conn -> DepsM conn a -> IO a
runEngine conn action =
    do (a, _) <- evalRWST action conn HM.empty
       return a

-- | Run an update/insert query on the database. All depending computations
-- will be run after the update/insert is commited.
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 ()

-- | Run a query and register it's parent computation. Important: Keep the CompId unique for
-- every unique computation, otherwise you will run into errors
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