{- |
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
eliminate ops on rhs, resulting in list of base relations
add equations for id
-}
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 =
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 ]