GraphBuilder.hs

{-# LANGUAGE GADTs #-}
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

-- | Graphs are constructed in a monadic environment.
-- | The graph constructed has to be a DAG.
-- | The reader monad provides access to the variable environment Gamma and the loop table
-- | The variable environment is a mapping from variable names to graphnodes that represent
-- | their compiled form.
-- | The state monad gives access to a supply of fresh variables, and maintains a map from
-- | nodes to node ids. When a node is inserted and an equal node (equal means, equal node 
-- | and equal child nodes) already exists in the map the node id for that already existing
-- | node is returned. This allows maximal sharing.
type GraphM = ReaderT (Gam, AlgNode) (State (Int, M.Map Algebra AlgNode))

-- | Variable environemtn mapping from variables to compiled nodes.
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
-- | An algebraic solution is a triple consisting of the node id, a description of the database columns and all subplans
type AlgRes = (AlgNode, Columns, SubPlan)

-- | An algebraic plan is the result of constructing a graph.
-- | The pair consists of the mapping from nodes to their respective ids
-- | and the algres from the top node.
type AlgPlan = (M.Map Algebra AlgNode, AlgRes)

-- | Evaluate the monadic graph into an algebraic plan, given a loop relation.
runGraph :: Algebra -> GraphM AlgRes -> AlgPlan
runGraph l = (\(r, (_,m)) -> (m, r) ) . flip runState (2, M.singleton l 1) . flip runReaderT ([], 1)

-- | Get the current loop table
getLoop :: GraphM AlgNode
getLoop = do 
            (_, l) <- ask
            return l

-- | Get the current variable environment            
getGamma :: GraphM Gam
getGamma = do
            (g, _) <- ask
            return g

-- | Get a fresh node id
getFreshId :: GraphM Int
getFreshId = do
                (n, t) <- get
                put $ (n + 1, t)
                return n

-- | Check if a node already exists in the graph construction environment, if so return its id.
findNode :: Algebra -> GraphM (Maybe AlgNode)
findNode n = do
              (_, t) <- get
              return $ M.lookup n t

-- | Insert a node into the graph construction environment, first check if the node already exists
-- | if so return its id, otherwise insert it and return its id.              
insertNode :: Algebra -> GraphM AlgNode
insertNode n = do
                            v <- findNode n             
                            case v of
                                (Just n') -> return n'
                                Nothing -> insertNode' n

-- | Blindly insert a node, get a fresh id and return that                                 
insertNode' :: Algebra  -> GraphM AlgNode
insertNode' n = do 
                              i <- getFreshId 
                              (sup, t) <- get
                              let t' = M.insert n i t
                              put $ (sup, t')
                              return i

-- | Evaluate the graph construction computation with the current environment extended with a binding n to v.
withBinding :: String -> AlgRes -> GraphM a -> GraphM a
withBinding n v a = do
                     local (\(g, alg) -> ((n, v):g, alg)) a

-- | Evaluate the graph construction computation with a differnt gamma, 
-- | and loop table. Return within he current computational context.                     
withContext :: Gam -> AlgNode -> GraphM a -> GraphM a
withContext gam loop = local (\_ -> (gam, loop))

-- | Lookup a variable in the environment                     
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!"