{- |
Module      :  ./CASL/CompositionTable/ToXml.hs
Description :  XML output for composition tables of qualitative calculi
Copyright   :  (c) Uni Bremen 2005
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  till@informatik.uni-bremen.de
Stability   :  provisional
Portability :  non-portable (FlexibleInstances via xml package)

XML output for composition tables
-}

module CASL.CompositionTable.ToXml (tableXmlStr) where

{-
DTD see systemURI

-- hets -v2 -n RCC8CompositionTable -o comptable.xml Calculi/Space/RCC8.het

-- writes Calculi/Space/RCC8_RCC8CompositionTable.comptable.xml

eliminate ops on rhs, resulting in list of base relations
add equations for id
-}

import CASL.CompositionTable.CompositionTable
import Text.XML.Light

-- Using xml it is not very easy to just add a DOCTYPE node

-- Public identifier (suggestion)
publicId :: String
publicId = "-//CoFI//DTD CompositionTable 1.1//EN"

-- System URI
systemURI :: String
systemURI =
  "http://www.informatik.uni-bremen.de/cofi/hets/CompositionTable.dtd"

tableProlog :: [String]
tableProlog =
    [ "<?xml version='1.0absd' encoding='UTF-8' ?>"
    , "<!DOCTYPE table PUBLIC " ++ shows publicId " "
      ++ shows systemURI ">" ]

-- this function renders a Table as xml string
tableXmlStr :: Table -> String
tableXmlStr t = unlines $ tableProlog ++ lines (ppElement $ table2Elem t)

table2Elem :: Table -> Element
table2Elem (Table as a b (Reflectiontable _) c) =
  add_attrs (tabAttr2Attrs as)
  $ unode "table" $ compTable2Elem a : conTable2Elems b ++ [models2Elem c]

toAttrFrStr :: String -> String -> Attr
toAttrFrStr = Attr . unqual

tabAttr2Attrs :: Table_Attrs -> [Attr]
tabAttr2Attrs v =
  [ toAttrFrStr "name" $ tableName v
  , toAttrFrStr "identity" $ baserelBaserel $ tableIdentity v ]

compTable2Elem :: Compositiontable -> Element
compTable2Elem (Compositiontable a) =
  unode "compositiontable" $ map cmpEntry2Elem a

cmpEntry2Elem :: Cmptabentry -> Element
cmpEntry2Elem (Cmptabentry as a) =
  add_attrs (cmpEntryAttrs2Attrs as)
  $ unode "cmptabentry" $ map baserel2Elem a

cmpEntryAttrs2Attrs :: Cmptabentry_Attrs -> [Attr]
cmpEntryAttrs2Attrs (Cmptabentry_Attrs b1 b2) =
  [ toAttrFrStr "argBaserel1" $ baserelBaserel b1
  , toAttrFrStr "argBaserel2" $ baserelBaserel b2 ]

baserel2Elem :: Baserel -> Element
baserel2Elem = unode "baserel" . baserel2Attr

baserel2Attr :: Baserel -> Attr
baserel2Attr = toAttrFrStr "baserel" . baserelBaserel

conTable2Elems :: Conversetable -> [Element]
conTable2Elems ct = case ct of
  Conversetable a ->
    [unode "conversetable" $ concatMap (\ (Contabentry b cs)
       -> map (\ c -> conEntry2Elem $ Contabentry b [c]) cs) a]
  _ -> []

conEntry2Elem :: Contabentry -> Element
conEntry2Elem c@(Contabentry _ cs) =
  add_attrs (conEntry2Attrs c) . unode "contabentry" $ case cs of
    [_] -> []
    _ -> map (unode "converseBaseRel" . baserelBaserel) cs

conEntry2Attrs :: Contabentry -> [Attr]
conEntry2Attrs (Contabentry a cs) =
  toAttrFrStr "argBaseRel" (baserelBaserel a)
  : case cs of
      [c] -> [ toAttrFrStr "converseBaseRel" $ baserelBaserel c ]
      _ -> []

models2Elem :: Models -> Element
models2Elem (Models a) = unode "models" $ map model2Elem a

model2Elem :: Model -> Element
model2Elem = unode "model" . model2Attrs

model2Attrs :: Model -> [Attr]
model2Attrs (Model s1 s2) =
  [ toAttrFrStr "string1" s1
  , toAttrFrStr "string2" s2 ]
