{-# LANGUAGE OverloadedStrings #-}

module ParserSpec (spec) where

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString       as BS
import qualified Data.ByteString.Char8 as B
import qualified Data.Word8            as W8
import qualified Lib.Parser            as Parser
import qualified Parsers.Parsers       as P
import           Test.Hspec
import           Text.Printf
import qualified Types.Msg             as Msg

spec :: Spec
spec = do
  char
  headers
  depth
  subject
  msg

charCases :: [(BS.ByteString, W8.Word8)]
charCases = zip (map charToByteString [(minBound::Char)..(maxBound::Char)]) [(minBound::W8.Word8)..(maxBound::W8.Word8)]
  where
    charToByteString c = B.pack [c]

char = parallel $ do
  describe "generated" $ do
    forM_ charCases $ \(input, want) ->
     describe (printf "char %s" (word8ToString want)) $ do
       it (printf "correctly parses generated case %s" (show input)) $ do
         let output = Parser.runParser (Parser.char want) input
         let result = fmap fst output
         result `shouldBe` Right want
         let left = fmap snd output
         left `shouldBe` Right ""
       it "returns ParserErr given empty string" $ do
         let output = Parser.runParser (Parser.char want) ""
         let result = fmap fst output
         result `shouldBe` Left (Parser.UnexpectedEndOfInput "nothing to read" 0)
         let left = fmap snd output
         left `shouldBe` Left (Parser.UnexpectedEndOfInput "nothing to read" 0)
       forM_ (filterSameChar input charCases) $ \(sinput, _) ->
         it (printf "returns ParserErr given %s" (show sinput)) $ do
           let output = Parser.runParser (Parser.char want) sinput
           let result = fmap fst output
           result `shouldBe` Left (Parser.UnexpectedChar(B.unpack $ foldr BS.append "" [BS.pack [BS.head sinput],  " does not match ", BS.pack [want], " in ", sinput]) 1)
           let left = fmap snd output
           left `shouldBe` Left (Parser.UnexpectedChar(B.unpack $ foldr BS.append "" [BS.pack [BS.head sinput],  " does not match ", BS.pack [want], " in ", sinput]) 1)

headerCases :: [(BS.ByteString, [(BS.ByteString, BS.ByteString)])]
headerCases = [
  ("NATS/1.0\r\nKEY: VALUE\r\n", [("KEY", "VALUE")]),
  ("NATS/1.0\r\nKEY:VALUE\r\n", [("KEY", "VALUE")]),
  ("NATS/1.0\r\n  KEY  : VALUE  \r\n", [("KEY", "VALUE")]),
  ("NATS/1.0\r\nKEY: VALUE\r\nOTHER: STUFF\r\n", [("KEY", "VALUE"), ("OTHER", "STUFF")]),
  ("NATS/1.0\r\n", []),
  ("NATS/2.2\r\n", [])
  ]

headers = parallel $ do
  describe "headers" $ do
    forM_ headerCases $ \(input, want) ->
      it (printf "correctly parses explicit case %s" (show input)) $ do
        let output = Parser.runParser (Parser.headersParser (fromIntegral . BS.length $ input)) input
        let result = fmap fst output
        result `shouldBe` Right want

depth = parallel $ do
  describe "alternative parser" $ do
    it "returns deepest failed parse attempt error" $ do
      let outputA = Parser.runParser (P.pingParser <|> P.pongParser) "PIL"
      let outputB = Parser.runParser (P.pongParser <|> P.pingParser) "PIL"
      outputA `shouldBe` outputB
      outputA `shouldBe` Left (Parser.UnexpectedChar "L does not match N in L" 1)

subject = parallel $ do
  describe "subject parser" $ do
    forM_ validSubjectCases $ \input ->
      it (printf "accepts %s" (show input)) $ do
        case Parser.runParser Parser.subjectParser (subjectInput input) of
          Left err -> expectationFailure (show err)
          Right (parsed, rest) -> do
            BS.pack parsed `shouldBe` input
            rest `shouldBe` ""
    forM_ invalidSubjectCases $ \input ->
      it (printf "rejects %s" (show input)) $ do
        subjectParsesFully input `shouldBe` False

msg = parallel $ do
  describe "MSG parsing" $ do
    it "accepts tab-delimited fields and non-alphanumeric subjects" $ do
      let input = "MSG foo-bar\t1\t_INBOX.a_b\t5\r\nHELLO\r\n"
      case P.genericParse input of
        Left err -> expectationFailure (show err)
        Right (parsed, rest) -> do
          rest `shouldBe` ""
          case parsed of
            P.ParsedMsg msg' -> do
              Msg.subject msg' `shouldBe` "foo-bar"
              Msg.replyTo msg' `shouldBe` Just "_INBOX.a_b"
              Msg.payload msg' `shouldBe` Just "HELLO"
            other -> expectationFailure ("unexpected parse result: " ++ show other)
    it "waits for the payload when a message spans frames" $ do
      let input = "MSG FOO 1 5\r\nHEL"
      case P.genericParse input of
        Left (Parser.UnexpectedEndOfInput _ _) -> pure ()
        Left err ->
          expectationFailure ("expected UnexpectedEndOfInput, got " ++ show err)
        Right result ->
          expectationFailure ("expected parse failure, got " ++ show result)

validSubjectCases :: [BS.ByteString]
validSubjectCases =
  [ "FOO"
  , "foo.bar"
  , "foo.BAR"
  , "_INBOX.foo"
  , "foo-bar"
  , "foo_bar"
  , "foo$bar"
  , "foo/bar"
  , "foo.*.bar"
  , "foo.>"
  , "foo.*.>"
  , "*"
  , ">"
  ]

invalidSubjectCases :: [BS.ByteString]
invalidSubjectCases =
  [ "foo..bar"
  , "foo. bar"
  , "foo.\tbar"
  , "foo.>bar"
  , "foo.>.bar"
  , "foo*.bar"
  , "foo.*bar"
  , "foo>bar"
  , "foo."
  , ".foo"
  ]

subjectParsesFully :: BS.ByteString -> Bool
subjectParsesFully input =
  case Parser.runParser Parser.subjectParser (subjectInput input) of
    Left _          -> False
    Right (_, rest) -> rest == ""

subjectInput :: BS.ByteString -> BS.ByteString
subjectInput input = BS.append input " "

filterSameChar :: BS.ByteString -> [(BS.ByteString, W8.Word8)] -> [(BS.ByteString, W8.Word8)]
filterSameChar _ [] = []
filterSameChar i os = filter f os
  where f item = fst item /= i

word8ToString :: W8.Word8 -> String
word8ToString w = show (BS.pack [w])