content: module ProjectM36.Relation.Show.HTML where
  import ProjectM36.Base
  import ProjectM36.Relation
  import ProjectM36.Tuple
  import ProjectM36.Atom
  import ProjectM36.Attribute as A
  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
  
  attributesAsHTML :: Attributes -> Text
  attributesAsHTML attrs = "<tr>" <> T.concat (map oneAttrHTML (A.toList attrs)) <> "</tr>"
    where
      oneAttrHTML attr = "<th>" <> prettyAttribute attr <> "</th>"
  
  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 <>
                            "<tr><th></th></tr>" <>
                            "<tr><td></td></tr>" <> 
                            tablefooter <> "</table>"
    | rel == relationFalse = pm36relcss <>
                             tablestart <>
                             "<tr><th></th></tr>" <>
                             tablefooter <> 
                             "</table>"
    | otherwise = pm36relcss <>
                  tablestart <> 
                  attributesAsHTML attrNameSet <> 
                  tupleSetAsHTML tupleSet <> 
                  tablefooter <> 
                  "</table>"
    where
      pm36relcss = "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style>"
      tablefooter = "<tfoot><tr><td colspan=\"100%\">" <> pack (show (cardinality rel)) <> " tuples</td></tr></tfoot>"
      tablestart = "<table class=\"pm36relation\"\">"
  
  writeHTML :: Text -> IO ()
  writeHTML = TIO.writeFile "/home/agentm/rel.html"
  
  writeRel :: Relation -> IO ()
  writeRel = writeHTML . relationAsHTML
  
  tupleAsHTML :: RelationTuple -> Text
  tupleAsHTML tuple = "<tr>" <> T.concat (L.map tupleFrag (tupleAssocs tuple)) <> "</tr>"
    where
      tupleFrag tup = "<td>" <> atomAsHTML (snd tup) <> "</td>"
      atomAsHTML (RelationAtom rel) = relationAsHTML rel
      atomAsHTML (TextAtom t) = "&quot;" <> t <> "&quot;"
      atomAsHTML atom = atomToText atom
  
  tupleSetAsHTML :: RelationTupleSet -> Text
  tupleSetAsHTML tupSet = foldr folder "" (asList tupSet)
    where
      folder tuple acc = acc <> tupleAsHTML tuple
  
  