TableAlgebra 0.1.5 → 0.6.1

raw patch · 8 files changed

+214/−138 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• TableAlgebra.cabal +3/−2
• src/Database/Ferry/Algebra.hs +6/−7
• src/Database/Ferry/Algebra/Data/Algebra.hs +3/−1
• src/Database/Ferry/Algebra/Data/Create.hs +26/−22
• src/Database/Ferry/Algebra/Data/GraphBuilder.hs +31/−35
• src/Database/Ferry/Algebra/Monadic/Create.hs +98/−0
• src/Database/Ferry/Algebra/Render/XML.hs +32/−67
• src/Database/Ferry/Algebra/Render/XMLUtils.hs +15/−4

@@ -2,7 +2,7 @@ Name:           TableAlgebra synopsis:       Ferry Table Algebra Category:       Database-Version:        0.1.5+Version:        0.6.1 Description:    The Ferry 2.0 Table Algebra library                 .                 The table algebra [2] is an intermediate language used by Ferry 2.0 [3] and DSH [4].@@ -30,12 +30,13 @@     buildable:        True     build-depends:    base >= 4.2 && < 5,  HaXml >= 1.20.2, mtl >= 2.0.1.0, containers >= 0.3.0.0, haskell98 >= 1.0.1.1, template-haskell >= 2.4.0.0, pretty >= 1.0.1.1     exposed-modules:  Database.Ferry.Algebra+                      Database.Ferry.Algebra.Render.XML     hs-source-dirs:   src     GHC-Options:       -Wall -fno-warn-orphans -fno-warn-type-defaults -fno-warn-unused-do-bind      other-modules:         Database.Ferry.Algebra.Data.Algebra          Database.Ferry.Algebra.Data.Create          Database.Ferry.Algebra.Data.GraphBuilder -        Database.Ferry.Algebra.Render.XML          Database.Ferry.Algebra.Render.XMLUtils+        Database.Ferry.Algebra.Monadic.Create         Database.Ferry.Impossible 

@@ -9,20 +9,19 @@  module Database.Ferry.Algebra (     AlgPlan,-    transform,-    union, emptyPlan, attach, proj, getLoop, subPlan, rownum, rownum', eqJoin, rank, eqTJoin, distinct, rowrank, cast, difference, aggr,-    select, posSelect, dbTable, notC, cross, oper, emptyTable,-    withBinding, withContext, getGamma, getPlan, fromGam, +    union, attach, proj, getLoop, rownum, rownum', eqJoin, rank, eqTJoin, distinct, rowrank, cast, difference, aggr,+    select, posSelect, dbTable, notC, cross, oper, emptyTable, tag, litTable,+    withBinding, withContext, getGamma, fromGam,      nat, int, bool, double, string,     natT, intT, surT, boolT, doubleT, stringT,     SortDir(..), AggrType(..),-    SubPlan(..), AlgRes,     Column(..), Columns,      ATy(..),     SchemaInfos, KeyInfos, AlgNode, GraphM, Gam,-    initLoop, runGraph)where+    initLoop, runGraph, ProjPair, ProjInf,+    module Database.Ferry.Algebra.Monadic.Create)where  import Database.Ferry.Algebra.Data.Algebra import Database.Ferry.Algebra.Data.Create import Database.Ferry.Algebra.Data.GraphBuilder-import Database.Ferry.Algebra.Render.XML+import Database.Ferry.Algebra.Monadic.Create

@@ -142,8 +142,9 @@ -- | Sort information, a list (ordered in sorting priority), of pair of columns and their sort direction-- type SortInf              = [(SortAttrName, SortDir)] +type ProjPair             = (NewAttrName, OldAttrName) -- | Projection information, a list of new attribute names, and their old names.-type ProjInf              = [(NewAttrName, OldAttrName)]  +type ProjInf              = [ProjPair]    -- | A tuple is a list of values type Tuple = [AVal]@@ -230,4 +231,5 @@     Aggr       :: SemInfAggr -> AlgNode -> Algebra    -- should have one child --    FunAggrCnt :: SemInfFunAggrCnt -> Algebra -- should have one child --    SerializeRel :: SemInfSerRel -> Algebra   -- should have two children+    Dummy :: String -> AlgNode -> Algebra -- Should have one child   deriving (Show, Eq, Ord)

