{-# LANGUAGE OverloadedStrings, OverloadedLists #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ViewPatterns #-}

module Thermoprint.Printout.BBCodeSpec (spec) where

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

import Thermoprint.Printout.BBCode
import Thermoprint.Printout

import Data.Text (Text)
import qualified Data.Text.Lazy as TL (pack)

import Data.String (IsString(..))

import Control.Monad (zipWithM_, join)
import Data.Monoid ((<>))
import Data.Function (on)
import Data.Bifunctor

import Data.Sequence (Seq)
import qualified Data.Sequence as Seq

instance Eq Block where
  (==) = (==) `on` cotext
deriving instance Eq Chunk

instance IsString Line where
  fromString = (\(Right l) -> l) . text . TL.pack

spec :: Spec
spec = do
  describe "example texts for bbcode" $
    zipWithM_ example [1..] examples
  describe "cobbcode" $ prop "is inverse to bbcode" bbcodeInv
  where
    example n (s, ts) = let str = show s
                        in specify str $ bbcode s == (pOut <$> ts)

bbcodeInv :: Printout -> Property
bbcodeInv (cobbcode -> Left _) = property True
bbcodeInv p@(cobbcode -> Right t) = either (const $ property True) property $ (==) <$> normalize (Right p)  <*> normalize (bbcode t)
  
normalize = (!! 3) . iterate normalize' . first (const ())
  where
    normalize' t = join' (bbcode <$> (join' $ cobbcode <$> t))
    join' :: Either a (Either b c) -> Either () c
    join' (Right (Right a)) = Right a
    join' _ = Left ()

pOut :: Seq Block -> Printout
pOut = fmap (pure . Cooked)

examples :: [(Text, Either BBCodeError (Seq Block))]
examples = [ ("Hello World!"
             , Right [Line (JuxtaPos ["Hello", HSpace 1, "World!"])])
           , ("Hello [hspace width=2/] World!"
             , Right [Line (JuxtaPos ["Hello", HSpace 4, "World!"])])
           , ("Par1\n\nPar2\n\nPar3 Word2"
             , Right [Line ("Par1"), Line ("Par2"), Line (JuxtaPos ["Par3", HSpace 1, "Word2"])])
           , ("Par1 [hspace=3/]\n\n[vspace=2/]Par2\n\nPar3 Word2"
             , Right [Line (JuxtaPos ["Par1", HSpace 4]), NewlSep [VSpace 2, Line ("Par2")], Line (JuxtaPos ["Par3", HSpace 1, "Word2"])])
           ]