{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}

module Text.BBCode.LexerSpec (spec) where

import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (Property, Discard(..), property)
import Test.QuickCheck.Instances

import Text.BBCode.Lexer

import Data.Text (Text)
import qualified Data.Text as T (singleton, replace, last, null)

import Data.Monoid ((<>), mconcat, Endo(..))

import Data.Attoparsec.Text (parseOnly, endOfInput)

import Control.Applicative
import Control.Monad (zipWithM_)

coToken :: BBToken -> Text
-- ^ Inverse of `token`
coToken (BBOpen t) = "[" <> escape [']'] t <> "]"
coToken (BBClose t) = "[/" <> escape [']'] t <> "]"
coToken (BBStr t) = escape ['['] t

escape :: [Char] -> Text -> Text
-- ^ Inverse of `escapedText`
escape xs = endos [ T.replace c' ("\\" <> c') . T.replace ("\\" <> c') ("\\\\" <> c') | c <- xs, let c' = T.singleton c ] . escapeLast
  where
    endos = appEndo . mconcat . map Endo
    escapeLast t
      | T.null t = ""
      | T.last t == '\\' = t <> "\\"
      | otherwise = t

tokenize :: Text -> Either String [BBToken]
-- ^ Run 'many token' against input
tokenize = parseOnly (many token <* endOfInput)

spec :: Spec
spec = do
  prop "prop_token" prop_token
  zipWithM_ example [1..] examples
    where
      example n (s, ts) = let str = "Example " <> show n
                          in specify str (tokenize s == Right ts)

prop_token :: Text -> Property
-- ^ prop> (mconcat . map coToken) <$> tokenize x == Right x
--
-- Where 'x' is restricted such that `tokenize` succeeds
prop_token x = discardLeft (((== x) . mconcat . map coToken) <$> tokenize x)
  where
    discardLeft = either (const $ property Discard) property

examples :: [(Text, [BBToken])]
examples = [ ("[t]test[/t]"
             , [BBOpen "t", BBStr "test", BBClose "t"])
           , ("[t]te\\st[/t]"
             , [BBOpen "t", BBStr "te\\st", BBClose "t"])
           , ("[t]te\\[st[/t]"
             , [BBOpen "t", BBStr "te[st", BBClose "t"])
           , ("[t]test\\\\[/t]"
             , [BBOpen "t", BBStr "test\\", BBClose "t"])
           , ("[t]test\\[/t]"
             , [BBOpen "t", BBStr "test[/t]"])
           , ("[\\t]test[/t]"
             , [BBOpen "\\t", BBStr "test", BBClose "t"])
           , ("[t]test[/t\\]]"
             , [BBOpen "t", BBStr "test", BBClose "t]"])
           ]