blob: 24a17e2cff3166bc0d0689cb49eba3d43a7b1fbe (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
import Blessings.Internal as B
import Blessings.String
import Control.Exception
import System.IO.Unsafe
import System.Timeout
import Test.Hspec
import Test.QuickCheck
unsafeTimeout :: Int -> a -> a
unsafeTimeout n f =
case unsafePerformIO $ timeout n (evaluate f) of
Nothing -> error "timeout"
Just y -> y
instance Arbitrary a => Arbitrary (Blessings a) where
arbitrary =
oneof
[ Plain <$> arbitrary
, pure Empty
, (<>) <$> arbitrary <*> arbitrary
, SGR <$> arbitrary <*> arbitrary
]
main :: IO ()
main =
hspec $ do
describe "Blessings" $ do
it "obeys the Semigroup laws" $
property $ \(x :: Blessings String) y z ->
(x <> y) <> z == x <> (y <> z)
it "obeys the Monoid laws" $
property $ \(x :: Blessings String) ->
x <> mempty == x && x == mempty <> x
it "pp (normalize x) == pp x" $
property $ \(x :: Blessings String) ->
pp (stripSGR (normalize x)) == pp (stripSGR x)
it "take 1 x <> drop 1 x == x" $
property $ \(x :: Blessings String) ->
normalize (B.take 1 x <> B.drop 1 x) == normalize x
it "uncurry (<>) (splitAt i x) == x" $
property $ \(i :: Int, x :: Blessings String) ->
unsafeTimeout 100000 $
normalize (uncurry (<>) (B.splitAt i x)) == normalize x
it "splitAt produces pairs with elements of proper length" $
property $ \(i :: Int, x :: Blessings String) ->
unsafeTimeout 100000 $
let
(l, r) = B.splitAt i x
n = B.length x
in
if | i <= 0 -> B.length l == 0 && B.length r == n
| i <= n -> B.length l == i && B.length r == n - i
| otherwise -> B.length l == n && B.length r == 0
let infx = mconcat (repeat (Plain "x" :: Blessings String))
it "can take from infinite structure" $
property $ \(n :: NonNegative Int) ->
unsafeTimeout 100000 $
let i = getNonNegative n in
B.length (B.take i infx) == i
it "can drop from infinite structure" $
property $ \(n :: NonNegative Int) ->
unsafeTimeout 100000 $
let i = getNonNegative n in
B.length (B.take i (B.drop i infx)) == i
it "can take concat of infinite structures" $
property $ \(x :: Blessings String) ->
unsafeTimeout 100000 $
B.length (B.take 1 $ infx <> x) <= 1
|
