module Database.Ferry.Algebra.Data.GraphBuilder where
import Database.Ferry.Algebra.Data.Algebra
import qualified Data.Map as M
import Control.Monad.State
import Control.Monad.Reader
type GraphM = ReaderT (Gam, AlgNode) (State (Int, M.Map Algebra AlgNode))
type Gam = [(String, AlgRes)]
newtype SubPlan = SubPlan (M.Map Int AlgRes)
instance Show SubPlan where
show (SubPlan p) = "SubPlans " ++ (show $ map (\(_,y,z) -> show (y, z)) $ M.elems p)
emptyPlan :: SubPlan
emptyPlan = SubPlan M.empty
subPlan :: Int -> AlgRes -> SubPlan
subPlan i p = SubPlan $ M.singleton i p
getPlan :: Int -> SubPlan -> AlgRes
getPlan i (SubPlan p) = p M.! i
type AlgRes = (AlgNode, Columns, SubPlan)
type AlgPlan = (M.Map Algebra AlgNode, AlgRes)
runGraph :: Algebra -> GraphM AlgRes -> AlgPlan
runGraph l = (\(r, (_,m)) -> (m, r) ) . flip runState (2, M.singleton l 1) . flip runReaderT ([], 1)
getLoop :: GraphM AlgNode
getLoop = do
(_, l) <- ask
return l
getGamma :: GraphM Gam
getGamma = do
(g, _) <- ask
return g
getFreshId :: GraphM Int
getFreshId = do
(n, t) <- get
put $ (n + 1, t)
return n
findNode :: Algebra -> GraphM (Maybe AlgNode)
findNode n = do
(_, t) <- get
return $ M.lookup n t
insertNode :: Algebra -> GraphM AlgNode
insertNode n = do
v <- findNode n
case v of
(Just n') -> return n'
Nothing -> insertNode' n
insertNode' :: Algebra -> GraphM AlgNode
insertNode' n = do
i <- getFreshId
(sup, t) <- get
let t' = M.insert n i t
put $ (sup, t')
return i
withBinding :: String -> AlgRes -> GraphM a -> GraphM a
withBinding n v a = do
local (\(g, alg) -> ((n, v):g, alg)) a
withContext :: Gam -> AlgNode -> GraphM a -> GraphM a
withContext gam loop = local (\_ -> (gam, loop))
fromGam :: String -> GraphM AlgRes
fromGam n = do
(m, _) <- ask
case lookup n m of
Just r -> return r
Nothing -> error $ "Variable: " ++ n ++ " could not be found, should not be possible!"