{- 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)
]