git.iko.soy/project-m36
on 8cfc3ee help sign in
project-m36/src/lib/ProjectM36/Relation/Show/HTML.hs
37 lines 1.5 kB history raw
1module ProjectM36.Relation.Show.HTML where
2import ProjectM36.Base
3import ProjectM36.Relation
4import ProjectM36.Tuple
5import ProjectM36.Atom
6import qualified Data.List as L
7import ProjectM36.Attribute
8import Data.Text (append, Text, pack)
9import qualified Data.Text as T
10import qualified Data.Text.IO as TIO
12attributesAsHTML :: Attributes -> Text
13attributesAsHTML attrs = "<tr>" `append` (T.concat $ map oneAttrHTML attrNameList) `append` "</tr>"
14 where
15 oneAttrHTML attrName = "<th>" `append` attrName `append` "</th>"
16 attrNameList = sortedAttributeNameList (attributeNameSet attrs)
18relationAsHTML :: Relation -> Text
19relationAsHTML rel@(Relation attrNameSet tupleSet) = "<table border=\"1\">" `append` (attributesAsHTML attrNameSet) `append` (tupleSetAsHTML tupleSet) `append` "<tfoot>" `append` tablefooter `append` "</tfoot></table>"
20 where
21 tablefooter = "<tr><td colspan=\"100%\">" `append` (pack $ show (cardinality rel)) `append` " tuples</td></tr>"
23writeHTML :: Text -> IO ()
24writeHTML = TIO.writeFile "/home/agentm/rel.html"
26writeRel :: Relation -> IO ()
27writeRel = writeHTML . relationAsHTML
29tupleAsHTML :: RelationTuple -> Text
30tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleSortedAssocs tuple)) `append` "</tr>"
31 where
32 tupleFrag tup = "<td>" `append` atomToText (snd tup) `append` "</td>"
34tupleSetAsHTML :: RelationTupleSet -> Text
35tupleSetAsHTML tupSet = foldr folder "" (asList tupSet)
36 where
37 folder tuple acc = acc `append` tupleAsHTML tuple