module Ideas.Text.OpenMath.Object
( OMOBJ(..), getOMVs, xml2omobj, omobj2xml
) where
import Data.Char
import Data.Generics.Uniplate.Direct hiding (children)
import Data.List (nub)
import Data.Maybe
import Ideas.Text.OpenMath.Symbol
import Ideas.Text.XML
data OMOBJ = OMI Integer
| OMF Double
| OMV String
| OMS Symbol
| OMA [OMOBJ]
| OMBIND OMOBJ [String] OMOBJ
deriving (Show, Eq)
instance ToXML OMOBJ where
toXML = omobj2xml
instance InXML OMOBJ where
fromXML = either fail return . xml2omobj
instance Uniplate OMOBJ where
uniplate omobj =
case omobj of
OMA xs -> plate OMA ||* xs
OMBIND a ss b -> plate OMBIND |* a |- ss |* b
_ -> plate omobj
getOMVs :: OMOBJ -> [String]
getOMVs omobj = nub [ x | OMV x <- universe omobj ]
xml2omobj :: XML -> Either String OMOBJ
xml2omobj xmlTop
| name xmlTop == "OMOBJ" =
case children xmlTop of
[x] -> rec x
_ -> fail "invalid omobj"
| otherwise = fail "expected an OMOBJ tag"
where
rec xml =
case name xml of
"OMA" -> do
ys <- mapM rec (children xml)
return (OMA ys)
"OMS" | emptyContent xml -> do
let mcd = case findAttribute "cd" xml of
Just "unknown" -> Nothing
this -> this
n <- findAttribute "name" xml
return (OMS (mcd, n))
"OMI" | name xml == "OMI" ->
case readInt (getData xml) of
Just i -> return (OMI (toInteger i))
_ -> fail "invalid integer in OMI"
"OMF" | emptyContent xml -> do
s <- findAttribute "dec" xml
case readDouble s of
Just nr -> return (OMF nr)
_ -> fail "invalid floating-point in OMF"
"OMV" | emptyContent xml -> do
s <- findAttribute "name" xml
return (OMV s)
"OMBIND" ->
case children xml of
[x1, x2, x3] -> do
y1 <- rec x1
y2 <- recOMBVAR x2
y3 <- rec x3
return (OMBIND y1 y2 y3)
_ -> fail "invalid ombind"
_ -> fail ("invalid tag " ++ name xml)
recOMBVAR xml
| name xml == "OMBVAR" =
let f (Right (OMV s)) = return s
f this = fail $ "expected tag OMV in OMBVAR, but found " ++ show this
in mapM (f . rec) (children xml)
| otherwise =
fail ("expected tag OMVAR, but found " ++ show (name xml))
omobj2xml :: OMOBJ -> XML
omobj2xml object = makeXML "OMOBJ" $ mconcat
[ "xmlns" .=. "http://www.openmath.org/OpenMath"
, "version" .=. "2.0"
, "cdbase" .=. "http://www.openmath.org/cd"
, rec object
]
where
rec :: OMOBJ -> XMLBuilder
rec omobj =
case omobj of
OMI i -> element "OMI" [text i]
OMF f -> element "OMF" ["dec" .=. show f]
OMV v -> element "OMV" ["name" .=. v]
OMA xs -> element "OMA" (map rec xs)
OMS s -> element "OMS"
[ "cd" .=. fromMaybe "unknown" (dictionary s)
, "name" .=. symbolName s
]
OMBIND x ys z -> element "OMBIND"
[ rec x
, element "OMBVAR" (map (rec . OMV) ys)
, rec z
]
readInt :: String -> Maybe Integer
readInt s = case reads s of
[(n, xs)] | all isSpace xs -> Just n
_ -> Nothing
readDouble :: String -> Maybe Double
readDouble s = case reads s of
[(n, xs)] | all isSpace xs -> Just n
_ -> Nothing