git.iko.soy/project-m36
on master help sign in
fix HTML display of true and false relvars (relations without attributes)
725a05aAgentM
src/lib/ProjectM36/Relation/Show/HTML.hs+27−7
compare with master
unifiedsplit
@@ -5,21 +5,40 @@ import ProjectM36.Tuple
5import ProjectM36.Atom
5import ProjectM36.Atom
6import ProjectM36.AtomType
6import ProjectM36.AtomType
7import qualified Data.List as L
7import qualified Data.List as L
8−import Data.Text (append, Text, pack)
8+import Data.Text (Text, pack)
9import qualified Data.Text as T
9import qualified Data.Text as T
10import qualified Data.Text.IO as TIO
10import qualified Data.Text.IO as TIO
11import Data.Monoid
11import Data.Monoid
12import qualified Data.Vector as V
12import qualified Data.Vector as V
13
13
14attributesAsHTML :: Attributes -> Text
14attributesAsHTML :: 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>"
16 where
16 where
17 oneAttrHTML attr = "<th>" <> prettyAttribute attr <> "</th>"
17 oneAttrHTML attr = "<th>" <> prettyAttribute attr <> "</th>"
18
18
19relationAsHTML :: Relation -> Text
19relationAsHTML :: Relation -> Text
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
20−relationAsHTML rel@(Relation attrNameSet tupleSet) = "<table border=\"1\">" `append` attributesAsHTML attrNameSet `append` tupleSetAsHTML tupleSet `append` "<tfoot>" `append` tablefooter `append` "</tfoot></table>"
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>"
21 where
38 where
39+ pm36relcss = "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style>"
22− tablefooter = "<tr><td colspan=\"100%\">" `append` pack (show (cardinality rel)) `append` " tuples</td></tr>"
40+ tablefooter = "<tfoot><tr><td colspan=\"100%\">" <> pack (show (cardinality rel)) <> " tuples</td></tr></tfoot>"
41+ tablestart = "<table class=\"pm36relation\"\">"
23
42
24writeHTML :: Text -> IO ()
43writeHTML :: Text -> IO ()
25writeHTML = TIO.writeFile "/home/agentm/rel.html"
44writeHTML = TIO.writeFile "/home/agentm/rel.html"
@@ -28,13 +47,14 @@ writeRel :: Relation -> IO ()
28writeRel = writeHTML . relationAsHTML
47writeRel = writeHTML . relationAsHTML
29
48
30tupleAsHTML :: RelationTuple -> Text
49tupleAsHTML :: 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>"
32 where
51 where
33− tupleFrag tup = "<td>" `append` atomAsHTML (snd tup) `append` "</td>"
52+ tupleFrag tup = "<td>" <> atomAsHTML (snd tup) <> "</td>"
34 atomAsHTML (RelationAtom rel) = relationAsHTML rel
53 atomAsHTML (RelationAtom rel) = relationAsHTML rel
35 atomAsHTML atom = atomToText atom
54 atomAsHTML atom = atomToText atom
36
55
37tupleSetAsHTML :: RelationTupleSet -> Text
56tupleSetAsHTML :: RelationTupleSet -> Text
38tupleSetAsHTML tupSet = foldr folder "" (asList tupSet)
57tupleSetAsHTML tupSet = foldr folder "" (asList tupSet)
39 where
58 where
40− folder tuple acc = acc `append` tupleAsHTML tuple
59+ folder tuple acc = acc <> tupleAsHTML tuple
60+