{- |
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 :: String
publicId = "-//CoFI//DTD CompositionTable 1.1//EN"

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

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

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

table2Elem :: Table -> Element
table2Elem :: Table -> Element
table2Elem (Table as :: Table_Attrs
as a :: Compositiontable
a b :: Conversetable
b (Reflectiontable _) c :: Models
c) =
  [Attr] -> Element -> Element
add_attrs (Table_Attrs -> [Attr]
tabAttr2Attrs Table_Attrs
as)
  (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode "table" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ Compositiontable -> Element
compTable2Elem Compositiontable
a Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: Conversetable -> [Element]
conTable2Elems Conversetable
b [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Models -> Element
models2Elem Models
c]

toAttrFrStr :: String -> String -> Attr
toAttrFrStr :: String -> String -> Attr
toAttrFrStr = QName -> String -> Attr
Attr (QName -> String -> Attr)
-> (String -> QName) -> String -> String -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QName
unqual

tabAttr2Attrs :: Table_Attrs -> [Attr]
tabAttr2Attrs :: Table_Attrs -> [Attr]
tabAttr2Attrs v :: Table_Attrs
v =
  [ String -> String -> Attr
toAttrFrStr "name" (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Table_Attrs -> String
tableName Table_Attrs
v
  , String -> String -> Attr
toAttrFrStr "identity" (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Baserel -> String
baserelBaserel (Baserel -> String) -> Baserel -> String
forall a b. (a -> b) -> a -> b
$ Table_Attrs -> Baserel
tableIdentity Table_Attrs
v ]

compTable2Elem :: Compositiontable -> Element
compTable2Elem :: Compositiontable -> Element
compTable2Elem (Compositiontable a :: [Cmptabentry]
a) =
  String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode "compositiontable" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Cmptabentry -> Element) -> [Cmptabentry] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Cmptabentry -> Element
cmpEntry2Elem [Cmptabentry]
a

cmpEntry2Elem :: Cmptabentry -> Element
cmpEntry2Elem :: Cmptabentry -> Element
cmpEntry2Elem (Cmptabentry as :: Cmptabentry_Attrs
as a :: [Baserel]
a) =
  [Attr] -> Element -> Element
add_attrs (Cmptabentry_Attrs -> [Attr]
cmpEntryAttrs2Attrs Cmptabentry_Attrs
as)
  (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode "cmptabentry" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Baserel -> Element) -> [Baserel] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Baserel -> Element
baserel2Elem [Baserel]
a

cmpEntryAttrs2Attrs :: Cmptabentry_Attrs -> [Attr]
cmpEntryAttrs2Attrs :: Cmptabentry_Attrs -> [Attr]
cmpEntryAttrs2Attrs (Cmptabentry_Attrs b1 :: Baserel
b1 b2 :: Baserel
b2) =
  [ String -> String -> Attr
toAttrFrStr "argBaserel1" (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Baserel -> String
baserelBaserel Baserel
b1
  , String -> String -> Attr
toAttrFrStr "argBaserel2" (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Baserel -> String
baserelBaserel Baserel
b2 ]

baserel2Elem :: Baserel -> Element
baserel2Elem :: Baserel -> Element
baserel2Elem = String -> Attr -> Element
forall t. Node t => String -> t -> Element
unode "baserel" (Attr -> Element) -> (Baserel -> Attr) -> Baserel -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baserel -> Attr
baserel2Attr

baserel2Attr :: Baserel -> Attr
baserel2Attr :: Baserel -> Attr
baserel2Attr = String -> String -> Attr
toAttrFrStr "baserel" (String -> Attr) -> (Baserel -> String) -> Baserel -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baserel -> String
baserelBaserel

conTable2Elems :: Conversetable -> [Element]
conTable2Elems :: Conversetable -> [Element]
conTable2Elems ct :: Conversetable
ct = case Conversetable
ct of
  Conversetable a :: [Contabentry]
a ->
    [String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode "conversetable" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Contabentry -> [Element]) -> [Contabentry] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ (Contabentry b :: Baserel
b cs :: [Baserel]
cs)
       -> (Baserel -> Element) -> [Baserel] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (\ c :: Baserel
c -> Contabentry -> Element
conEntry2Elem (Contabentry -> Element) -> Contabentry -> Element
forall a b. (a -> b) -> a -> b
$ Baserel -> [Baserel] -> Contabentry
Contabentry Baserel
b [Baserel
c]) [Baserel]
cs) [Contabentry]
a]
  _ -> []

conEntry2Elem :: Contabentry -> Element
conEntry2Elem :: Contabentry -> Element
conEntry2Elem c :: Contabentry
c@(Contabentry _ cs :: [Baserel]
cs) =
  [Attr] -> Element -> Element
add_attrs (Contabentry -> [Attr]
conEntry2Attrs Contabentry
c) (Element -> Element)
-> ([Element] -> Element) -> [Element] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode "contabentry" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ case [Baserel]
cs of
    [_] -> []
    _ -> (Baserel -> Element) -> [Baserel] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Element
forall t. Node t => String -> t -> Element
unode "converseBaseRel" (String -> Element) -> (Baserel -> String) -> Baserel -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baserel -> String
baserelBaserel) [Baserel]
cs

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

models2Elem :: Models -> Element
models2Elem :: Models -> Element
models2Elem (Models a :: [Model]
a) = String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode "models" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Model -> Element) -> [Model] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Model -> Element
model2Elem [Model]
a

model2Elem :: Model -> Element
model2Elem :: Model -> Element
model2Elem = String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode "model" ([Attr] -> Element) -> (Model -> [Attr]) -> Model -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model -> [Attr]
model2Attrs

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