{- This file is part of text-position.
 -
 - Written in 2015 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - To the extent possible under law, 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/>.
 -}

import Control.Monad (unless)
import Data.Position
import System.Exit
import Test.QuickCheck
import Test.QuickCheck.Test
import Text.Printf
import Text.Regex.Applicative

main :: IO ()
main = do
    results <- mapM (\ (name ,action) -> printf "%-25s: " name >> action) tests
    unless (all isSuccess results) exitFailure

prop_defaultAdvance1 :: Char -> String -> Int -> Int -> Int -> Bool
prop_defaultAdvance1 s ss l c ch =
    case findFirstPrefix defaultAdvance (s:ss) of
        Nothing          -> False
        Just (adv, rest) -> rest == ss &&
                            adv (Position l c ch) == Position l (c+1) (ch+1)

prop_defaultAdvance2 :: Bool
prop_defaultAdvance2 =
    case findFirstPrefix defaultAdvance [] of
        Nothing -> True
        Just _  -> False

prop_linecharAdvance :: Char -> Int -> String -> Int -> Int -> Int -> Bool
prop_linecharAdvance t w s l c ch =
    case findFirstPrefix (linecharAdvance t w) (t:s) of
        Nothing          -> False
        Just (adv, rest) -> rest == s &&
                            adv (Position l c ch) == Position l (c+w) (ch+1)

prop_concat :: Char -> String -> Char -> String -> String
            -> Int -> Int -> Int
            -> Bool
prop_concat s1 ss1 s2 ss2 ss l c ch =
    case findFirstPrefix (adv1 <++> adv2) (s1:ss1 ++ s2:ss2 ++ ss) of
        Nothing          -> False
        Just (adv, rest) -> rest == ss &&
            adv (Position l c ch) == Position (l*8-1) (c*5+4) (ch*7-2)
    where
    a1 (Position l' c' ch') = Position (l'*8) (c'*5) (ch'*7)
    a2 (Position l' c' ch') = Position (l'-1) (c'+4) (ch'-2)
    adv1 = stringAdvance (s1:ss1) a1
    adv2 = stringAdvance (s2:ss2) a2

prop_enrichOnce :: Bool
prop_enrichOnce = a == b
    where
    a = enrichOnce (newlineAdvance "\r\n") (Position 1 1 1) "\r\nhello"
    b =
        ( [ Positioned '\r' (Position 1 1 1)
          , Positioned '\n' (Position 1 1 2)
          ]
        , Position 2 1 3
        , "hello"
        )

prop_enrich :: Bool
prop_enrich = a == b
    where
    a = enrich (commonAdvance 8 True True True True) "1\t4\r\n\r2\f8\t\n"
    b =
        ( [ Positioned '1'  (Position 1  1  1)
          , Positioned '\t' (Position 1  2  2)
          , Positioned '4'  (Position 1 10  3)
          , Positioned '\r' (Position 1 11  4)
          , Positioned '\n' (Position 1 11  5)
          , Positioned '\r' (Position 2  1  6)
          , Positioned '2'  (Position 3  1  7)
          , Positioned '\f' (Position 3  2  8)
          , Positioned '8'  (Position 4  1  9)
          , Positioned '\t' (Position 4  2 10)
          , Positioned '\n' (Position 4 10 11)
          ]
        , Position 5 1 12
        )

prop_bless :: Bool
prop_bless = a == b
    where
    a  = match re $ fst $ enrich (commonAdvance 8 True True True True) s
    s  = "helloB\tE\r\nB\tEhello\r\n\r\nB\tE"
    re = some $ bless $ 'H' <$ string "hello"
                    <|> 'T' <$ string "B\tE"
                    <|> 'N' <$ string "\r\n"
    b  = Just
        [ Positioned 'H' (Position 1  1  1)
        , Positioned 'T' (Position 1  6  6)
        , Positioned 'N' (Position 1 16  9)
        , Positioned 'T' (Position 2  1 11)
        , Positioned 'H' (Position 2 11 14)
        , Positioned 'N' (Position 2 16 19)
        , Positioned 'N' (Position 3  1 21)
        , Positioned 'T' (Position 4  1 23)
        ]

comadv     = commonAdvance 8 True True True True
tokenize   = tokens comadv re
re         =    'H' <$ string "hello"
            <|> 'T' <$ string "B\tE"
            <|> 'N' <$ string "\r\n"
input      = "helloB\tE\r\nB\tEhello\r\n\r\nB\tE"
positions  =
        [ Positioned 'H' (Position 1  1  1)
        , Positioned 'T' (Position 1  6  6)
        , Positioned 'N' (Position 1 16  9)
        , Positioned 'T' (Position 2  1 11)
        , Positioned 'H' (Position 2 11 14)
        , Positioned 'N' (Position 2 16 19)
        , Positioned 'N' (Position 3  1 21)
        , Positioned 'T' (Position 4  1 23)
        ]

prop_tokens1 :: Bool
prop_tokens1 = tokenize input == (positions, Nothing)

prop_tokens2 :: Bool
prop_tokens2 = tokenize (input ++ "world") ==
               (positions, Just $ Positioned 'w' (Position 4 11 26))

prop_textInfo :: Bool
prop_textInfo = textInfo comadv input == (4, 10, 25)

tests :: [(String, IO Result)]
tests =
    [ ("defaultAdvance 1", quickCheckResult prop_defaultAdvance1)
    , ("defaultAdvance 2", quickCheckResult prop_defaultAdvance2)
    , ("linecharAdvance",  quickCheckResult prop_linecharAdvance)
    , ("<++>",             quickCheckResult prop_concat)
    , ("enrichOnce",       quickCheckResult prop_enrichOnce)
    , ("enrich",           quickCheckResult prop_enrich)
    , ("bless",            quickCheckResult prop_bless)
    , ("tokens1",          quickCheckResult prop_tokens1)
    , ("tokens2",          quickCheckResult prop_tokens2)
    , ("textInfo",         quickCheckResult prop_textInfo)
    ]