-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me 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 Util.XML where

import Data.List
import Domain.Math.Expr.Data
import Ideas.Common.Rewriting
import Data.Maybe
import Ideas.Encoding.OpenMathSupport
import Ideas.Text.OpenMath.Object
import Ideas.Text.XML
import Ideas.Text.HTML (ToHTML(..))

unescape :: String -> String
unescape [] = []
unescape xs@(y:ys) | "&lt;" `isPrefixOf` xs   = '<' : unescape (drop 4 xs)
                   | "&gt;" `isPrefixOf` xs   = '>' : unescape (drop 4 xs)
                   | "&amp;" `isPrefixOf` xs  = '&' : unescape (drop 5 xs)
                   | "&quot;" `isPrefixOf` xs = '\"' : unescape (drop 6 xs)
                   | "&apos;" `isPrefixOf` xs = '\'' : unescape (drop 6 xs)
                   | "&#10;" `isPrefixOf` xs  = '\n' : unescape (drop 5 xs)
                   | otherwise                = y : unescape ys

unescapeAttr :: String -> String
unescapeAttr [] = []
unescapeAttr xs@(y:ys)
              | "&lt;" `isPrefixOf` xs   = '<' : unescapeAttr (drop 4 xs)
              | "&amp;" `isPrefixOf` xs   = '&' : unescapeAttr (drop 5 xs)
              | "&quot;" `isPrefixOf` xs   = '\"' : unescapeAttr (drop 6 xs)
              | otherwise                = y : unescape ys

instance (ToXML a, ToXML b) => ToXML (Either a b) where
  toXML (Left x)  = makeXML "either_left"  $ builderXML x
  toXML (Right x) = makeXML "either_right" $ builderXML x

instance (InXML a, InXML b) => InXML (Either a b) where
  fromXML xml =
     case children xml of
        [a] | name xml == "either_left"  -> Left  <$> fromXML a
            | name xml == "either_right" -> Right <$> fromXML a
        _ -> fail "invalid xml for Either type"

instance ToXML Expr where
   toXML ex = toXML (toOMOBJ (fromJust (fromExpr ex) :: Term))

instance ToHTML Expr where
 toHTML = mempty

instance InXML Expr where
 fromXML ex = case xml2omobj ex of
                 Left e -> fail ("Util.XML:InXML.Expr : " ++ e)
                 Right r -> pure (let x :: Term
                                      x = fromJust (fromOMOBJ r)
                                  in toExpr x)