@@ -45,7 +45,7 @@ -- * Graph construction combinators for table algebra  -- | Construct an empty table node with -emptyTable :: SchemaInfos -> GraphM AlgNode+emptyTable :: SchemaInfos -> GraphM a AlgNode emptyTable = insertNode . EmptyTable  -- | Construct a database table node@@ -53,7 +53,7 @@ -- table. The second describes the columns in alphabetical order. -- The third argument describes the database keys (one table key can -- span over multiple columns).-dbTable :: String -> Columns -> KeyInfos -> GraphM AlgNode+dbTable :: String -> Columns -> KeyInfos -> GraphM a AlgNode dbTable n cs ks = insertNode $ TableRef (n, attr, ks)    where     attr = map (\c -> case c of@@ -61,90 +61,94 @@                         _                   -> error "Not a named column") cs  -- | Construct a table with one value-litTable :: AVal -> String -> ATy -> GraphM AlgNode+litTable :: AVal -> String -> ATy -> GraphM a AlgNode litTable v s t = insertNode $ LitTable [[v]] [(s, t)]  -- | Attach a column 'ResAttrName' of type `ATy' with value -- `AVal' in all rows to table `AlgNode'-attach :: ResAttrName -> ATy -> AVal -> AlgNode -> GraphM AlgNode+attach :: ResAttrName -> ATy -> AVal -> AlgNode -> GraphM a AlgNode attach n t v c = insertNode $ Attach (n, (t, v)) c  -- | Cast column `AttrName' to type `ATy' and give it the name  --  `ResAttrName' afterwards.-cast :: AttrName -> ResAttrName -> ATy -> AlgNode -> GraphM AlgNode+cast :: AttrName -> ResAttrName -> ATy -> AlgNode -> GraphM a AlgNode cast n r t c = insertNode $ Cast (r, n, t) c  -- | Join two plans where the columns n1 of table 1 and columns n2 of table --  2 are equal.-eqJoin :: String -> String -> AlgNode -> AlgNode -> GraphM AlgNode+eqJoin :: String -> String -> AlgNode -> AlgNode -> GraphM a AlgNode eqJoin n1 n2 c1 c2 = insertNode $ EqJoin (n1, n2) c1 c2  -- | The same as eqJoin but with multiple columns.-eqTJoin :: [(String, String)] -> ProjInf -> AlgNode -> AlgNode -> GraphM AlgNode+eqTJoin :: [(String, String)] -> ProjInf -> AlgNode -> AlgNode -> GraphM a AlgNode eqTJoin eqs projI q1 q2 = let (a, b) = head eqs                           in foldr filterEqs (eqJoin a b q1 q2) $ tail eqs         where resCol = "item99999002"-              filterEqs :: (String, String) -> GraphM AlgNode -> GraphM AlgNode+              filterEqs :: (String, String) -> GraphM a AlgNode -> GraphM a AlgNode               filterEqs (l, r) res = proj projI =<< select resCol =<< oper "==" resCol l r =<< res  -- | Assign a number to each row in column 'ResAttrName' incrementing -- sorted by `SortInf'. The numbering is not dense!-rank :: ResAttrName -> SortInf -> AlgNode -> GraphM AlgNode+rank :: ResAttrName -> SortInf -> AlgNode -> GraphM a AlgNode rank res sort c1 = insertNode $ Rank (res, sort) c1  -- | Compute the difference between two plans.-difference :: AlgNode -> AlgNode -> GraphM AlgNode+difference :: AlgNode -> AlgNode -> GraphM a AlgNode difference q1 q2 = insertNode $ Difference q1 q2  -- | Same as rank but provides a dense numbering.-rowrank :: ResAttrName -> SortInf -> AlgNode -> GraphM AlgNode+rowrank :: ResAttrName -> SortInf -> AlgNode -> GraphM a AlgNode rowrank res sort c1 = insertNode $ RowRank (res, sort) c1  -- | Get's the nth element(s) of a (partitioned) table.-posSelect :: Int -> SortInf -> Maybe AttrName -> AlgNode -> GraphM AlgNode+posSelect :: Int -> SortInf -> Maybe AttrName -> AlgNode -> GraphM a AlgNode posSelect n sort part c1 = insertNode $ PosSel (n, sort, part) c1  -- | Select rows where the column `SelAttrName' contains True.-select :: SelAttrName -> AlgNode -> GraphM AlgNode+select :: SelAttrName -> AlgNode -> GraphM a AlgNode select sel c1 = insertNode $ Sel sel c1  -- | Remove duplicate rows-distinct :: AlgNode -> GraphM AlgNode+distinct :: AlgNode -> GraphM a AlgNode distinct c1 = insertNode $ Distinct c1  -- | Make cross product from two plans-cross :: AlgNode -> AlgNode -> GraphM AlgNode+cross :: AlgNode -> AlgNode -> GraphM a AlgNode cross c1 c2 = insertNode $ Cross c1 c2  -- | Negate the boolen value in column n and store it in column r-notC :: AttrName -> AttrName -> AlgNode -> GraphM AlgNode+notC :: AttrName -> AttrName -> AlgNode -> GraphM a AlgNode notC r n c1 = insertNode $ FunBoolNot (r, n) c1  -- | Union between two plans-union :: AlgNode -> AlgNode -> GraphM AlgNode+union :: AlgNode -> AlgNode -> GraphM a AlgNode union c1 c2 = insertNode $ DisjUnion c1 c2  -- | Project/rename certain column out of a plan-proj :: ProjInf -> AlgNode -> GraphM AlgNode+proj :: ProjInf -> AlgNode -> GraphM a AlgNode proj cols c = insertNode $ Proj cols c  -- | Apply aggregate functions to a plan-aggr :: [(AggrType, ResAttrName, Maybe AttrName)] -> Maybe PartAttrName -> AlgNode -> GraphM AlgNode+aggr :: [(AggrType, ResAttrName, Maybe AttrName)] -> Maybe PartAttrName -> AlgNode -> GraphM a AlgNode aggr aggrs part c1 = insertNode $ Aggr (aggrs, part) c1  -- | Similar to rowrank but this will assign a \emph{unique} number to every row -- (even if two rows are equal)-rownum :: AttrName -> [AttrName] -> Maybe AttrName -> AlgNode -> GraphM AlgNode+rownum :: AttrName -> [AttrName] -> Maybe AttrName -> AlgNode -> GraphM a AlgNode rownum res sort part c1 = insertNode $ RowNum (res, zip sort $ repeat Asc, part) c1  -- | Same as rownum but columns can be assigned an ordering direction-rownum' :: AttrName -> [(AttrName, SortDir)] -> Maybe AttrName -> AlgNode -> GraphM AlgNode+rownum' :: AttrName -> [(AttrName, SortDir)] -> Maybe AttrName -> AlgNode -> GraphM a AlgNode rownum' res sort part c1 = insertNode $ RowNum (res, sort, part) c1  -- | Apply an operator to the element in `LeftAttrName' and `RightAttrName', -- store the result in `ResAttrName'-oper :: String -> ResAttrName -> LeftAttrName -> RightAttrName -> AlgNode -> GraphM AlgNode+oper :: String -> ResAttrName -> LeftAttrName -> RightAttrName -> AlgNode -> GraphM a AlgNode oper o r la ra c = insertNode $ FunBinOp (o, r, la, ra) c++-- | Tag a subtree with a comment+tag :: String -> AlgNode -> GraphM a AlgNode+tag s c = insertNode $ Dummy s c  -- | Shorthand for the initial loop condition used by Ferry. initLoop :: Algebra

