diff --git a/TableAlgebra.cabal b/TableAlgebra.cabal --- a/TableAlgebra.cabal +++ b/TableAlgebra.cabal @@ -2,7 +2,7 @@ Name: TableAlgebra synopsis: Ferry Table Algebra Category: Database -Version: 0.6.1 +Version: 0.7.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]. @@ -28,7 +28,7 @@ Build-Type: Simple library 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 + build-depends: base >= 4.2 && < 5, HaXml >= 1.22, mtl >= 2.0.1.0, containers >= 0.3.0.0, 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 diff --git a/src/Database/Ferry/Algebra.hs b/src/Database/Ferry/Algebra.hs --- a/src/Database/Ferry/Algebra.hs +++ b/src/Database/Ferry/Algebra.hs @@ -10,13 +10,13 @@ module Database.Ferry.Algebra ( AlgPlan, union, attach, proj, getLoop, rownum, rownum', eqJoin, rank, eqTJoin, distinct, rowrank, cast, difference, aggr, - select, posSelect, dbTable, notC, cross, oper, emptyTable, tag, litTable, + select, posSelect, dbTable, notC, cross, oper, emptyTable, tag, litTable, litTable', withBinding, withContext, getGamma, fromGam, nat, int, bool, double, string, natT, intT, surT, boolT, doubleT, stringT, SortDir(..), AggrType(..), Column(..), Columns, - ATy(..), + ATy(..), AVal(), SchemaInfos, KeyInfos, AlgNode, GraphM, Gam, initLoop, runGraph, ProjPair, ProjInf, module Database.Ferry.Algebra.Monadic.Create)where diff --git a/src/Database/Ferry/Algebra/Data/Create.hs b/src/Database/Ferry/Algebra/Data/Create.hs --- a/src/Database/Ferry/Algebra/Data/Create.hs +++ b/src/Database/Ferry/Algebra/Data/Create.hs @@ -64,6 +64,9 @@ litTable :: AVal -> String -> ATy -> GraphM a AlgNode litTable v s t = insertNode $ LitTable [[v]] [(s, t)] +litTable' :: [[AVal]] -> [(String, ATy)] -> GraphM a AlgNode +litTable' v s = insertNode $ LitTable v s + -- | Attach a column 'ResAttrName' of type `ATy' with value -- `AVal' in all rows to table `AlgNode' attach :: ResAttrName -> ATy -> AVal -> AlgNode -> GraphM a AlgNode diff --git a/src/Database/Ferry/Algebra/Render/XML.hs b/src/Database/Ferry/Algebra/Render/XML.hs --- a/src/Database/Ferry/Algebra/Render/XML.hs +++ b/src/Database/Ferry/Algebra/Render/XML.hs @@ -16,6 +16,8 @@ import Text.XML.HaXml.Escape (xmlEscape, stdXmlEscaper) import Text.PrettyPrint.HughesPJ +import Data.List (intersperse, transpose) + document :: Document i -> Doc document = P.document @@ -66,16 +68,16 @@ case ts of Nothing -> return xId Just x -> do - xId' <- alg2XML' (Dummy (unlines x) gId) + xId' <- alg2XML' (Dummy (concat $ intersperse " " x) gId) addNodeTrans gId xId' return xId' else return xId where alg2XML' :: Algebra -> XML XMLNode - alg2XML' (LitTable [[v]] [(n, ty)]) = do + alg2XML' (LitTable vs s) = do xId <- freshId - tell [mkTableNode xId n v ty] + tell [mkTableNode xId s vs] return xId alg2XML' (Attach (n, (ty, val)) cId1) = do cxId1 <- alg2XML cId1 @@ -175,10 +177,9 @@ 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" +mkDummy xId comment cxId1 = ([[comment `stringChildOf` 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" @@ -341,12 +342,14 @@ colNode = [xmlEscape stdXmlEscaper valNode] `childsOf` column n True in [[colNode] `childsOf` contentNode, mkEdge cxId]`childsOf` node xId "attach" --- Create an xml table node with one value in it -mkTableNode :: XMLNode -> ColName -> AVal -> ATy -> Element () -mkTableNode xId n val ty = let valNode = val `dataChildOf` [attr "type" $ show ty] `attrsOf` xmlElem "value" - colNode = [xmlEscape stdXmlEscaper valNode] `childsOf` column n True - conNode = [colNode] `childsOf` contentNode - in [conNode] `childsOf` node xId "table" +-- Create an xml table node +mkTableNode :: XMLNode -> [(ColName, ATy)] -> [[AVal]] -> Element () +mkTableNode xId s vals = let colNodes = [ valNodes t vs `childsOf` column n True + | ((n, t), vs) <- zip s (transpose vals)] + conNode = colNodes `childsOf` contentNode + in [conNode] `childsOf` node xId "table" + where + valNodes ty vs = [xmlEscape stdXmlEscaper $ v `dataChildOf` [attr "type" $ show ty] `attrsOf` xmlElem "value" | v <- vs] -- Create an xml edge to point to the given xml node id. mkEdge :: XMLNode -> Element () diff --git a/src/Database/Ferry/Algebra/Render/XMLUtils.hs b/src/Database/Ferry/Algebra/Render/XMLUtils.hs --- a/src/Database/Ferry/Algebra/Render/XMLUtils.hs +++ b/src/Database/Ferry/Algebra/Render/XMLUtils.hs @@ -88,6 +88,9 @@ dataChildOf :: Show a => a -> Element () -> Element () dataChildOf v (Elem n attrs cs) = Elem n attrs $ (CString False (show v) ()) : cs +stringChildOf :: String -> Element () -> Element () +stringChildOf v (Elem n attrs cs) = Elem n attrs $ (CString False v ()) : cs + -- | Construct a column with name n, and new status v column :: String -> Bool -> Element () column n v = let new = case v of @@ -101,7 +104,7 @@ -- | Construct an xml tag with name n xmlElem :: String -> Element () -xmlElem n = Elem n [] [] +xmlElem n = Elem (N n) [] [] -- | Construct an algebraic node with id xId and of kind t node :: XMLNode -> String -> Element () @@ -113,7 +116,7 @@ -- | Construct an attribute for an xml node, attrname = n and its value is v attr :: String -> String -> Attribute -attr n v = (n, AttValue [Left v]) +attr n v = (N n, AttValue [Left v]) -- | Attach list of attributes to an xml element attrsOf :: [Attribute] -> Element () -> Element ()