{-# LANGUAGE CPP, ScopedTypeVariables #-}
module Main where
import Control.Applicative ((<$>))
import Control.Exception
import Data.List (isPrefixOf)
import qualified Data.Int as Int
import GHC.Int
import Ros.Internal.Msg.SrvInfo
import Ros.Internal.RosBinary
import Ros.Service (callService)
import Ros.Service.ServiceTypes
import qualified Ros.Test_srvs.AddTwoIntsRequest as Req
import qualified Ros.Test_srvs.AddTwoIntsResponse as Res
import Ros.Test_srvs.EmptyRequest
import Ros.Test_srvs.EmptyResponse
import Test.Tasty
import Test.Tasty.HUnit

-- To run:
-- 1. start ros: run "roscore"
-- 2. in another terminal start the add_two_ints server:
--      python roshask/Tests/ServiceClientTests/add_two_ints_server.py
-- 3. in a new terminal make sure $ROS_MASTER_URI is correct and run
--      cabal test servicetest --show-details=always
type Response a = IO (Either ServiceResponseExcept a)

main :: IO ()
main = defaultMain $ testGroup "Service Tests" [
  addIntsTest 4 7
  , notOkTest 100 100
  , requestResponseDontMatchTest
  , noProviderTest
  , connectionHeaderBadMD5Test
  , emptyServiceTest]
       
addIntsTest :: GHC.Int.Int64 -> GHC.Int.Int64 -> TestTree
addIntsTest x y = testCase ("add_two_ints, add " ++ show x ++ " + " ++ show y) $
  do res <- callService "/add_two_ints" Req.AddTwoIntsRequest{Req.a=x, Req.b=y} :: Response  Res.AddTwoIntsResponse
     Right (Res.AddTwoIntsResponse (x + y)) @=? res

-- add_two_ints_server returns None (triggering the NotOkError) if both a and b are 100
notOkTest :: GHC.Int.Int64 -> GHC.Int.Int64 -> TestTree
notOkTest x y = testCase ("NotOKError, add_two_ints, add " ++ show x ++ " + " ++ show y) $
  do res <- callService "/add_two_ints" Req.AddTwoIntsRequest{Req.a=x, Req.b=y} :: Response Res.AddTwoIntsResponse
     Left (NotOkExcept "service cannot process request: service handler returned None") @=? res

-- tests that an error is returned if the server is not registered with the master
noProviderTest :: TestTree
noProviderTest = testCase ("service not registered error") $
  do res <- callService "/not_add_two_ints" Req.AddTwoIntsRequest{Req.a=x, Req.b=y} :: Response Res.AddTwoIntsResponse
     Left (MasterExcept "lookupService failed, code: -1, statusMessage: no provider") @=? res
  where
    x = 10
    y = 10

-- From the deprecated @testpack@ package by John Goerzen
assertRaises :: forall a e. (Show a, Control.Exception.Exception e, Show e, Eq e)
             => String -> e -> IO a -> IO ()
assertRaises msg selector action =
    let thetest :: e -> IO ()
        thetest e = if isPrefixOf (show selector) (show e) then return ()
                    else assertFailure $
                         msg ++ "\nReceived unexpected exception: "
                             ++ show e
                             ++ "\ninstead of exception: " ++ show selector
        in do
           r <- Control.Exception.try action
           case r of
                  Left e -> thetest e
                  Right _ -> assertFailure $
                             msg ++ "\nReceived no exception, "
                                 ++ "but was expecting exception: "
                                 ++ show selector


requestResponseDontMatchTest :: TestTree
requestResponseDontMatchTest =
  testGroup "check request and response" [testMd5, testName]
  where
    testMd5 = testCase ("check md5") $ do
      assertRaises "Failed to detect mismatch"
        (ErrorCall "Request and response type do not match")
        --(callService "/add_two_ints" (Req.AddTwoIntsRequest 1 1) :: IO (Either ServiceResponseExcept BadMD5))
        (callService "/add_two_ints" (Req.AddTwoIntsRequest 1 1) :: Response BadMD5)
    testName =  testCase ("check name") $ do
      assertRaises "Failed to detect mismatch"
        (ErrorCall "Request and response type do not match")
        (callService "/add_two_ints" (Req.AddTwoIntsRequest 1 1) :: IO (Either ServiceResponseExcept BadName))

connectionHeaderBadMD5Test :: TestTree
connectionHeaderBadMD5Test = testCase "connection header wrong MD5 error" $ 
  do res <- callService "/add_two_ints" $ BadMD5 10 :: Response BadMD5
     Left (ConHeadExcept "Connection header from server has error, connection header is: [(\"error\",\"request from [roshask]: md5sums do not match: [6a2e34150c00229791cc89ff309fff22] vs. [6a2e34150c00229791cc89ff309fff21]\")]") @=? res

emptyServiceTest :: TestTree
emptyServiceTest =
  testCase "emptyService" $
  do res <- callService "/empty_srv" $ EmptyRequest :: Response EmptyResponse
     Right (EmptyResponse) @=? res

data BadMD5 = BadMD5 {a :: Int.Int64} deriving (Show, Eq)

instance SrvInfo BadMD5 where
  srvMD5 _ = "6a2e34150c00229791cc89ff309fff22"
  srvTypeName _ = "test_srvs/AddTwoInts"

instance RosBinary BadMD5 where
  put obj' = put (a obj')
  get = BadMD5 <$> get

data BadName = BadName Int.Int64 deriving (Show, Eq)

instance SrvInfo BadName where
  srvMD5 _ = "6a2e34150c00229791cc89ff309fff21"
  srvTypeName _ = "test_srvs/AddTwoIntu"

instance RosBinary BadName where
  put (BadName x) = put x
  get = BadName <$> get

#if MIN_VERSION_base(4,7,0)
#else
instance Eq ErrorCall where
    x == y = (show x) == (show y)
#endif
