{-# 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, init)

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

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 (BBOpen t xs) = "[" <> escape [']'] t <> " " <> attrs <> " ]"
  where
    attrs = mconcat . intersperse " " $ map attr xs
    attr (key, "") = escape ['=', ']', ' '] key
    attr (key, val) = escape ['=', ']', ' '] key <> "=\"" <> escape ['\"'] val <> "\""
coToken (BBContained t xs) = (<> "/]") . T.init . coToken $ BBOpen t xs
coToken (BBClose t) = "[/" <> escape [']'] t <> "]"
coToken (BBStr t) = escape ['['] t
coToken  BBNewPar = "\n\n"

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) >>= tokenize) <*> tokenize x
--
-- Where 'x' is restricted such that `tokenize` succeeds
--
-- Without accounting for failure this is:
--
-- > (tokenize . mconcat . map coToken . tokenize x) == tokenize x 
prop_token x = discardLeft $ (==) <$> (((mconcat . map coToken) <$> tokenize x) >>= tokenize) <*> 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]"])
           , ("[t attr]test[/t]"
             , [BBOpen "t" [("attr", "")], BBStr "test", BBClose "t"])
           , ("[t=attr]test[/t]"
             , [BBOpen "t" [("", "attr")], BBStr "test", BBClose "t"])
           , ("[t attr=val]test[/t]"
             , [BBOpen "t" [("attr", "val")], BBStr "test", BBClose "t"])
           , ("[t attr=\"val\"]test[/t]"
             , [BBOpen "t" [("attr", "val")], BBStr "test", BBClose "t"])
           , ("[t attr=\"va]l\"]test[/t]"
             , [BBOpen "t" [("attr", "va]l")], BBStr "test", BBClose "t"])
           , ("[t attr=\"va\\\"l\"]test[/t]"
             , [BBOpen "t" [("attr", "va\"l")], BBStr "test", BBClose "t"])
           , ("[t attr=\"val\"   attr2=\"val2\"  ]test[/t]"
             , [BBOpen "t" [("attr", "val"), ("attr2", "val2")], BBStr "test", BBClose "t"])
           , ("[br/]"
             , [BBContained "br" []])
           , ("[br attr/]"
             , [BBContained "br" [("attr", "")]])
           , ("[br=val/]"
             , [BBContained "br" [("", "val")]])
           , ("[br attr=val/]"
             , [BBContained "br" [("attr", "val")]])
           , ("[br attr=val val2/]"
             , [BBContained "br" [("attr", "val"), ("val2", "")]])
           , ("[foo\\/bar]"
             , [BBOpen "foo/bar" []])
           , ("foo\nbar"
             , [BBStr "foo\nbar"])
           , ("foo\n\nbar"
             , [BBStr "foo", BBNewPar, BBStr "bar"])
           , ("foo\n\n\r\n\r\nbar"
             , [BBStr "foo", BBNewPar, BBStr "bar"])
           ]