-----------------------------------------------------------------------------

-- Copyright 2018, Ideas project team. This file is distributed under the

-- terms of the Apache License 2.0. For more information, see the files

-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.

-----------------------------------------------------------------------------

-- |

-- Maintainer  :  bastiaan.heeren@ou.nl

-- Stability   :  provisional

-- Portability :  portable (depends on ghc)

--

-----------------------------------------------------------------------------



module Ideas.Text.MathML

   ( MathML(..), xml2mathml, mathml2xml

   ) where



import Data.Either

import Data.Maybe

import Ideas.Text.XML

import Ideas.Utils.Uniplate hiding (children)



data MathML = MRow [MathML]

            | MId String

            | MNumber String

            | MOperator String

            | MString String

            | MText String

            | MSqrt MathML

            | MRoot MathML MathML

            | MSup MathML MathML -- base, superscript

            | MSub MathML MathML -- base, subscript

            | MSubSup MathML MathML MathML -- base, subscript, superscript

            | MFrac MathML MathML -- numerator, denominator

            | MFenced String String MathML -- left, right, content

            | MSpace

            | MStyle

            | MPadded

            | MPhantom

            | MError

            | MEnclose

            | MUnder

            | MOver

            | MUnderOver

            | MTable

            | MTableRow

            | MLabeledTableRow

            | MTableData

   deriving (Show, Eq)

{-
from: https://www.w3.org/TR/MathML2/chapter3.html#presm.mn @ 3.2.1
Conversely, since mn is a presentation element, there are a few situations where it may desirable to include arbitrary text in the content of an mn that should merely render as a numeric literal
-}



instance InXML MathML where

   toXML   = mathml2xml

   fromXML = either fail return . xml2mathml



instance Uniplate MathML where

   uniplate math =

      case math of

         MRow xs       -> plate MRow ||* xs

         _             -> plate math



----------------------------------------------------------

-- conversion functions: XML <-> MathML



xml2mathml :: XML -> Either String MathML

xml2mathml = rec

 where

   rec xml = case xml of

       Element "mrow" _ _ -> MRow <$> mapM rec (children xml)

       Element "mi" _ [Left s] -> return (MId s)

       Element "mn" _ [Left s] -> return (MNumber s)

       Element "mo" _ [Left s] -> return (MOperator s)

       Element "ms" _ [Left s] -> return (MString s)

       Element "mtext" _ [] -> return (MText "")

       Element "mtext" _ [Left s] -> return (MText s)

       Element "mroot" _ [Right c, Right d] -> MRoot <$> rec c <*> rec d

       Element "msup" _ [Right c, Right d] -> MSup <$> rec c <*> rec d

       Element "msub" _ [Right c, Right d] -> MSub <$> rec c <*> rec d

       Element "msubsup" _ [Right c, Right d, Right e] -> MSubSup <$> rec c <*> rec d <*> rec e

       Element "mfrac" _ [Right c, Right d] -> MFrac <$> rec c <*> rec d

       Element "mfenced" _ [Right c] -> MFenced (fromMaybe "(" (findAttribute "open" xml)) (fromMaybe ")" (findAttribute "close" xml)) <$> rec c

       Element "mspace" _ _ -> return MSpace

       Element "mtable" _ _ -> return MTable

       Element "mtr" _ _ -> return MTableRow

       Element "mlabeledtr" _ _ -> return MLabeledTableRow

       Element "munder" _ _ -> return MUnder

       Element "mover" _ _ -> return MOver

       Element "munderover" _ _ -> return MUnderOver

       -- below are cases that have 1* arguments, when none-one an mrow is implied.

       Element "math" _ xs -> impliedMRow xs

       Element "msqrt" _ xs -> MSqrt <$> impliedMRow xs

       Element "mphantom" _ _ -> return MPhantom

       Element "mpadded" _ _ -> return MPadded

       Element "mstyle" _ _ -> return MStyle

       Element "merror" _ _ -> return MError

       Element "mtd" _ _ -> return MTableData

       Element "menclose" _ _ -> return MEnclose

       _ -> fail ("unsupported MathML: " ++ show xml)

   impliedMRow :: [Either String Element] -> Either String MathML

   impliedMRow [Right r] = rec r

   impliedMRow xs = MRow <$> mapM rec (rights xs)



mathml2xml :: MathML -> XML

mathml2xml = makeXML "math" . rec

 where

   rec :: MathML -> XMLBuilder

   rec math =

      case math of

         MRow ms           -> element "mrow" (map rec ms)

         MId s             -> element "mi" [string s]

         MNumber s         -> element "mn" [string s]

         MOperator s       -> element "mo" [string s]

         MString s         -> element "ms" [string s]

         MText s           -> element "mtext" [string s]

         MSqrt m           -> element "msqrt" [rec m]

         MRoot m1 m2       -> element "mroot" [rec m1, rec m2]

         MSup m1 m2        -> element "msup" [rec m1, rec m2]

         MSub m1 m2        -> element "msub" [rec m1, rec m2]

         MSubSup m1 m2 m3  -> element "msubsup" [rec m1, rec m2, rec m3]

         MFrac m1 m2       -> element "mfrac" [rec m1, rec m2]

         MFenced s1 s2 m   -> element "mfenced" ["open" .=. s1, "close" .=. s2, rec m]

         MSpace            -> element "mspace" []

         MStyle            -> element "mstyle" []

         MPadded           -> element "mpadded" []

         MPhantom          -> element "mphantom" []

         MError            -> element "merror" []

         MEnclose          -> element "menclose" []

         MUnder            -> element "munder" []

         MOver             -> element "mover" []

         MUnderOver        -> element "munderover" []

         MTable            -> element "mtable" []

         MTableRow         -> element "mtr" []

         MLabeledTableRow  -> element "mlabeledtr" []

         MTableData        -> element "mtd" []