module MPS.Heavy where

import Codec.Binary.Base64.String as C
import Data.Char
import MPS.Light
import Prelude hiding ((.), (^), (>), (/), elem, foldl)
import Text.ParserCombinators.Parsec (many, char, many1, digit, (<|>), Parser, anyChar, try)
import qualified Codec.Compression.GZip as GZip
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Text.ParserCombinators.Parsec as P


-- compress

zip64, unzip64 :: String -> String
zip64 = B.pack > GZip.compress > B.unpack > C.encode
unzip64 = C.decode > B.pack > GZip.decompress > B.unpack
  
-- Parser
parse :: P.GenParser tok () a -> [tok] -> a
parse p s = case (P.parse p "" s) of
  Left err -> err.show.error
  Right x  -> x


-- XML
unescape_xml, escape_xml :: String -> String
unescape_xml s = parse unescape_parser s
  where
    unicode_char :: Parser Char
    unicode_char = do
      char '&'
      char '#'
      word <- many1 digit
      char ';'
      return $ chr (read word)

    unescape_parser :: Parser String
    unescape_parser = many (try unicode_char <|> anyChar)

escape_xml = concatMap fixChar
    where
      fixChar '<' = "<"
      fixChar '>' = ">"
      fixChar '&' = "&"
      fixChar '"' = "\""
      fixChar c | ord c < 0x80 = [c]
      fixChar c = "&#" ++ show (ord c) ++ ";"

-- backward compatible
unescape_unicode_xml, escape_unicode_xml :: String -> String
unescape_unicode_xml = unescape_xml
escape_unicode_xml = escape_xml