module ProjectM36.Relation.Show.HTML where import ProjectM36.Base import ProjectM36.Relation import ProjectM36.Tuple import ProjectM36.Atom import ProjectM36.AtomType import qualified Data.List as L import Data.Text (Text, pack) import qualified Data.Text as T import qualified Data.Text.IO as TIO #if __GLASGOW_HASKELL__ < 804 import Data.Monoid #endif import qualified Data.Vector as V attributesAsHTML :: Attributes -> Text attributesAsHTML attrs = "" <> T.concat (map oneAttrHTML (V.toList attrs)) <> "" where oneAttrHTML attr = "" <> prettyAttribute attr <> "" relationAsHTML :: Relation -> Text -- 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 relationAsHTML rel@(Relation attrNameSet tupleSet) | rel == relationTrue = pm36relcss <> tablestart <> "" <> "" <> tablefooter <> "" | rel == relationFalse = pm36relcss <> tablestart <> "" <> tablefooter <> "" | otherwise = pm36relcss <> tablestart <> attributesAsHTML attrNameSet <> tupleSetAsHTML tupleSet <> tablefooter <> "" where pm36relcss = "" tablefooter = "" <> pack (show (cardinality rel)) <> " tuples" tablestart = "" writeHTML :: Text -> IO () writeHTML = TIO.writeFile "/home/agentm/rel.html" writeRel :: Relation -> IO () writeRel = writeHTML . relationAsHTML tupleAsHTML :: RelationTuple -> Text tupleAsHTML tuple = "" <> T.concat (L.map tupleFrag (tupleAssocs tuple)) <> "" where tupleFrag tup = "" atomAsHTML (RelationAtom rel) = relationAsHTML rel atomAsHTML (TextAtom t) = """ <> t <> """ atomAsHTML atom = atomToText atom tupleSetAsHTML :: RelationTupleSet -> Text tupleSetAsHTML tupSet = foldr folder "" (asList tupSet) where folder tuple acc = acc <> tupleAsHTML tuple
" <> atomAsHTML (snd tup) <> "