{-# LANGUAGE
  FlexibleInstances
  , TypeSynonymInstances
 #-}

{- |
Module      :  ./OMDoc/XmlInterface.hs
Description :  OMDoc-XML conversion
Copyright   :  (c) Ewaryst Schulz, DFKI 2009
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  ewaryst.schulz@dfki.de
Stability   :  provisional
Portability :  portable

The transformation of the OMDoc intermediate representation to and from xml.
The import from xml does not validate the xml, hence if you encounter strange
errors, do not forget to check the xml structure first.
-}


module OMDoc.XmlInterface where

import OMDoc.DataTypes

import Common.Utils (splitBy)
import Common.Result
import Common.Percent

import Data.Maybe
import Data.List
import Control.Monad (liftM, when)
import qualified Control.Monad.Fail as Fail

import Common.XmlParser (XmlParseable, parseXml)
import Text.XML.Light

-- * Names and other constants

-- | The implemented OMDoc version
omdoc_current_version :: String
omdoc_current_version :: String
omdoc_current_version = "1.6"

toQN :: String -> QName
toQN :: String -> QName
toQN s :: String
s = QName
blank_name { qName :: String
qName = String
s }
toQNOM :: String -> QName
toQNOM :: String -> QName
toQNOM s :: String
s = QName
blank_name { qName :: String
qName = String
s , qPrefix :: Maybe String
qPrefix = String -> Maybe String
forall a. a -> Maybe a
Just "om" }

-- | often used element names

el_omdoc, el_theory, el_view, el_structure, el_type, el_adt, el_sortdef
 , el_constructor, el_argument, el_insort, el_selector, el_open, el_component
 , el_conass, el_constant, el_notation, el_text, el_definition, el_omobj
 , el_ombind, el_oms, el_ombvar, el_omattr, el_omatp, el_omv, el_oma :: QName

el_omdoc :: QName
el_omdoc = String -> QName
toQN "omdoc"
el_theory :: QName
el_theory = String -> QName
toQN "theory"
el_view :: QName
el_view = String -> QName
toQN "view"
el_structure :: QName
el_structure = String -> QName
toQN "structure"
el_type :: QName
el_type = String -> QName
toQN "type"
el_adt :: QName
el_adt = String -> QName
toQN "adt"
el_sortdef :: QName
el_sortdef = String -> QName
toQN "sortdef"
el_constructor :: QName
el_constructor = String -> QName
toQN "constructor"
el_argument :: QName
el_argument = String -> QName
toQN "argument"
el_insort :: QName
el_insort = String -> QName
toQN "insort"
el_selector :: QName
el_selector = String -> QName
toQN "selector"
el_conass :: QName
el_conass = String -> QName
toQN "conass"
el_open :: QName
el_open = String -> QName
toQN "open"
el_constant :: QName
el_constant = String -> QName
toQN "constant"
el_notation :: QName
el_notation = String -> QName
toQN "notation"
el_text :: QName
el_text = String -> QName
toQN "text"
el_definition :: QName
el_definition = String -> QName
toQN "definition"
el_component :: QName
el_component = String -> QName
toQN "component"

el_omobj :: QName
el_omobj = String -> QName
toQN "OMOBJ"

el_ombind :: QName
el_ombind = String -> QName
toQNOM "OMBIND"
el_oms :: QName
el_oms = String -> QName
toQNOM "OMS"
el_ombvar :: QName
el_ombvar = String -> QName
toQNOM "OMBVAR"
el_omattr :: QName
el_omattr = String -> QName
toQNOM "OMATTR"
el_omatp :: QName
el_omatp = String -> QName
toQNOM "OMATP"
el_omv :: QName
el_omv = String -> QName
toQNOM "OMV"
el_oma :: QName
el_oma = String -> QName
toQNOM "OMA"

at_version, at_module, at_name, at_meta, at_role, at_type, at_total, at_for
 , at_from, at_to, at_value, at_base, at_as, at_precedence, at_fixity, at_index
 , at_associativity, at_style, at_implicit :: QName

at_version :: QName
at_version = String -> QName
toQN "version"
at_module :: QName
at_module = String -> QName
toQN "module"
at_name :: QName
at_name = String -> QName
toQN "name"
at_meta :: QName
at_meta = String -> QName
toQN "meta"
at_role :: QName
at_role = String -> QName
toQN "role"
at_type :: QName
at_type = String -> QName
toQN "type"
at_total :: QName
at_total = String -> QName
toQN "total"
at_for :: QName
at_for = String -> QName
toQN "for"
at_from :: QName
at_from = String -> QName
toQN "from"
at_to :: QName
at_to = String -> QName
toQN "to"
at_value :: QName
at_value = String -> QName
toQN "value"
at_base :: QName
at_base = String -> QName
toQN "base"
at_as :: QName
at_as = String -> QName
toQN "as"
at_precedence :: QName
at_precedence = String -> QName
toQN "precedence"
at_fixity :: QName
at_fixity = String -> QName
toQN "fixity"
at_associativity :: QName
at_associativity = String -> QName
toQN "associativity"
at_style :: QName
at_style = String -> QName
toQN "style"
at_implicit :: QName
at_implicit = String -> QName
toQN "implicit"
at_index :: QName
at_index = String -> QName
toQN "index"

attr_om :: Attr
attr_om :: Attr
attr_om = QName -> String -> Attr
Attr (QName
blank_name { qName :: String
qName = "om" , qPrefix :: Maybe String
qPrefix = String -> Maybe String
forall a. a -> Maybe a
Just "xmlns" })
          "http://www.openmath.org/OpenMath"


-- * Top level from/to xml functions

{- |
  This class defines the interface to read from and write to XML
-}
class XmlRepresentable a where
  -- | render instance to an XML Element
  toXml :: a -> Content
  -- | read instance from an XML Element
  fromXml :: Element -> Result (Maybe a)


{-
-- for testing the performance without the xml lib we use the show and read funs
xmlOut :: Show a => a -> String
xmlOut = show

xmlIn :: String -> Result OMDoc
xmlIn = return . read
-}

xmlOut :: XmlRepresentable a => a -> String
xmlOut :: a -> String
xmlOut obj :: a
obj = case a -> Content
forall a. XmlRepresentable a => a -> Content
toXml a
obj of
 Elem e :: Element
e -> Element -> String
ppTopElement Element
e
 c :: Content
c -> Content -> String
ppContent Content
c

xmlIn :: XmlParseable a => a -> IO (Result OMDoc)
xmlIn :: a -> IO (Result OMDoc)
xmlIn s :: a
s = do
  Either String Element
res <- a -> IO (Either String Element)
forall a. XmlParseable a => a -> IO (Either String Element)
parseXml a
s
  Result OMDoc -> IO (Result OMDoc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result OMDoc -> IO (Result OMDoc))
-> Result OMDoc -> IO (Result OMDoc)
forall a b. (a -> b) -> a -> b
$ case Either String Element
res of
            Right e :: Element
e -> Element -> Result (Maybe OMDoc)
forall a. XmlRepresentable a => Element -> Result (Maybe a)
fromXml Element
e Result (Maybe OMDoc)
-> (Maybe OMDoc -> Result OMDoc) -> Result OMDoc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result OMDoc
-> (OMDoc -> Result OMDoc) -> Maybe OMDoc -> Result OMDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Result OMDoc
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "xmlIn") OMDoc -> Result OMDoc
forall (m :: * -> *) a. Monad m => a -> m a
return
            Left msg :: String
