module Test.Hspec.Wai.Matcher (
  ResponseMatcher(..)
, match
, haveHeader
) where


import           Control.Monad
import           Data.Monoid
import           Data.Functor
import           Data.String
import           Data.Text.Lazy.Encoding (encodeUtf8)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as LB
import           Network.HTTP.Types
import           Network.Wai.Test

data ResponseMatcher = ResponseMatcher {
  matchStatus :: Int
, matchBody :: Maybe LB.ByteString
}

instance IsString ResponseMatcher where
  fromString s = ResponseMatcher 200 (Just . encodeUtf8 . fromString $ s)

instance Num ResponseMatcher where
  fromInteger n = ResponseMatcher (fromInteger n) Nothing
  (+) =    error "ResponseMatcher does not support (+)"
  (-) =    error "ResponseMatcher does not support (-)"
  (*) =    error "ResponseMatcher does not support (*)"
  abs =    error "ResponseMatcher does not support `abs`"
  signum = error "ResponseMatcher does not support `signum`"

match :: SResponse -> ResponseMatcher -> Maybe String
match (SResponse (Status status _) _ body) (ResponseMatcher expectedStatus expectedBody) = mconcat [
    match_ "status mismatch" status expectedStatus
  , expectedBody >>= match_ "body mismatch" body
  ]
  where
    match_ :: (Show a, Eq a) => String -> a -> a -> Maybe String
    match_ message actual expected = actualExpected message actual expected <$ guard (actual /= expected)

    actualExpected :: Show a => String -> a -> a -> String
    actualExpected message actual expected = unlines [
        message
      , "  expected: " ++ show expected
      , "  but got:  " ++ show actual
      ]

haveHeader :: SResponse -> Header -> Maybe String
haveHeader (SResponse _ headers _) (name, expected) = go $ lookup name headers
  where
    go Nothing = Just $ "header doesn't exist: " ++ show name
    go (Just actual) = if actual == expected
                         then Nothing
                         else (Just . unlines) [ "header mismatch"
                                               , "  expected: \"" ++ B.unpack expected ++ "\""
                                               , "  but got:  \"" ++ B.unpack actual ++ "\""
                                               ]