@@ -5,21 +5,40 @@ import ProjectM36.Tuple
55import ProjectM36.Atom
66import ProjectM36.AtomType
77import qualified Data.List as L
8−import Data.Text (append, Text, pack)
8+import Data.Text (Text, pack)
99import qualified Data.Text as T
1010import qualified Data.Text.IO as TIO
1111import Data.Monoid
1212import qualified Data.Vector as V
1313
1414attributesAsHTML :: Attributes -> Text
15−attributesAsHTML attrs = "<tr>" `append` T.concat (map oneAttrHTML (V.toList attrs)) `append` "</tr>"
15+attributesAsHTML attrs = "<tr>" <> T.concat (map oneAttrHTML (V.toList attrs)) <> "</tr>"
1616 where
1717 oneAttrHTML attr = "<th>" <> prettyAttribute attr <> "</th>"
1818
1919relationAsHTML :: Relation -> Text
20−relationAsHTML rel@(Relation attrNameSet tupleSet) = "<table border=\"1\">" `append` attributesAsHTML attrNameSet `append` tupleSetAsHTML tupleSet `append` "<tfoot>" `append` tablefooter `append` "</tfoot></table>"
20+-- web browsers don't display tables with empty cells or empty headers, so we have to insert some placeholders- it's not technically the same, but looks as expected in the browser
21+relationAsHTML rel@(Relation attrNameSet tupleSet)
22+ | rel == relationTrue = pm36relcss <>
23+ tablestart <>
24+ "<tr><th></th></tr>" <>
25+ "<tr><td></td></tr>" <>
26+ tablefooter <> "</table>"
27+ | rel == relationFalse = pm36relcss <>
28+ tablestart <>
29+ "<tr><th></th></tr>" <>
30+ tablefooter <>
31+ "</table>"
32+ | otherwise = pm36relcss <>
33+ tablestart <>
34+ attributesAsHTML attrNameSet <>
35+ tupleSetAsHTML tupleSet <>
36+ tablefooter <>
37+ "</table>"
2138 where
22− tablefooter = "<tr><td colspan=\"100%\">" `append` pack (show (cardinality rel)) `append` " tuples</td></tr>"
39+ pm36relcss = "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style>"
40+ tablefooter = "<tfoot><tr><td colspan=\"100%\">" <> pack (show (cardinality rel)) <> " tuples</td></tr></tfoot>"
41+ tablestart = "<table class=\"pm36relation\"\">"
2342
2443writeHTML :: Text -> IO ()
2544writeHTML = TIO.writeFile "/home/agentm/rel.html"
@@ -28,13 +47,14 @@ writeRel :: Relation -> IO ()
2847writeRel = writeHTML . relationAsHTML
2948
3049tupleAsHTML :: RelationTuple -> Text
31−tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleAssocs tuple)) `append` "</tr>"
50+tupleAsHTML tuple = "<tr>" <> T.concat (L.map tupleFrag (tupleAssocs tuple)) <> "</tr>"
3251 where
33− tupleFrag tup = "<td>" `append` atomAsHTML (snd tup) `append` "</td>"
52+ tupleFrag tup = "<td>" <> atomAsHTML (snd tup) <> "</td>"
3453 atomAsHTML (RelationAtom rel) = relationAsHTML rel
3554 atomAsHTML atom = atomToText atom
3655
3756tupleSetAsHTML :: RelationTupleSet -> Text
3857tupleSetAsHTML tupSet = foldr folder "" (asList tupSet)
3958 where
40− folder tuple acc = acc `append` tupleAsHTML tuple
59+ folder tuple acc = acc <> tupleAsHTML tuple
60+