903f237 · project-m36 · git.iko.soy

git.iko.soy/project-m36

remove attribute sorting from HTML relation presentation

this caused the HTML tuple header to be out-of-phase with the tuple ordering- oops

commit903f237fbafe1a5d7b64747e8abd5cff56a354ad authorAgentM <agentm@themactionfaction.com> dateTue 14 Nov 2017, 22:41 (9 years ago) parentfa4774b

3 files changed+17−8

compare with master

unifiedsplit

src/lib/ProjectM36/MiscUtils.hs+6 src/lib/ProjectM36/Relation/Show/HTML.hs+3−4 src/lib/ProjectM36/Tuple.hs+8−4

src/lib/ProjectM36/MiscUtils.hs+6

@@ -7,3 +7,9 @@ dupes [_] = []

77dupes [x,y] = [x | x == y]

88dupes (x:y:xs) = dupes(x:[y]) ++ dupes(y : xs)

10+--Data.Vector.indexed but for lists

11+indexed :: [a] -> [(Int, a)]

12+indexed ls = go 0 ls

13+ where

14+ go _ [] = []

15+ go i (v:ys) = (i,v):(go (i+1) ys)

src/lib/ProjectM36/Relation/Show/HTML.hs+3−4

@@ -5,17 +5,16 @@ import ProjectM36.Tuple

55import ProjectM36.Atom

66import ProjectM36.AtomType

77import qualified Data.List as L

8−import ProjectM36.Attribute

98import Data.Text (append, Text, pack)

109import qualified Data.Text as T

1110import qualified Data.Text.IO as TIO

1211import Data.Monoid

12+import qualified Data.Vector as V

1313

1414attributesAsHTML :: Attributes -> Text

15−attributesAsHTML attrs = "<tr>" `append` T.concat (map oneAttrHTML sortedAttrs) `append` "</tr>"

15+attributesAsHTML attrs = "<tr>" `append` T.concat (map oneAttrHTML (V.toList attrs)) `append` "</tr>"

1616 where

1717 oneAttrHTML attr = "<th>" <> prettyAttribute attr <> "</th>"

18− sortedAttrs = orderedAttributes attrs

1918

2019relationAsHTML :: Relation -> Text

2120relationAsHTML rel@(Relation attrNameSet tupleSet) = "<table border=\"1\">" `append` attributesAsHTML attrNameSet `append` tupleSetAsHTML tupleSet `append` "<tfoot>" `append` tablefooter `append` "</tfoot></table>"

@@ -29,7 +28,7 @@ writeRel :: Relation -> IO ()

2928writeRel = writeHTML . relationAsHTML

3029

3130tupleAsHTML :: RelationTuple -> Text

32−tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleSortedAssocs tuple)) `append` "</tr>"

31+tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleAssocs tuple)) `append` "</tr>"

3332 where

3433 tupleFrag tup = "<td>" `append` atomToText (snd tup) `append` "</td>"

3534

src/lib/ProjectM36/Tuple.hs+8−4

@@ -29,6 +29,14 @@ tupleAttributes (RelationTuple tupAttrs _) = tupAttrs

2929tupleAssocs :: RelationTuple -> [(AttributeName, Atom)]

3030tupleAssocs (RelationTuple attrVec tupVec) = V.toList $ V.map (first attributeName) (V.zip attrVec tupVec)

3131

32+orderedTupleAssocs :: RelationTuple -> [(AttributeName, Atom)]

33+orderedTupleAssocs tup@(RelationTuple attrVec _) = map (\attr -> (attributeName attr, atomForAttr (attributeName attr))) oAttrs

34+ where

35+ oAttrs = orderedAttributes attrVec

36+ atomForAttr nam = case atomForAttributeName nam tup of

37+ Left _ -> TextAtom "<?>"

38+ Right val -> val

39+

3240-- return atoms in some arbitrary but consistent key order

3341tupleAtoms :: RelationTuple -> V.Vector Atom

3442tupleAtoms (RelationTuple _ tupVec) = tupVec

@@ -146,10 +154,6 @@ tupleAtomExtend newAttrName atom tupIn = tupleExtend tupIn newTup

146154 where

147155 newTup = RelationTuple (V.singleton $ Attribute newAttrName (atomTypeForAtom atom)) (V.singleton atom)

148156

149−{- sort the associative list to match the header sorting -}

150−tupleSortedAssocs :: RelationTuple -> [(AttributeName, Atom)]

151−tupleSortedAssocs (RelationTuple tupAttrs tupVec) = V.toList $ V.map (\(index,attr) -> (attributeName attr, tupVec V.! index)) $ V.indexed tupAttrs

152−

153157--this could be cheaper- it may not be wortwhile to update all the tuples for projection, but then the attribute management must be slightly different- perhaps the attributes should be a vector of association tuples [(name, index)]

154158tupleProject :: S.Set AttributeName -> RelationTuple -> RelationTuple

155159tupleProject projectAttrs (RelationTuple attrs tupVec) = RelationTuple newAttrs newTupVec