{- This file is part of irc-fun-color.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

import Data.List (findIndex)
import Data.Monoid ((<>))
import Data.Text (Text, pack)
import Data.Text.IO (putStrLn)
import Network.IRC.Fun.Color
import Prelude hiding (putStrLn)
import System.Exit (exitFailure)

cases :: [(StyledText, Text, Text)]
cases =
    [ ( Green #> "hello beautiful world"
      , "\ETX3hello beautiful world\ETX"
      , "hello beautiful world"
      )
    , ( Bold #> "hello beautiful world"
      , "\STXhello beautiful world\STX"
      , "hello beautiful world"
      )
    , ( Green #> ("hello " <> Underline #> "beautiful" <> " world")
      , "\ETX3hello \ETX\US\ETX3beautiful\ETX\US\ETX3 world\ETX"
      , "hello beautiful world"
      )
    , ( Red `fgBg` Gray #> "hello beautiful world"
      , "\ETX4,14hello beautiful world\ETX"
      , "hello beautiful world"
      )
    , ( ("hello " <> Red #> Underline #> "beautiful" <> " world") <# bg Blue
      , "\ETX,12hello \ETX\US\ETX4,12beautiful\ETX\US\ETX,12 world\ETX"
      , "hello beautiful world"
      )
    , ( Lime `fgBg` Black #> (Bold #> "A" <> Reverse #> "B" <> Italic #> "C")
      , "\STX\ETX9,1A\ETX\STX\SYN\ETX9,1B\ETX\SYN\GS\ETX9,1C\ETX\GS"
      , "ABC"
      )
    , ( Bold #> Underline #> Purple `fgBg` White #> "hello beautiful world"
      , "\US\STX\ETX6,0hello beautiful world\ETX\STX\US"
      , "hello beautiful world"
      )
    ]

results :: [(Bool, Text, Bool, Text)]
results = map f cases
    where
    f (styled, encoded, stripped) =
        let e = encode styled
            s = strip styled
        in  (e == encoded, e, s == stripped, s)

showt :: Show a => a -> Text
showt = pack . show

failure :: Maybe (Int, Bool, StyledText, Text, Text)
failure = do
    loc <- findIndex (\ (e, _, s, _) -> not (e && s)) results
    case (cases !! loc, results !! loc) of
        ((styled, encoded, _), (False, e, _, _)) ->
            Just (loc + 1, True, styled, encoded, e)
        ((styled, _, stripped), (_, _, False, s)) ->
            Just (loc + 1, False, styled, stripped, s)
        _ -> error "Test impl error"

putFailure :: Int -> Bool -> StyledText -> Text -> Text -> IO ()
putFailure n enc styled expected got = do
    putStrLn $ "TEST " <> showt n <> " FAILED:"
    putStrLn $ (if enc then "encode " else "strip ") <> showt styled
    putStrLn $ "Expected: " <> showt expected
    putStrLn $ "Got:      " <> showt got

main :: IO ()
main =
    case failure of
        Nothing               -> putStrLn "ALL TESTS PASSED"
        Just (n, b, ss, e, s) -> putFailure n b ss e s >> exitFailure