msg -> String -> Result OMDoc
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
msg


listToXml :: XmlRepresentable a => [a] -> [Content]
listToXml :: [a] -> [Content]
listToXml = (a -> Content) -> [a] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map a -> Content
forall a. XmlRepresentable a => a -> Content
toXml

listFromXml :: XmlRepresentable a => [Content] -> Result [a]
listFromXml :: [Content] -> Result [a]
listFromXml elms :: [Content]
elms = ([Maybe a] -> [a]) -> Result [Maybe a] -> Result [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes (Result [Maybe a] -> Result [a]) -> Result [Maybe a] -> Result [a]
forall a b. (a -> b) -> a -> b
$ (Element -> Result (Maybe a)) -> [Element] -> Result [Maybe a]
forall a b. (a -> Result b) -> [a] -> Result [b]
mapR Element -> Result (Maybe a)
forall a. XmlRepresentable a => Element -> Result (Maybe a)
fromXml ([Content] -> [Element]
onlyElems [Content]
elms)

mkElement :: QName -> [Attr] -> [Content] -> Content
mkElement :: QName -> [Attr] -> [Content] -> Content
mkElement qn :: QName
qn atts :: [Attr]
atts elems :: [Content]
elems = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ QName -> [Attr] -> [Content] -> Maybe Line -> Element
Element QName
qn [Attr]
atts [Content]
elems Maybe Line
forall a. Maybe a
Nothing

makeComment :: String -> Content
makeComment :: String -> Content
makeComment s :: String
s = CData -> Content
Text (CData -> Content) -> CData -> Content
forall a b. (a -> b) -> a -> b
$ CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataRaw ("<!-- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " -->") Maybe Line
forall a. Maybe a
Nothing

inAContent :: QName -> [Attr] -> Maybe Content -> Content
inAContent :: QName -> [Attr] -> Maybe Content -> Content
inAContent qn :: QName
qn a :: [Attr]
a c :: Maybe Content
c = QName -> [Attr] -> [Content] -> Content
mkElement QName
qn [Attr]
a ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ Maybe Content -> [Content]
forall a. Maybe a -> [a]
maybeToList Maybe Content
c

inContent :: QName -> Maybe Content -> Content
inContent :: QName -> Maybe Content -> Content
inContent qn :: QName
qn = QName -> [Attr] -> Maybe Content -> Content
inAContent QName
qn []

toOmobj :: Content -> Content
toOmobj :: Content -> Content
toOmobj c :: Content
c = QName -> [Attr] -> Maybe Content -> Content
inAContent QName
el_omobj [Attr
attr_om] (Maybe Content -> Content) -> Maybe Content -> Content
forall a b. (a -> b) -> a -> b
$ Content -> Maybe Content
forall a. a -> Maybe a
Just Content
c

-- * Encoding/Decoding

{- url escaping and unescaping.
We use ? and / as special characters, so we need them to be encoded in names -}
urlEscape :: String -> String
urlEscape :: String -> String
urlEscape = (Char -> Bool) -> String -> String
encodeBut (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` "%/?")

urlUnescape :: String -> String
urlUnescape :: String -> String
urlUnescape = String -> String
decode


-- to- and from-string functions

showCDName :: OMCD -> OMName -> String
showCDName :: OMCD -> OMName -> String
showCDName omcd :: OMCD
omcd omname :: OMName
omname = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [OMCD -> String
showCD OMCD
omcd, "?", OMName -> String
showOMName OMName
omname]

showCD :: OMCD -> String
showCD :: OMCD -> String
showCD cd :: OMCD
cd = let [x :: String
x, y :: String
y] = OMCD -> [String]
cdToList OMCD
cd
                 in [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
x, "?", String
y]

showOMName :: OMName -> String
showOMName :: OMName -> String
showOMName on :: OMName
on = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "/" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ OMName -> [String]
path OMName
on [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [OMName -> String
name OMName
on]


readCD :: Show a => a -> String -> OMCD
readCD :: a -> String -> OMCD
readCD _ s :: String
s = case Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
splitBy '?' String
s of
               [b :: String
b, cd :: String
cd] -> [String] -> OMCD
cdFromList [String
b, String
cd]
               _ -> String -> OMCD
forall a. HasCallStack => String -> a
error (String -> OMCD) -> String -> OMCD
forall a b. (a -> b) -> a -> b
$ "readCD: The value " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                            "has to contain exactly one '?'"

readCDName :: String -> OMQualName
readCDName :: String -> OMQualName
readCDName s :: String
s = case Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
splitBy '?' String
s of
                 (b :: String
b : cd :: String
cd : n :: String
n : []) -> ( [String] -> OMCD
cdFromList [String
b, String
cd]
                                , String -> OMName
readOMName String
n)
                 _ -> String -> OMQualName
forall a. HasCallStack => String -> a
error (String -> OMQualName) -> String -> OMQualName
forall a b. (a -> b) -> a -> b
$ "readCDName: The value " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                              "has to contain exactly two '?'"

readOMName :: String -> OMName
readOMName :: String -> OMName
readOMName s :: String
s = let l :: [String]
l = Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
splitBy '/' String
s
               in String -> [String] -> OMName
OMName ([String] -> String
forall a. [a] -> a
last [String]
l) ([String] -> OMName) -> [String] -> OMName
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
init [String]
l


-- encoding

{- only uri-fields need to be %-encoded, the following attribs are uri-fields:
theory@meta
include@from
structure@from
view@from
view@to
@base
-}

tripleEncodeOMS :: OMCD -> OMName -> [Attr]
tripleEncodeOMS :: OMCD -> OMName -> [Attr]
tripleEncodeOMS omcd :: OMCD
omcd omname :: OMName
omname
    = OMCD -> [Attr]
pairEncodeCD OMCD
omcd [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++ [QName -> String -> Attr
Attr QName
at_name (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ OMName -> String
showOMName OMName
omname]

pairEncodeCD :: OMCD -> [Attr]
pairEncodeCD :: OMCD -> [Attr]
pairEncodeCD cd :: OMCD
cd = let [base :: Maybe String
base, modl :: Maybe String
modl] = OMCD -> [Maybe String]
cdToMaybeList OMCD
cd
                  in [Maybe Attr] -> [Attr]
forall a. [Maybe a] -> [a]
catMaybes [ (String -> Attr) -> Maybe String -> Maybe Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QName -> String -> Attr
Attr QName
at_base (String -> Attr) -> (String -> String) -> String -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
urlEscape) Maybe String
base
                               , (String -> Attr) -> Maybe String -> Maybe Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QName -> String -> Attr
Attr QName
at_module) Maybe String
modl]

-- decoding

tripleDecodeOMS :: String -> String -> String -> (OMCD, OMName)
tripleDecodeOMS :: String -> String -> String -> OMQualName
tripleDecodeOMS cd :: String
cd base :: String
base nm :: String
nm =
    let cdl :: [String]
cdl = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String
cd, String -> String
urlUnescape String
base]
    in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cd Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
base)
       then String -> OMQualName
forall a. HasCallStack => String -> a
error "tripleDecodeOMS: base not empty but cd not given!"
       else ([String] -> OMCD
CD [String]
cdl, String -> OMName
readOMName String
nm)


warnIfNothing :: String -> (Maybe a -> b) -> Maybe a -> Result b
warnIfNothing :: String -> (Maybe a -> b) -> Maybe a -> Result b
warnIfNothing s :: String
s f :: Maybe a -> b
f v :: Maybe a
v = do
  String -> Bool -> Result ()
warnIf String
s (Bool -> Result ()) -> Bool -> Result ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
v
  b -> Result b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result b) -> b -> Result b
forall a b. (a -> b) -> a -> b
$ Maybe a -> b
f Maybe a
v

warnIf :: String -> Bool -> Result ()
warnIf :: String -> Bool -> Result ()
warnIf s :: String
s b :: Bool
b = Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$ () -> String -> Result ()
forall a. a -> String -> Result a
justWarn () String
s

elemIsOf :: Element -> QName -> Bool
elemIsOf :: Element -> QName -> Bool
elemIsOf e :: Element
e qn :: QName
qn = let en :: QName
en = Element -> QName
elName Element
e in
                (QName -> String
qName QName
en, QName -> Maybe String
qPrefix QName
en) (String, Maybe String) -> (String, Maybe String) -> Bool
forall a. Eq a => a -> a -> Bool
== (QName -> String
qName QName
qn, QName -> Maybe String
qPrefix QName
qn)

oneOfMsg :: Element -> [QName] -> String
oneOfMsg :: Element -> [QName] -> String
oneOfMsg e :: Element
e l :: [QName]
l = let printName :: QName -> String
printName = QName -> String
qName in
               [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ "Couldn't find expected element {"
                      , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ((QName -> String) -> [QName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map QName -> String
printName [QName]
l), "}"
                      , String -> (Line -> String) -> Maybe Line -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ((" at line " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Line -> String) -> Line -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> String
forall a. Show a => a -> String
show) (Element -> Maybe Line
elLine Element
e)
                      , " but found ", QName -> String
printName (QName -> String) -> QName -> String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e, "."
                      ]

-- * Monad and Maybe interaction

justReturn :: Monad m => a -> m (Maybe a)
justReturn :: a -> m (Maybe a)
justReturn = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just

fmapMaybe :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybe :: (a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybe f :: a -> m b
f v :: Maybe a
v = Maybe (m b) -> m (Maybe b)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
encapsMaybe (Maybe (m b) -> m (Maybe b)) -> Maybe (m b) -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ (a -> m b) -> Maybe a -> Maybe (m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m b
f Maybe a
v

fmapFromMaybe :: Monad m => (a -> m (Maybe b)) -> Maybe a -> m (Maybe b)
fmapFromMaybe :: (a -> m (Maybe b)) -> Maybe a -> m (Maybe b)
fmapFromMaybe f :: a -> m (Maybe b)
f = m (Maybe (Maybe b)) -> m (Maybe b)
forall (m :: * -> *) a.
Monad m =>
m (Maybe (Maybe a)) -> m (Maybe a)
flattenMaybe (m (Maybe (Maybe b)) -> m (Maybe b))
-> (Maybe a -> m (Maybe (Maybe b))) -> Maybe a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (Maybe b)) -> Maybe a -> m (Maybe (Maybe b))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybe a -> m (Maybe b)
f

encapsMaybe :: Monad m => Maybe (m a) -> m (Maybe a)
encapsMaybe :: Maybe (m a) -> m (Maybe a)
encapsMaybe v :: Maybe (m a)
v = case Maybe (m a)
v of
  Just x :: m a
x -> m a
x m a -> (a -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn
  _ -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

flattenMaybe :: Monad m => m (Maybe (Maybe a)) -> m (Maybe a)
flattenMaybe :: m (Maybe (Maybe a)) -> m (Maybe a)
flattenMaybe = (Maybe (Maybe a) -> Maybe a) -> m (Maybe (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe a -> Maybe (Maybe a) -> Maybe a
forall a. a -> Maybe a -> a
fromMaybe Maybe a
forall a. Maybe a
Nothing)


{- | Function to extract the Just values from maybes with a default missing
error in case of Nothing -}
missingMaybe :: String -> String -> Maybe a -> a
missingMaybe :: String -> String -> Maybe a -> a
missingMaybe el :: String
el misses :: String
misses =
    a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
el String -> String -> String
forall a. [a] -> [a] -> [a]
++ " element must have a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
misses String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".")


-- -- -- -- -- XmlRepresentable Class instances for OMDoc types -- -- -- -- --

-- | The root instance for representing OMDoc in XML
instance XmlRepresentable OMDoc where
    toXml :: OMDoc -> Content
toXml (OMDoc omname :: String
omname elms :: [TLElement]
elms) =
        QName -> [Attr] -> [Content] -> Content
mkElement
        QName
el_omdoc [QName -> String -> Attr
Attr QName
at_version String
omdoc_current_version, QName -> String -> Attr
Attr QName
at_name String
omname]
                     ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ [TLElement] -> [Content]
forall a. XmlRepresentable a => [a] -> [Content]
listToXml [TLElement]
elms
    fromXml :: Element -> Result (Maybe OMDoc)
fromXml e :: Element
e
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_omdoc =
            do
              String
nm <- String -> (Maybe String -> String) -> Maybe String -> Result String
forall a b. String -> (Maybe a -> b) -> Maybe a -> Result b
warnIfNothing "No name in omdoc element." (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "")
                    (Maybe String -> Result String) -> Maybe String -> Result String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_name Element
e
              String
vs <- String -> (Maybe String -> String) -> Maybe String -> Result String
forall a b. String -> (Maybe a -> b) -> Maybe a -> Result b
warnIfNothing "No version in omdoc element."
                    (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "1.6") (Maybe String -> Result String) -> Maybe String -> Result String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_version Element
e
              String -> Bool -> Result ()
warnIf "Wrong OMDoc version." (Bool -> Result ()) -> Bool -> Result ()
forall a b. (a -> b) -> a -> b
$ String
vs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
omdoc_current_version
              [TLElement]
tls <- [Content] -> Result [TLElement]
forall a. XmlRepresentable a => [Content] -> Result [a]
listFromXml ([Content] -> Result [TLElement])
-> [Content] -> Result [TLElement]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
              OMDoc -> Result (Maybe OMDoc)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OMDoc -> Result (Maybe OMDoc)) -> OMDoc -> Result (Maybe OMDoc)
forall a b. (a -> b) -> a -> b
$ String -> [TLElement] -> OMDoc
OMDoc String
nm [TLElement]
tls
        | Bool
otherwise = String -> Result (Maybe OMDoc)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "OMDoc fromXml: toplevel element is no omdoc."


-- | toplevel OMDoc elements to XML and back
instance XmlRepresentable TLElement where
    toXml :: TLElement -> Content
toXml (TLTheory tname :: String
tname meta :: Maybe OMCD
meta elms :: [TCElement]
elms) =
        QName -> [Attr] -> [Content] -> Content
mkElement
        QName
el_theory (QName -> String -> Attr
Attr QName
at_name String
tname Attr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
: case Maybe OMCD
meta of
          Nothing -> []
          Just mtcd :: OMCD
mtcd -> [QName -> String -> Attr
Attr QName
at_meta (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ String -> String
urlEscape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ OMCD -> String
showCD OMCD
mtcd])
        ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ [TCElement] -> [Content]
forall a. XmlRepresentable a => [a] -> [Content]
listToXml [TCElement]
elms
    toXml (TLView nm :: String
nm from :: OMCD
from to :: OMCD
to morph :: TCMorphism
morph) =
        QName -> [Attr] -> [Content] -> Content
mkElement
        QName
el_view [QName -> String -> Attr
Attr QName
at_name String
nm, QName -> String -> Attr
Attr QName
at_from (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ String -> String
urlEscape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ OMCD -> String
showCD OMCD
from,
                      QName -> String -> Attr
Attr QName
at_to (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ String -> String
urlEscape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ OMCD -> String
showCD OMCD
to]
                    ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ ((OMName, OMImage) -> Content) -> TCMorphism -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (OMName, OMImage) -> Content
assignmentToXml TCMorphism
morph

    fromXml :: Element -> Result (Maybe TLElement)
fromXml e :: Element
e
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_theory =
            let nm :: String
nm = String -> String -> Maybe String -> String
forall a. String -> String -> Maybe a -> a
missingMaybe "Theory" "name" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_name Element
e
                mt :: Maybe OMCD
mt = (String -> OMCD) -> Maybe String -> Maybe OMCD
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Line -> String -> OMCD
forall a. Show a => a -> String -> OMCD
readCD (Element -> Maybe Line
elLine Element
e) (String -> OMCD) -> (String -> String) -> String -> OMCD
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
urlUnescape) (Maybe String -> Maybe OMCD) -> Maybe String -> Maybe OMCD
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_meta Element
e
            in do
              [TCElement]
tcl <- [Content] -> Result [TCElement]
forall a. XmlRepresentable a => [Content] -> Result [a]
listFromXml ([Content] -> Result [TCElement])
-> [Content] -> Result [TCElement]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
              TLElement -> Result (Maybe TLElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (TLElement -> Result (Maybe TLElement))
-> TLElement -> Result (Maybe TLElement)
forall a b. (a -> b) -> a -> b
$ String -> Maybe OMCD -> [TCElement] -> TLElement
TLTheory String
nm Maybe OMCD
mt [TCElement]
tcl

        | Element -> QName -> Bool
elemIsOf Element
e QName
el_view =
            let musthave :: QName -> String -> String
musthave at :: QName
at s :: String
s = String -> String -> Maybe String -> String
forall a. String -> String -> Maybe a -> a
missingMaybe "View" String
s (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at Element
e
                nm :: String
nm = QName -> String -> String
musthave QName
at_name "name"
                from :: OMCD
from = Maybe Line -> String -> OMCD
forall a. Show a => a -> String -> OMCD
readCD (Element -> Maybe Line
elLine Element
e) (String -> OMCD) -> String -> OMCD
forall a b. (a -> b) -> a -> b
$ String -> String
urlUnescape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ QName -> String -> String
musthave QName
at_from "from"
                to :: OMCD
to = Maybe Line -> String -> OMCD
forall a. Show a => a -> String -> OMCD
readCD (Element -> Maybe Line
elLine Element
e) (String -> OMCD) -> String -> OMCD
forall a b. (a -> b) -> a -> b
$ String -> String
urlUnescape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ QName -> String -> String
musthave QName
at_to "to"
            in do
              TCMorphism
morph <- (Element -> Result (OMName, OMImage))
-> [Element] -> Result TCMorphism
forall a b. (a -> Result b) -> [a] -> Result [b]
mapR Element -> Result (OMName, OMImage)
xmlToAssignment (QName -> Element -> [Element]
findChildren QName
el_conass Element
e)
              TLElement -> Result (Maybe TLElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (TLElement -> Result (Maybe TLElement))
-> TLElement -> Result (Maybe TLElement)
forall a b. (a -> b) -> a -> b
$ String -> OMCD -> OMCD -> TCMorphism -> TLElement
TLView String
nm OMCD
from OMCD
to TCMorphism
morph
        | Bool
otherwise = Maybe TLElement -> Result (Maybe TLElement)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TLElement
forall a. Maybe a
Nothing

-- | theory constitutive OMDoc elements to XML and back
instance XmlRepresentable TCElement where
    toXml :: TCElement -> Content
toXml (TCSymbol sname :: String
sname symtype :: OMElement
symtype role :: SymbolRole
role defn :: Maybe OMElement
defn) =
        String -> String -> OMElement -> Maybe OMElement -> Content
constantToXml String
sname (SymbolRole -> String
forall a. Show a => a -> String
show SymbolRole
role) OMElement
symtype Maybe OMElement
defn
    toXml (TCNotation (cd :: OMCD
cd, nm :: OMName
nm) val :: String
val mStl :: Maybe String
mStl) =
        QName -> [Attr] -> Maybe Content -> Content
inAContent
        QName
el_notation
        ( [QName -> String -> Attr
Attr QName
at_for (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ String -> String
urlEscape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ OMCD -> OMName -> String
showCDName OMCD
cd OMName
nm, QName -> String -> Attr
Attr QName
at_role "constant"]
          [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++ [Attr] -> (String -> [Attr]) -> Maybe String -> [Attr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Attr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
: []) (Attr -> [Attr]) -> (String -> Attr) -> String -> [Attr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String -> Attr
Attr QName
at_style) Maybe String
mStl )
        (Maybe Content -> Content) -> Maybe Content -> Content
forall a b. (a -> b) -> a -> b
$ Content -> Maybe Content
forall a. a -> Maybe a
Just (Content -> Maybe Content) -> Content -> Maybe Content
forall a b. (a -> b) -> a -> b
$ QName -> [Attr] -> Maybe Content -> Content
inAContent QName
el_text [QName -> String -> Attr
Attr QName
at_value String
val] Maybe Content
forall a. Maybe a
Nothing
    toXml (TCSmartNotation (cd :: OMCD
cd, nm :: OMName
nm) fixity :: Fixity
fixity assoc :: Assoc
assoc prec :: Int
prec implicit :: Int
implicit) =
        QName -> [Attr] -> Maybe Content -> Content
inAContent
        QName
el_notation
        ( [ QName -> String -> Attr
Attr QName
at_for (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ String -> String
urlEscape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ OMCD -> OMName -> String
showCDName OMCD
cd OMName
nm
          , QName -> String -> Attr
Attr QName
at_role "application", QName -> String -> Attr
Attr QName
at_fixity (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Fixity -> String
forall a. Show a => a -> String
show Fixity
fixity
          , QName -> String -> Attr
Attr QName
at_precedence (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
prec ]
          [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++ (if Int
implicit Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [] else [QName -> String -> Attr
Attr QName
at_implicit (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
implicit])
          [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++ (if Assoc
assoc Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
== Assoc
NoneAssoc then [] else [QName -> String -> Attr
Attr QName
at_associativity
                                                          (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Assoc -> String
forall a. Show a => a -> String
show Assoc
assoc]) )
        Maybe Content
forall a. Maybe a
Nothing
    toXml (TCFlexibleNotation (cd :: OMCD
cd, nm :: OMName
nm) prec :: Int
prec comps :: [NotationComponent]
comps) =
        QName -> [Attr] -> [Content] -> Content
mkElement
        QName
el_notation
        [ QName -> String -> Attr
Attr QName
at_for (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ String -> String
urlEscape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ OMCD -> OMName -> String
showCDName OMCD
cd OMName
nm, QName -> String -> Attr
Attr QName
at_role "application"
        , QName -> String -> Attr
Attr QName
at_precedence (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
prec ] ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ (NotationComponent -> Content) -> [NotationComponent] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map NotationComponent -> Content
notationComponentToXml [NotationComponent]
comps
    toXml (TCADT sds :: [OmdADT]
sds) = QName -> [Attr] -> [Content] -> Content
mkElement QName
el_adt [] ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ [OmdADT] -> [Content]
forall a. XmlRepresentable a => [a] -> [Content]
listToXml [OmdADT]
sds
    toXml (TCComment c :: String
c) = String -> Content
makeComment String
c
    toXml (TCImport nm :: String
nm from :: OMCD
from morph :: TCMorphism
morph) =
        QName -> [Attr] -> [Content] -> Content
mkElement
        QName
el_structure [QName -> String -> Attr
Attr QName
at_name String
nm, QName -> String -> Attr
Attr QName
at_from (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ String -> String
urlEscape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ OMCD -> String
showCD OMCD
from]
                         ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ ((OMName, OMImage) -> Content) -> TCMorphism -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (OMName, OMImage) -> Content
assignmentToXml TCMorphism
morph

    fromXml :: Element -> Result (Maybe TCElement)
fromXml e :: Element
e
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_constant =
            let musthave :: String -> Maybe a -> a
musthave = String -> String -> Maybe a -> a
forall a. String -> String -> Maybe a -> a
missingMaybe "Constant"
                nm :: String
nm = String -> Maybe String -> String
forall a. String -> Maybe a -> a
musthave "name" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_name Element
e
                role :: SymbolRole
role = SymbolRole -> (String -> SymbolRole) -> Maybe String -> SymbolRole
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SymbolRole
Obj String -> SymbolRole
forall a. Read a => String -> a
read (Maybe String -> SymbolRole) -> Maybe String -> SymbolRole
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_role Element
e
            in do
              OMElement
typ <- (Maybe OMElement -> OMElement)
-> Result (Maybe OMElement) -> Result OMElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe OMElement -> OMElement
forall a. String -> Maybe a -> a
musthave "typ") (Result (Maybe OMElement) -> Result OMElement)
-> Result (Maybe OMElement) -> Result OMElement
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Result (Maybe OMElement)
omelementFrom QName
el_type Element
e
              Maybe OMElement
defn <- QName -> Element -> Result (Maybe OMElement)
omelementFrom QName
el_definition Element
e
              TCElement -> Result (Maybe TCElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (TCElement -> Result (Maybe TCElement))
-> TCElement -> Result (Maybe TCElement)
forall a b. (a -> b) -> a -> b
$ String -> OMElement -> SymbolRole -> Maybe OMElement -> TCElement
TCSymbol String
nm OMElement
typ SymbolRole
role Maybe OMElement
defn
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_notation =
            let musthave :: String -> Maybe a -> a
musthave = String -> String -> Maybe a -> a
forall a. String -> String -> Maybe a -> a
missingMaybe "Notation"
                nm :: String
nm = String -> String
urlUnescape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. String -> Maybe a -> a
musthave "for" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_for Element
e
                role :: String
role = String -> Maybe String -> String
forall a. String -> Maybe a -> a
musthave "role" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_role Element
e
                mStl :: Maybe String
mStl = QName -> Element -> Maybe String
findAttr QName
at_style Element
e
                text :: Element
text = String -> Maybe Element -> Element
forall a. String -> Maybe a -> a
musthave "text" (Maybe Element -> Element) -> Maybe Element -> Element
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Element
findChild QName
el_text Element
e
                val :: String
val = String -> Maybe String -> String
forall a. String -> Maybe a -> a
musthave "value" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_value Element
text
            in if String
role String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "constant"
               then TCElement -> Result (Maybe TCElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (TCElement -> Result (Maybe TCElement))
-> TCElement -> Result (Maybe TCElement)
forall a b. (a -> b) -> a -> b
$ OMQualName -> String -> Maybe String -> TCElement
TCNotation (String -> OMQualName
readCDName String
nm) String
val Maybe String
mStl
               else Maybe TCElement -> Result (Maybe TCElement)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TCElement
forall a. Maybe a
Nothing
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_structure =
            let musthave :: QName -> String -> String
musthave at :: QName
at s :: String
s = String -> String -> Maybe String -> String
forall a. String -> String -> Maybe a -> a
missingMaybe "Structure" String
s (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at Element
e
                nm :: String
nm = QName -> String -> String
musthave QName
at_name "name"
                from :: OMCD
from = Maybe Line -> String -> OMCD
forall a. Show a => a -> String -> OMCD
readCD (Element -> Maybe Line
elLine Element
e) (String -> OMCD) -> String -> OMCD
forall a b. (a -> b) -> a -> b
$ String -> String
urlUnescape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ QName -> String -> String
musthave QName
at_from "from"
            in do
              TCMorphism
morph <- (Element -> Result (OMName, OMImage))
-> [Element] -> Result TCMorphism
forall a b. (a -> Result b) -> [a] -> Result [b]
mapR Element -> Result (OMName, OMImage)
xmlToAssignment
                       ([Element] -> Result TCMorphism) -> [Element] -> Result TCMorphism
forall a b. (a -> b) -> a -> b
$ (QName -> Bool) -> Element -> [Element]
filterChildrenName (QName -> [QName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [QName
el_conass, QName
el_open]) Element
e
              TCElement -> Result (Maybe TCElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (TCElement -> Result (Maybe TCElement))
-> TCElement -> Result (Maybe TCElement)
forall a b. (a -> b) -> a -> b
$ String -> OMCD -> TCMorphism -> TCElement
TCImport String
nm OMCD
from TCMorphism
morph
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_adt =
            do
              [OmdADT]
sds <- [Content] -> Result [OmdADT]
forall a. XmlRepresentable a => [Content] -> Result [a]
listFromXml ([Content] -> Result [OmdADT]) -> [Content] -> Result [OmdADT]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
              TCElement -> Result (Maybe TCElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (TCElement -> Result (Maybe TCElement))
-> TCElement -> Result (Maybe TCElement)
forall a b. (a -> b) -> a -> b
$ [OmdADT] -> TCElement
TCADT [OmdADT]
sds
        | Bool
otherwise =
            String -> Result (Maybe TCElement)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> Result (Maybe TCElement))
-> String -> Result (Maybe TCElement)
forall a b. (a -> b) -> a -> b
$ Element -> [QName] -> String
oneOfMsg Element
e [QName
el_constant, QName
el_structure, QName
el_adt, QName
el_notation]


-- | OMDoc - Algebraic Data Types
instance XmlRepresentable OmdADT where
    toXml :: OmdADT -> Content
toXml (ADTSortDef n :: String
n b :: ADTType
b cs :: [OmdADT]
cs) =
        QName -> [Attr] -> [Content] -> Content
mkElement QName
el_sortdef
                      [QName -> String -> Attr
Attr QName
at_name String
n, QName -> String -> Attr
Attr QName
at_type (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ ADTType -> String
forall a. Show a => a -> String
show ADTType
b]
                      ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ [OmdADT] -> [Content]
forall a. XmlRepresentable a => [a] -> [Content]
listToXml [OmdADT]
cs
    toXml (ADTConstr n :: String
n args :: [OmdADT]
args) =
        QName -> [Attr] -> [Content] -> Content
mkElement QName
el_constructor [QName -> String -> Attr
Attr QName
at_name String
n] ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ [OmdADT] -> [Content]
forall a. XmlRepresentable a => [a] -> [Content]
listToXml [OmdADT]
args
    toXml (ADTArg t :: OMElement
t sel :: Maybe OmdADT
sel) =
        QName -> [Attr] -> [Content] -> Content
mkElement QName
el_argument [] ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ OMElement -> Content
typeToXml OMElement
t Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: case Maybe OmdADT
sel of
          Nothing -> []
          Just s :: OmdADT
s -> [OmdADT -> Content
forall a. XmlRepresentable a => a -> Content
toXml OmdADT
s]
    toXml (ADTSelector n :: String
n total :: Totality
total) =
        QName -> [Attr] -> [Content] -> Content
mkElement QName
el_selector [QName -> String -> Attr
Attr QName
at_name String
n, QName -> String -> Attr
Attr QName
at_total (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Totality -> String
forall a. Show a => a -> String
show Totality
total] []
    toXml (ADTInsort (d :: OMCD
d, n :: OMName
n)) =
        QName -> [Attr] -> [Content] -> Content
mkElement QName
el_insort [QName -> String -> Attr
Attr QName
at_for (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ OMCD -> OMName -> String
showCDName OMCD
d OMName
n] []

    fromXml :: Element -> Result (Maybe OmdADT)
fromXml e :: Element
e
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_sortdef =
            let musthave :: String -> QName -> String
musthave s :: String
s at :: QName
at = String -> String -> Maybe String -> String
forall a. String -> String -> Maybe a -> a
missingMaybe "Sortdef" String
s (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at Element
e
                nm :: String
nm = String -> QName -> String
musthave "name" QName
at_name
                typ :: ADTType
typ = String -> ADTType
forall a. Read a => String -> a
read (String -> ADTType) -> String -> ADTType
forall a b. (a -> b) -> a -> b
$ String -> QName -> String
musthave "type" QName
at_type
            in do
              [OmdADT]
entries <- [Content] -> Result [OmdADT]
forall a. XmlRepresentable a => [Content] -> Result [a]
listFromXml ([Content] -> Result [OmdADT]) -> [Content] -> Result [OmdADT]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
              OmdADT -> Result (Maybe OmdADT)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OmdADT -> Result (Maybe OmdADT))
-> OmdADT -> Result (Maybe OmdADT)
forall a b. (a -> b) -> a -> b
$ String -> ADTType -> [OmdADT] -> OmdADT
ADTSortDef String
nm ADTType
typ [OmdADT]
entries
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_constructor =
            do
              let nm :: String
nm = String -> String -> Maybe String -> String
forall a. String -> String -> Maybe a -> a
missingMaybe "Constructor" "name" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_name Element
e
              [OmdADT]
entries <- [Content] -> Result [OmdADT]
forall a. XmlRepresentable a => [Content] -> Result [a]
listFromXml ([Content] -> Result [OmdADT]) -> [Content] -> Result [OmdADT]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
              OmdADT -> Result (Maybe OmdADT)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OmdADT -> Result (Maybe OmdADT))
-> OmdADT -> Result (Maybe OmdADT)
forall a b. (a -> b) -> a -> b
$ String -> [OmdADT] -> OmdADT
ADTConstr String
nm [OmdADT]
entries
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_argument =
            do
              OMElement
typ <- (Maybe OMElement -> OMElement)
-> Result (Maybe OMElement) -> Result OMElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> Maybe OMElement -> OMElement
forall a. String -> String -> Maybe a -> a
missingMaybe "Argument" "typ")
                     (Result (Maybe OMElement) -> Result OMElement)
-> Result (Maybe OMElement) -> Result OMElement
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Result (Maybe OMElement)
omelementFrom QName
el_type Element
e
              Maybe OmdADT
sel <- (Element -> Result (Maybe OmdADT))
-> Maybe Element -> Result (Maybe OmdADT)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Maybe a -> m (Maybe b)
fmapFromMaybe Element -> Result (Maybe OmdADT)
forall a. XmlRepresentable a => Element -> Result (Maybe a)
fromXml (Maybe Element -> Result (Maybe OmdADT))
-> Maybe Element -> Result (Maybe OmdADT)
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Element
findChild QName
el_selector Element
e
              OmdADT -> Result (Maybe OmdADT)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OmdADT -> Result (Maybe OmdADT))
-> OmdADT -> Result (Maybe OmdADT)
forall a b. (a -> b) -> a -> b
$ OMElement -> Maybe OmdADT -> OmdADT
ADTArg OMElement
typ Maybe OmdADT
sel
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_selector =
            let musthave :: String -> QName -> String
musthave s :: String
s at :: QName
at = String -> String -> Maybe String -> String
forall a. String -> String -> Maybe a -> a
missingMaybe "Selector" String
s (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at Element
e
                nm :: String
nm = String -> QName -> String
musthave "name" QName
at_name
                total :: Totality
total = String -> Totality
forall a. Read a => String -> a
read (String -> Totality) -> String -> Totality
forall a b. (a -> b) -> a -> b
$ String -> QName -> String
musthave "total" QName
at_total
            in OmdADT -> Result (Maybe OmdADT)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OmdADT -> Result (Maybe OmdADT))
-> OmdADT -> Result (Maybe OmdADT)
forall a b. (a -> b) -> a -> b
$ String -> Totality -> OmdADT
ADTSelector String
nm Totality
total
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_insort =
            do
              let nm :: String
nm = String -> String -> Maybe String -> String
forall a. String -> String -> Maybe a -> a
missingMaybe "Insort" "for" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_for Element
e
              OmdADT -> Result (Maybe OmdADT)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OmdADT -> Result (Maybe OmdADT))
-> OmdADT -> Result (Maybe OmdADT)
forall a b. (a -> b) -> a -> b
$ OMQualName -> OmdADT
ADTInsort (OMQualName -> OmdADT) -> OMQualName -> OmdADT
forall a b. (a -> b) -> a -> b
$ String -> OMQualName
readCDName String
nm
        | Bool
otherwise =
            String -> Result (Maybe OmdADT)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> Result (Maybe OmdADT))
-> String -> Result (Maybe OmdADT)
forall a b. (a -> b) -> a -> b
$ Element -> [QName] -> String
oneOfMsg Element
e [ QName
el_sortdef, QName
el_constructor, QName
el_argument
                              , QName
el_selector, QName
el_insort]


-- | OpenMath elements to XML and back
instance XmlRepresentable OMElement where
    toXml :: OMElement -> Content
toXml (OMS (d :: OMCD
d, n :: OMName
n)) = QName -> [Attr] -> [Content] -> Content
mkElement QName
el_oms (OMCD -> OMName -> [Attr]
tripleEncodeOMS OMCD
d OMName
n) []
    toXml (OMV n :: OMName
n) = QName -> [Attr] -> [Content] -> Content
mkElement QName
el_omv [QName -> String -> Attr
Attr QName
at_name (OMName -> String
name OMName
n)] []
    toXml (OMATTT elm :: OMElement
elm attr :: OMAttribute
attr) = QName -> [Attr] -> [Content] -> Content
mkElement QName
el_omattr [] [OMAttribute -> Content
forall a. XmlRepresentable a => a -> Content
toXml OMAttribute
attr, OMElement -> Content
forall a. XmlRepresentable a => a -> Content
toXml OMElement
elm]
    toXml (OMA args :: [OMElement]
args) = QName -> [Attr] -> [Content] -> Content
mkElement QName
el_oma [] ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ [OMElement] -> [Content]
forall a. XmlRepresentable a => [a] -> [Content]
listToXml [OMElement]
args
    toXml (OMBIND symb :: OMElement
symb vars :: [OMElement]
vars body :: OMElement
body) =
        QName -> [Attr] -> [Content] -> Content
mkElement QName
el_ombind []
                      [ OMElement -> Content
forall a. XmlRepresentable a => a -> Content
toXml OMElement
symb
                      , QName -> [Attr] -> [Content] -> Content
mkElement QName
el_ombvar [] ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ [OMElement] -> [Content]
forall a. XmlRepresentable a => [a] -> [Content]
listToXml [OMElement]
vars
                      , OMElement -> Content
forall a. XmlRepresentable a => a -> Content
toXml OMElement
body]

    fromXml :: Element -> Result (Maybe OMElement)
fromXml e :: Element
e
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_oms =
            let nm :: String
nm = String -> String -> Maybe String -> String
forall a. String -> String -> Maybe a -> a
missingMaybe "OMS" "name" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_name Element
e
                omcd :: String
omcd = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_module Element
e
                cdb :: String
cdb = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_base Element
e
            in OMElement -> Result (Maybe OMElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OMElement -> Result (Maybe OMElement))
-> OMElement -> Result (Maybe OMElement)
forall a b. (a -> b) -> a -> b
$ OMQualName -> OMElement
OMS (OMQualName -> OMElement) -> OMQualName -> OMElement
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> OMQualName
tripleDecodeOMS String
omcd String
cdb String
nm
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_omv =
            let nm :: String
nm = String -> String -> Maybe String -> String
forall a. String -> String -> Maybe a -> a
missingMaybe "OMV" "name" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_name Element
e
            in OMElement -> Result (Maybe OMElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OMElement -> Result (Maybe OMElement))
-> OMElement -> Result (Maybe OMElement)
forall a b. (a -> b) -> a -> b
$ OMName -> OMElement
OMV (OMName -> OMElement) -> OMName -> OMElement
forall a b. (a -> b) -> a -> b
$ String -> OMName
readOMName String
nm
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_omattr =
            let [atp :: Element
atp, el :: Element
el] = Element -> [Element]
elChildren Element
e
                musthave :: String -> Maybe a -> a
musthave = String -> String -> Maybe a -> a
forall a. String -> String -> Maybe a -> a
missingMaybe "OMATTR"
            in do
              Maybe OMAttribute
atp' <- Element -> Result (Maybe OMAttribute)
forall a. XmlRepresentable a => Element -> Result (Maybe a)
fromXml Element
atp
              Maybe OMElement
el' <- Element -> Result (Maybe OMElement)
forall a. XmlRepresentable a => Element -> Result (Maybe a)
fromXml Element
el
              OMElement -> Result (Maybe OMElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OMElement -> Result (Maybe OMElement))
-> OMElement -> Result (Maybe OMElement)
forall a b. (a -> b) -> a -> b
$ OMElement -> OMAttribute -> OMElement
OMATTT (String -> Maybe OMElement -> OMElement
forall a. String -> Maybe a -> a
musthave "attributed value" Maybe OMElement
el')
                             (String -> Maybe OMAttribute -> OMAttribute
forall a. String -> Maybe a -> a
musthave "attribution" Maybe OMAttribute
atp')
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_oma =
            do
              [OMElement]
entries <- [Content] -> Result [OMElement]
forall a. XmlRepresentable a => [Content] -> Result [a]
listFromXml ([Content] -> Result [OMElement])
-> [Content] -> Result [OMElement]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
              OMElement -> Result (Maybe OMElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OMElement -> Result (Maybe OMElement))
-> OMElement -> Result (Maybe OMElement)
forall a b. (a -> b) -> a -> b
$ [OMElement] -> OMElement
OMA [OMElement]
entries
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_ombind =
            let [bd :: Element
bd, bvar :: Element
bvar, body :: Element
body] = Element -> [Element]
elChildren Element
e
                musthave :: String -> Maybe a -> a
musthave = String -> String -> Maybe a -> a
forall a. String -> String -> Maybe a -> a
missingMaybe "OMBIND"
            in do
              Maybe OMElement
bd' <- Element -> Result (Maybe OMElement)
forall a. XmlRepresentable a => Element -> Result (Maybe a)
fromXml Element
bd
              [OMElement]
bvar' <- [Content] -> Result [OMElement]
forall a. XmlRepresentable a => [Content] -> Result [a]
listFromXml ([Content] -> Result [OMElement])
-> [Content] -> Result [OMElement]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
bvar
              Maybe OMElement
body' <- Element -> Result (Maybe OMElement)
forall a. XmlRepresentable a => Element -> Result (Maybe a)
fromXml Element
body
              OMElement -> Result (Maybe OMElement)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OMElement -> Result (Maybe OMElement))
-> OMElement -> Result (Maybe OMElement)
forall a b. (a -> b) -> a -> b
$ OMElement -> [OMElement] -> OMElement -> OMElement
OMBIND (String -> Maybe OMElement -> OMElement
forall a. String -> Maybe a -> a
musthave "binder" Maybe OMElement
bd') [OMElement]
bvar'
                             (String -> Maybe OMElement -> OMElement
forall a. String -> Maybe a -> a
musthave "body" Maybe OMElement
body')
        | Bool
otherwise =
            String -> Result (Maybe OMElement)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> Result (Maybe OMElement))
-> String -> Result (Maybe OMElement)
forall a b. (a -> b) -> a -> b
$ Element -> [QName] -> String
oneOfMsg Element
e [QName
el_oms, QName
el_omv, QName
el_omattr, QName
el_oma, QName
el_ombind]


-- | Helper instance for OpenMath attributes
instance XmlRepresentable OMAttribute where
    toXml :: OMAttribute -> Content
toXml (OMAttr e1 :: OMElement
e1 e2 :: OMElement
e2) = QName -> [Attr] -> [Content] -> Content
mkElement QName
el_omatp [] [OMElement -> Content
forall a. XmlRepresentable a => a -> Content
toXml OMElement
e1, OMElement -> Content
forall a. XmlRepresentable a => a -> Content
toXml OMElement
e2]
    fromXml :: Element -> Result (Maybe OMAttribute)
fromXml e :: Element
e
        | Element -> QName -> Bool
elemIsOf Element
e QName
el_omatp =
            do
              [key :: OMElement
key, val :: OMElement
val] <- [Content] -> Result [OMElement]
forall a. XmlRepresentable a => [Content] -> Result [a]
listFromXml ([Content] -> Result [OMElement])
-> [Content] -> Result [OMElement]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
              OMAttribute -> Result (Maybe OMAttribute)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
justReturn (OMAttribute -> Result (Maybe OMAttribute))
-> OMAttribute -> Result (Maybe OMAttribute)
forall a b. (a -> b) -> a -> b
$ OMElement -> OMElement -> OMAttribute
OMAttr OMElement
key OMElement
val
        | Bool
otherwise =
            String -> Result (Maybe OMAttribute)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> Result (Maybe OMAttribute))
-> String -> Result (Maybe OMAttribute)
forall a b. (a -> b) -> a -> b
$ Element -> [QName] -> String
oneOfMsg Element
e [QName
el_omatp]


-- * fromXml methods

{- | If the child element with given name contains an OMOBJ xml element,
this is transformed to an OMElement. -}
omelementFrom :: QName -> Element -> Result (Maybe OMElement)
omelementFrom :: QName -> Element -> Result (Maybe OMElement)
omelementFrom qn :: QName
qn e :: Element
e = (Element -> Result (Maybe OMElement))
-> Maybe Element -> Result (Maybe OMElement)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Maybe a -> m (Maybe b)
fmapFromMaybe Element -> Result (Maybe OMElement)
omelementFromOmobj (Maybe Element -> Result (Maybe OMElement))
-> Maybe Element -> Result (Maybe OMElement)
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Element
findChild QName
qn Element
e

omelementFromOmobj :: Element -> Result (Maybe OMElement)
omelementFromOmobj :: Element -> Result (Maybe OMElement)
omelementFromOmobj e :: Element
e = (Element -> Result OMElement)
-> Maybe Element -> Result (Maybe OMElement)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybe Element -> Result OMElement
omobjToOMElement (Maybe Element -> Result (Maybe OMElement))
-> Maybe Element -> Result (Maybe OMElement)
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Element
findChild QName
el_omobj Element
e

-- | Get an OMElement from an OMOBJ xml element
omobjToOMElement :: Element -> Result OMElement
omobjToOMElement :: Element -> Result OMElement
omobjToOMElement e :: Element
e = case Element -> [Element]
elChildren Element
e of
                       [om :: Element
om] ->
                           do
                             Maybe OMElement
omelem <- Element -> Result (Maybe OMElement)
forall a. XmlRepresentable a => Element -> Result (Maybe a)
fromXml Element
om
                             case Maybe OMElement
omelem of
                               Nothing -> String -> Result OMElement
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail
                                   (String -> Result OMElement) -> String -> Result OMElement
forall a b. (a -> b) -> a -> b
$ "omobjToOMElement: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                     "No OpenMath element found."
                               Just x :: OMElement
x -> OMElement -> Result OMElement
forall (m :: * -> *) a. Monad m => a -> m a
return OMElement
x
                       _ -> String -> Result OMElement
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "OMOBJ element must have a unique child."


-- | The input is assumed to be a conass element
xmlToAssignment :: Element -> Result (OMName, OMImage)
xmlToAssignment :: Element -> Result (OMName, OMImage)
xmlToAssignment e :: Element
e
    | Element -> QName
elName Element
e QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
el_open =
        let musthave :: String -> Maybe a -> a
musthave = String -> String -> Maybe a -> a
forall a. String -> String -> Maybe a -> a
missingMaybe "Open"
            nm :: String
nm = String -> Maybe String -> String
forall a. String -> Maybe a -> a
musthave "name" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_name Element
e
            alias :: String
alias = String -> Maybe String -> String
forall a. String -> Maybe a -> a
musthave "as" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_as Element
e
        in (OMName, OMImage) -> Result (OMName, OMImage)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> OMName
readOMName String
nm, String -> OMImage
forall a b. a -> Either a b
Left String
alias)
    | Element -> QName
elName Element
e QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
el_conass =
        let musthave :: String -> Maybe a -> a
musthave = String -> String -> Maybe a -> a
forall a. String -> String -> Maybe a -> a
missingMaybe "Conass"
            nm :: String
nm = String -> Maybe String -> String
forall a. String -> Maybe a -> a
musthave "name" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr QName
at_name Element
e
        in do
          Maybe OMElement
omel <- Element -> Result (Maybe OMElement)
omelementFromOmobj Element
e
          (OMName, OMImage) -> Result (OMName, OMImage)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> OMName
readOMName String
nm, OMElement -> OMImage
forall a b. b -> Either a b
Right (OMElement -> OMImage) -> OMElement -> OMImage
forall a b. (a -> b) -> a -> b
$ String -> Maybe OMElement -> OMElement
forall a. String -> Maybe a -> a
musthave "OMOBJ element" Maybe OMElement
omel)
    | Bool
otherwise = String -> Result (OMName, OMImage)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> Result (OMName, OMImage))
-> String -> Result (OMName, OMImage)
forall a b. (a -> b) -> a -> b
$ Element -> [QName] -> String
oneOfMsg Element
e [QName
el_conass, QName
el_open]


-- * toXml methods

typeToXml :: OMElement -> Content
typeToXml :: OMElement -> Content
typeToXml t :: OMElement
t = QName -> Maybe Content -> Content
inContent QName
el_type (Maybe Content -> Content) -> Maybe Content -> Content
forall a b. (a -> b) -> a -> b
$ Content -> Maybe Content
forall a. a -> Maybe a
Just (Content -> Maybe Content) -> Content -> Maybe Content
forall a b. (a -> b) -> a -> b
$ Content -> Content
toOmobj (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ OMElement -> Content
forall a. XmlRepresentable a => a -> Content
toXml OMElement
t

assignmentToXml :: (OMName, OMImage) -> Content
assignmentToXml :: (OMName, OMImage) -> Content
assignmentToXml (from :: OMName
from, to :: OMImage
to) =
    case OMImage
to of
      Left s :: String
s ->
          QName -> [Attr] -> [Content] -> Content
mkElement QName
el_open [QName -> String -> Attr
Attr QName
at_name (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ OMName -> String
showOMName OMName
from, QName -> String -> Attr
Attr QName
at_as String
s] []
      Right obj :: OMElement
obj ->
          QName -> [Attr] -> Maybe Content -> Content
inAContent QName
el_conass [QName -> String -> Attr
Attr QName
at_name (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ OMName -> String
showOMName OMName
from]
                         (Maybe Content -> Content) -> Maybe Content -> Content
forall a b. (a -> b) -> a -> b
$ Content -> Maybe Content
forall a. a -> Maybe a
Just (Content -> Maybe Content)
-> (OMElement -> Content) -> OMElement -> Maybe Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Content
toOmobj (Content -> Content)
-> (OMElement -> Content) -> OMElement -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMElement -> Content
forall a. XmlRepresentable a => a -> Content
toXml (OMElement -> Maybe Content) -> OMElement -> Maybe Content
forall a b. (a -> b) -> a -> b
$ OMElement
obj

constantToXml :: String -> String -> OMElement -> Maybe OMElement -> Content
constantToXml :: String -> String -> OMElement -> Maybe OMElement -> Content
constantToXml n :: String
n r :: String
r tp :: OMElement
tp prf :: Maybe OMElement
prf =
    Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ QName -> [Attr] -> [Content] -> Maybe Line -> Element
Element QName
el_constant
             [QName -> String -> Attr
Attr QName
at_name String
n, QName -> String -> Attr
Attr QName
at_role String
r]
             (OMElement -> Content
typeToXml OMElement
tp
              Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: (OMElement -> Content) -> [OMElement] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (QName -> Maybe Content -> Content
inContent QName
el_definition (Maybe Content -> Content)
-> (OMElement -> Maybe Content) -> OMElement -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Maybe Content
forall a. a -> Maybe a
Just (Content -> Maybe Content)
-> (OMElement -> Content) -> OMElement -> Maybe Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Content
toOmobj (Content -> Content)
-> (OMElement -> Content) -> OMElement -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMElement -> Content
forall a. XmlRepresentable a => a -> Content
toXml)
                    (Maybe OMElement -> [OMElement]
forall a. Maybe a -> [a]
maybeToList Maybe OMElement
prf))
             Maybe Line
forall a. Maybe a
Nothing


notationComponentToXml :: NotationComponent -> Content
notationComponentToXml :: NotationComponent -> Content
notationComponentToXml (TextComp val :: String
val) = QName -> [Attr] -> [Content] -> Content
mkElement QName
el_text [QName -> String -> Attr
Attr QName
at_value String
val] []
notationComponentToXml (ArgComp ind :: Int
ind prec :: Int
prec) =
    QName -> [Attr] -> [Content] -> Content
mkElement QName
el_component [ QName -> String -> Attr
Attr QName
at_index (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
ind
                           , QName -> String -> Attr
Attr QName
at_precedence (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
prec] []