@@ -16,64 +16,60 @@ -- | 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))+type GraphM a = ReaderT (Gam a, AlgNode) (State (Int, M.Map Algebra AlgNode, Tags))  -- | 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)+type Gam a = [(String, a)]  -- | 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)+type AlgPlan res = (M.Map Algebra AlgNode, res, Tags) +type Tags = M.Map AlgNode [String]+ -- | 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)+runGraph :: Algebra -> GraphM res res -> AlgPlan res+runGraph l = (\(r, (_,m, c)) -> (m, r, c) ) . flip runState (2, M.singleton l 1, M.empty) . flip runReaderT ([], 1) +-- Add tag +addTag :: AlgNode -> String -> GraphM a ()+addTag i c = modify insertTag +  where+    insertTag :: (Int, M.Map Algebra AlgNode, Tags) -> (Int, M.Map Algebra AlgNode, Tags)+    insertTag (s, g, v) = (s, g, M.insertWith (++) i [c] v)+ -- | Get the current loop table-getLoop :: GraphM AlgNode+getLoop :: GraphM a AlgNode getLoop = do              (_, l) <- ask             return l  -- | Get the current variable environment            -getGamma :: GraphM Gam+getGamma :: GraphM a (Gam a) getGamma = do             (g, _) <- ask             return g  -- | Get a fresh node id-getFreshId :: GraphM Int+getFreshId :: GraphM a Int getFreshId = do-                (n, t) <- get-                put $ (n + 1, t)+                (n, t, c) <- get+                put $ (n + 1, t, c)                 return n  -- | Check if a node already exists in the graph construction environment, if so return its id.-findNode :: Algebra -> GraphM (Maybe AlgNode)+findNode :: Algebra -> GraphM a (Maybe AlgNode) findNode n = do-              (_, t) <- get+              (_, 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 :: Algebra -> GraphM a AlgNode+insertNode (Dummy s c) = do+                            addTag c s+                            return c insertNode n = do                             v <- findNode n                                          case v of@@ -81,26 +77,26 @@                                 Nothing -> insertNode' n  -- | Blindly insert a node, get a fresh id and return that                                 -insertNode' :: Algebra  -> GraphM AlgNode+insertNode' :: Algebra  -> GraphM a AlgNode insertNode' n = do                                i <- getFreshId -                              (sup, t) <- get+                              (sup, t, c) <- get                               let t' = M.insert n i t-                              put $ (sup, t')+                              put $ (sup, t', c)                               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 :: String -> a -> GraphM a r -> GraphM a r 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 a -> AlgNode -> GraphM a r -> GraphM a r withContext gam loop = local (\_ -> (gam, loop))  -- | Lookup a variable in the environment                     -fromGam :: String -> GraphM AlgRes+fromGam :: String -> GraphM a a fromGam n = do              (m, _) <- ask              case lookup n m of

@@ -0,0 +1,98 @@+-- | This module exports monadic combinators for creating graphs+module Database.Ferry.Algebra.Monadic.Create (attachM, castM, eqJoinM, eqTJoinM, rankM, differenceM, rowrankM, posSelectM, selectM,+                                              distinctM, crossM, notM, unionM, projM, aggrM, rownumM, rownum'M, operM, tagM) where++import qualified Database.Ferry.Algebra.Data.Create as C    +import Database.Ferry.Algebra.Data.Algebra+import Database.Ferry.Algebra.Data.GraphBuilder++bind1 :: Monad m => (a -> m b) -> m a -> m b+bind1 = (=<<)+             +bind2 :: Monad m => (a -> b -> m c) -> m a -> m b -> m c+bind2 f a b = do+                a' <- a+                b' <- b+                f a' b'+                +-- | Attach a column 'ResAttrName' of type `ATy' with value+-- `AVal' in all rows to table `AlgNode'+attachM :: ResAttrName -> ATy -> AVal -> GraphM a AlgNode -> GraphM a AlgNode+attachM n t v = bind1 (C.attach n t v)++-- | Cast column `AttrName' to type `ATy' and give it the name +--  `ResAttrName' afterwards.+castM :: AttrName -> ResAttrName -> ATy -> GraphM a AlgNode -> GraphM a AlgNode+castM n r t = bind1 (C.cast n r t)++-- | Join two plans where the columns n1 of table 1 and columns n2 of table+--  2 are equal.+eqJoinM :: String -> String -> GraphM a AlgNode -> GraphM a AlgNode -> GraphM a AlgNode+eqJoinM n1 n2 = bind2 (C.eqJoin n1 n2)+                      +-- | The same as eqJoin but with multiple columns.+eqTJoinM :: [(String, String)] -> ProjInf -> GraphM a AlgNode -> GraphM a AlgNode -> GraphM a AlgNode+eqTJoinM eqs projI = bind2 (C.eqTJoin eqs projI)++-- | Assign a number to each row in column 'ResAttrName' incrementing+-- sorted by `SortInf'. The numbering is not dense!+rankM :: ResAttrName -> SortInf -> GraphM a AlgNode -> GraphM a AlgNode+rankM res sort = bind1 (C.rank res sort)++-- | Compute the difference between two plans.+differenceM :: GraphM a AlgNode -> GraphM a AlgNode -> GraphM a AlgNode+differenceM = bind2 C.difference++-- | Same as rank but provides a dense numbering.+rowrankM :: ResAttrName -> SortInf -> GraphM a AlgNode -> GraphM a AlgNode+rowrankM res sort = bind1 (C.rowrank res sort)+                        +-- | Get's the nth element(s) of a (partitioned) table.+posSelectM :: Int -> SortInf -> Maybe AttrName -> GraphM a AlgNode -> GraphM a AlgNode+posSelectM n sort part = bind1 (C.posSelect n sort part)+                             +-- | Select rows where the column `SelAttrName' contains True.+selectM :: SelAttrName -> GraphM a AlgNode -> GraphM a AlgNode+selectM sel = bind1 (C.select sel) ++-- | Remove duplicate rows+distinctM :: GraphM a AlgNode -> GraphM a AlgNode+distinctM = bind1 C.distinct ++-- | Make cross product from two plans+crossM :: GraphM a AlgNode -> GraphM a AlgNode -> GraphM a AlgNode+crossM = bind2 C.cross++-- | Negate the boolen value in column n and store it in column r+notM :: AttrName -> AttrName -> GraphM a AlgNode -> GraphM a AlgNode+notM r n = bind1 (C.notC r n) ++-- | Union between two plans+unionM :: GraphM a AlgNode -> GraphM a AlgNode -> GraphM a AlgNode+unionM = bind2 C.union ++-- | Project/rename certain column out of a plan+projM :: ProjInf -> GraphM a AlgNode -> GraphM a AlgNode+projM cols = bind1 (C.proj cols) ++-- | Apply aggregate functions to a plan+aggrM :: [(AggrType, ResAttrName, Maybe AttrName)] -> Maybe PartAttrName -> GraphM a AlgNode -> GraphM a AlgNode+aggrM aggrs part = bind1 (C.aggr aggrs part) ++-- | Similar to rowrank but this will assign a \emph{unique} number to every row+-- (even if two rows are equal)+rownumM :: AttrName -> [AttrName] -> Maybe AttrName -> GraphM a AlgNode -> GraphM a AlgNode+rownumM res sort part = bind1 (C.rownum res sort part) ++-- | Same as rownum but columns can be assigned an ordering direction+rownum'M :: AttrName -> [(AttrName, SortDir)] -> Maybe AttrName -> GraphM a AlgNode -> GraphM a AlgNode+rownum'M res sort part = bind1 (C.rownum' res sort part) ++-- | Apply an operator to the element in `LeftAttrName' and `RightAttrName',+-- store the result in `ResAttrName'+operM :: String -> ResAttrName -> LeftAttrName -> RightAttrName -> GraphM a AlgNode -> GraphM a AlgNode+operM o r la ra = bind1 (C.oper o r la ra) ++-- | Tag a subtree with a comment+tagM :: String -> GraphM a AlgNode -> GraphM a AlgNode+tagM s = bind1 (C.tag s)

@@ -1,66 +1,31 @@ {-# LANGUAGE TemplateHaskell #-}-module Database.Ferry.Algebra.Render.XML where+module Database.Ferry.Algebra.Render.XML (document, mkXMLDocument, mkPlanBundle, serializeAlgebra,+                                          module Database.Ferry.Algebra.Render.XMLUtils,+                                          module Text.XML.HaXml.Types,+                                          iterCol, posCol, mkQueryPlan) where {- Transform a query plan DAG into an XML representation. -}     import Database.Ferry.Impossible import Database.Ferry.Algebra.Data.Algebra-import Database.Ferry.Algebra.Data.GraphBuilder import Database.Ferry.Algebra.Render.XMLUtils import Control.Monad.Writer  import Text.XML.HaXml.Types-import Text.XML.HaXml.Pretty (document)+import qualified Text.XML.HaXml.Pretty as P (document) import Text.XML.HaXml.Escape (xmlEscape, stdXmlEscaper)- import Text.PrettyPrint.HughesPJ -import qualified Data.Map as M---- Transform a query plan with result type into a pretty doc.--- The type is used to add meta information to the XML that is used for pretty printing by ferryDB-transform :: (Bool, AlgPlan) -> Doc-transform (isList, p) = let plans = runXML M.empty $ planBuilder (mkProperty isList) p-                            planBundle = mkPlanBundle plans-                         in (document $ mkXMLDocument planBundle)---- Transform a potentially nested algebraic plan into xml.--- The first argument is the overall result type property of the query.-planBuilder :: Element () -> AlgPlan -> XML ()-planBuilder prop (nodes, (top, cols, subs)) = buildPlan Nothing (Just prop) (top, cols, subs)-    where-        buildPlan :: Maybe (Int, Int) -> Maybe (Element ()) -> AlgRes -> XML ()-        buildPlan parent props (top', cols', subs') = -                                    do-                                        let colProp = cssToProp cols'-                                        let planProp = case props of-                                                        Nothing -> [colProp] `childsOf` xmlElem "properties"-                                                        Just p  -> [colProp, p] `childsOf` xmlElem "properties"-                                        let plan = runXML nodeTable $ serializeAlgebra top' cols'-                                        pId <- mkQueryPlan parent planProp plan-                                        buildSubPlans pId subs'-        buildSubPlans :: Int -> SubPlan -> XML ()-        buildSubPlans parent (SubPlan m) = let subPlans = M.toList m-                                            in mapM_ (\(cId, res) -> buildPlan (Just (parent, cId)) Nothing res) subPlans-        -        nodeTable = M.fromList $ map (\(a, b) -> (b, a)) $ M.toList nodes----- Convert columns structure to xml properties for rendering by ferry DB        -cssToProp :: Columns -> Element ()-cssToProp cols = map csToProp cols `childsOf` [attr "name" "cs"] `attrsOf` xmlElem "property"--csToProp :: Column -> Element ()-csToProp (Col i ty) = [[attr "name" "type", attr "value" $ show ty] `attrsOf` xmlElem "property"] `childsOf` [attr "name" "offset", attr "value" $ show i] `attrsOf` xmlElem "property"  -csToProp (NCol x css) = [cssToProp css] `childsOf` [attr "name" "mapping", attr "value" x] `attrsOf` xmlElem "property" +document ::  Document i -> Doc+document = P.document  -- Serialize algebra-serializeAlgebra :: GraphNode -> Columns -> XML XMLNode-serializeAlgebra qGId cols = do+serializeAlgebra :: [Element ()] -> GraphNode -> XML XMLNode+serializeAlgebra cols qGId = do                                     qId <- alg2XML qGId                                     nilId <- nilNode                                     xId <- freshId-                                    let contentN = ((:) iterCol $ (:) posCol $ fst $ colsToNodes 1 cols) `childsOf` contentNode+                                    let contentN = cols `childsOf` contentNode                                     let edgeNil = mkEdge nilId                                     let edgeQ = mkEdge qId                                     tell [[contentN, edgeNil, edgeQ] `childsOf` node xId "serialize relation"]@@ -74,16 +39,6 @@ posCol :: Element () posCol = [attr "name" "pos", attr "new" "false", attr "function" "pos"] `attrsOf` xmlElem "column" --- Transform cs structure into xml columns-colsToNodes :: Int -> Columns -> ([Element ()], Int)-colsToNodes i ((Col n _):cs) = let col = [attr "name" $ "item" ++ (show n), attr "new" "false", attr "function" "item", attr "position" $ show i] `attrsOf` xmlElem "column"-                                   (els, i') = colsToNodes (i+1) cs-                                in (col:els, i') -colsToNodes i ((NCol _ cs):cs') = let (els, i') = colsToNodes i cs -                                      (els', i'') = colsToNodes i' cs'-                                   in (els ++ els', i'')-colsToNodes i []                = ([], i)- -- XML defintion of nil node                                     nilNode :: XML XMLNode nilNode = do@@ -100,12 +55,22 @@                 case def of                     Just x -> return x                     Nothing -> do+                                debug <- debugEnabled                                 nd <- getNode gId                                 xId <- alg2XML' nd                                 addNodeTrans gId xId-                                return xId-                -                +                                if debug +                                    then+                                      do+                                        ts <- getTags gId+                                        case ts of+                                            Nothing -> return xId+                                            Just x -> do+                                                        xId' <- alg2XML' (Dummy (unlines x) gId)+                                                        addNodeTrans gId xId'+                                                        return xId'+                                            else+                                                return xId        where     alg2XML' :: Algebra -> XML XMLNode      alg2XML' (LitTable [[v]] [(n, ty)]) = do@@ -205,10 +170,18 @@                                         xId <- freshId                                         tell [mkDifference xId cxId1 cxId2]                                         return xId+    alg2XML' (Dummy t cId1) = do+                                cxId1 <- alg2XML cId1+                                xId <- freshId+                                tell [mkDummy xId t cxId1]+                                return xId     alg2XML' _ = $impossible +mkDummy :: XMLNode -> String -> XMLNode -> Element ()+mkDummy xId comment cxId1 = [[comment `dataChildOf` xmlElem "comment"] `childsOf` contentNode ,mkEdge cxId1]`childsOf` node xId "dummy"+ mkDifference :: XMLNode -> XMLNode -> XMLNode -> Element ()-mkDifference xId cxId1 cxId2 = [mkEdge cxId1, mkEdge cxId2]`childsOf` node xId "difference" +mkDifference xId cxId1 cxId2 = [mkEdge cxId1, mkEdge cxId2] `childsOf` node xId "difference"   mkCast :: XMLNode -> AttrName -> AttrName -> ATy -> XMLNode -> Element () mkCast xId o r t c = [[column r True, column o False, typeN t] `childsOf` contentNode, mkEdge c] `childsOf` node xId "cast"@@ -400,11 +373,3 @@ mkXMLDocument el = let xmlDecl = XMLDecl "1.0" (Just $ EncodingDecl "UTF-8") Nothing                        prol = Prolog (Just xmlDecl) [] Nothing []                     in Document prol emptyST el []---- Create an xml property node so that ferryDB knows more or less how to print the result-mkProperty :: Bool -> Element ()-mkProperty isList = [attr "name" "overallResultType", attr "value" result] `attrsOf` xmlElem "property"-    where-        result = case isList of-                    True  -> "LIST"-                    False -> "TUPLE"

@@ -31,8 +31,19 @@ -- are the node ids from the graph. The state monad keeps track of the supply of fresh ids -- for xml nodes and the dictionary for looking up whether a certain graphnode already has -- an xml representation.-type XML = WriterT [Element ()] (ReaderT (M.Map AlgNode Algebra) (State (Int, Dictionary)))+type XML = WriterT [Element ()] (ReaderT (M.Map AlgNode Algebra, M.Map AlgNode [String], Bool) (State (Int, Dictionary))) +getTags :: GraphNode -> XML (Maybe [String])+getTags i = do+             (_, ts, _) <- ask+             return $ M.lookup i ts++-- Debug enabled?+debugEnabled :: XML Bool+debugEnabled = do+                (_,_,d) <- ask+                return d+ -- Has a graphnode already been translated into an xml node. If yes which node? isDefined :: GraphNode -> XML (Maybe XMLNode) isDefined g = do@@ -55,13 +66,13 @@ -- Get a node from the algebraic plan with a certain graphNode id number getNode :: Int -> XML Algebra getNode i = do-             nodes <- ask+             (nodes, _, _) <- ask              return $ nodes M.! i   -- Run the monad and return a list of xml elements from the monad.-runXML :: M.Map AlgNode Algebra -> XML a -> [Element ()]-runXML m = snd . fst . flip runState (0, M.empty) . flip runReaderT m . runWriterT+runXML :: Bool -> M.Map AlgNode Algebra -> M.Map AlgNode [String] -> XML a -> [Element ()]+runXML debug m t = snd . fst . flip runState (0, M.empty) . flip runReaderT (m, t, debug) . runWriterT  -- * Helper functions for constructing xml nodes