{-# LANGUAGE OverloadedStrings #-}

import           Control.Monad
import           Control.Monad.IO.Class
import           Data.ByteString.Lazy.Char8              ({- IsString -})
import           Data.Char                               (ord, chr)
import           Data.String
import           Data.Text                               (toLower)
import           Data.XML.Types
import           Test.HUnit                              hiding (Test)
import           Test.Hspec
import           Test.Hspec.HUnit
import           Text.XML.Enumerator.Combinators.General
import           Text.XML.Enumerator.Combinators.Tags
import           Text.XML.Enumerator.Parse               (decodeEntities)
import qualified Control.Exception                       as C
import qualified Data.ByteString.Lazy                    as L
import qualified Data.Map                                as Map
import qualified Text.XML.Enumerator.Parse               as P

main :: IO ()
main = hspec $ describe "XML combinators"
    [ it "has working chooseSplit" testChooseSplit
    , it "has working permute" testPermute
    , it "has working permuteFallback" testPermuteFallback
    , it "has working tags" testTags
    , it "has working tagsPermute" testTagsPermute
    , it "has working tagsPermuteRepetition" testTagsPermuteRepetition
    ]

testChooseSplit = P.parseLBS_ input decodeEntities $ do
    P.force "need hello" $ P.tagNoAttr "hello" $ do
        x <- chooseSplit (\t-> P.tagNoAttr t (return t)) ["a", "b", "c"]
        liftIO $ x @?= Just ("b",["a","c"])
  where
    input = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<b/>"
        , "</hello>"
        ]

testPermute 
    = do
        let frame input = P.parseLBS_ input decodeEntities $ do
                            P.force "need hello" $ P.tagNoAttr "hello" $ 
                              permute (\t -> P.tagNoAttr t (return t)) ["a", "b"]
        frame input1 >>= \result1 -> result1 @?= Just ["a", "b"]
        frame input2 >>= \result2 -> result2 @?= Just ["b", "a"]
        frame input3 >>= \result3 -> result3 @?= Nothing
        C.try (frame input4) >>= \result4 -> case result4 of
                                               Left (P.XmlException { 
                                                            P.xmlBadInput = Just (EventBeginElement 
                                                                                    Name { 
                                                                                      nameLocalName = "c"
                                                                                    , nameNamespace = Nothing
                                                                                    , namePrefix = Nothing 
                                                                                    }
                                                                                    _) 
                                                            }) -> return () -- right type of error
                                               Left  _ -> assertFailure "wrong error"
                                               Right _ -> assertFailure "erroneous document requires an error"
  where
    input1 = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<a/>"
        , "<b/>"
        , "</hello>"
        ]
    input2 = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<b/>"
        , "<a/>"
        , "</hello>"
        ]
    input3 = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<a/>"
        , "</hello>"
        ]
    input4 = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<a/>"
        , "<c/>"
        , "</hello>"
        ]

testPermuteFallback
    = do
        let frame input = P.parseLBS_ input decodeEntities $ do
                            P.force "need hello" $ P.tagNoAttr "hello" $ 
                              permuteFallback (fmap return `fmap` P.contentMaybe) 
                                               (\t -> P.tagNoAttr t (return $ nameLocalName t)) 
                                               ["a", "b"]
        frame input1 >>= \result1 -> result1 @?= Just ["a", "t", "b"]
        frame input2 >>= \result2 -> result2 @?= Just ["t", "b", "a"]
        frame input3 >>= \result3 -> result3 @?= Nothing
        C.try (frame input4) >>= \result4 -> case result4 of
                                               Left (P.XmlException { 
                                                            P.xmlBadInput = Just (EventBeginElement 
                                                                                    Name { 
                                                                                      nameLocalName = "c"
                                                                                    , nameNamespace = Nothing
                                                                                    , namePrefix = Nothing 
                                                                                    }
                                                                                    _) 
                                                            }) -> return () -- right type of error
                                               Left  _ -> assertFailure "wrong error"
                                               Right _ -> assertFailure "erroneous document requires an error"
  where
    input1 = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<a/>"
        , "t"
        , "<b/>"
        , "</hello>"
        ]
    input2 = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "t"
        , "<b/>"
        , "<a/>"
        , "</hello>"
        ]
    input3 = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<a/>"
        , "</hello>"
        ]
    input4 = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<a/>"
        , "<c/>"
        , "</hello>"
        ]

testTags = P.parseLBS_ input decodeEntities $ do
    P.force "need hello" $ P.tagNoAttr "hello" $ do
        x <- tags (\state name -> do 
                       let n = nameLocalName name
                       guard (n == fromString [chr $ ord 'a' + state]) 
                       Just (return (), \_ -> return $ Just (state + 1, Just n)))
                    (const $ return Nothing)
                    0
        liftIO $ x @?= (5, ["a", "b", "c", "d", "e"])
  where
    input = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<a/>"
        , "<b/>"
        , "<c/>"
        , "<d/>"
        , "<e/>"
        , "</hello>"
        ]

testTagsPermute = P.parseLBS_ input decodeEntities $ do
    P.force "need hello" $ P.tagNoAttr "hello" $ do
        let p c = (return (), \_ -> return (Just c))
        x <- tagsPermute (toLower . nameLocalName) 
                           (Map.fromList $ map (\c -> (c, p c)) 
                                   ["a", "b", "c", "d", "e"])
                           (return Nothing)
        liftIO $ x @?= Just ["d", "b", "e", "a", "c"]
  where
    input = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<d/>"
        , "<b/>"
        , "<E/>"
        , "<a/>"
        , "<C/>"
        , "</hello>"
        ]

testTagsPermuteRepetition = P.parseLBS_ input decodeEntities $ do
    P.force "need hello" $ P.tagNoAttr "hello" $ do
        let p r c = (r, return (), \_ -> return (Just ()))
        x <- tagsPermuteRepetition (toLower . nameLocalName) 
                                     (Map.fromList $ map (\c -> (c, p repeatOnce c)) ["a", "b", "c", "d", "e"] ++
                                                     map (\c -> (c, p repeatMany c)) ["r"])
                                     (return Nothing)
        liftIO $ fmap (map fst) x @?= Just ["d", "r", "b", "e", "r", "a", "c"]
  where
    input = L.concat
        [ "<?xml version='1.0'?>\n"
        , "<!DOCTYPE foo []>\n"
        , "<hello>"
        , "<d/>"
        , "<r/>"
        , "<b/>"
        , "<E/>"
        , "<r/>"
        , "<a/>"
        , "<C/>"
        , "</hello>"
        ]