{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Spec where
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck (Arbitrary(..))
import Data.MonoTraversable
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Storable as VS
import Data.Sequences
import Prelude (Bool (..), ($), IO, min, abs, Eq (..), (&&), fromIntegral, Ord (..), String, mod, Int, show,
return, asTypeOf, (.), Show, id, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, seq)
import qualified Prelude
import Control.Monad.Trans.Writer
import qualified Data.NonNull as NN
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup as SG
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.HashMap.Strict as HashMap
import Data.Containers
import qualified Data.IntSet as IntSet
import Control.Arrow (first, second)
import qualified Control.Foldl as Foldl
import Data.Int (Int64)
import Data.ByteVector
import Control.Monad (liftM2)
import qualified Data.Sequence as Seq
instance Arbitrary a => Arbitrary (NE.NonEmpty a) where
arbitrary = liftM2 (NE.:|) arbitrary arbitrary
main :: IO ()
main = hspec $ do
describe "cnull" $ do
it "empty list" $ onull [] `shouldBe` True
it "non-empty list" $ onull [()] `shouldBe` False
it "empty text" $ onull ("" :: Text) `shouldBe` True
it "non-empty text" $ onull ("foo" :: Text) `shouldBe` False
describe "osum" $ do
it "list" $ do
let x = 1
-- explicitly using Int64 to avoid overflow issues, see:
-- https://github.com/snoyberg/mono-traversable/issues/29
y = 10000000 :: Int64
list = [x..y]
osum list `shouldBe` ((x + y) * (y - x + 1) `div` 2)
describe "oproduct" $ do
it "list" $ do
let x = 1
y = 10000000 :: Int64
list = [x..y]
fact n =
go 1 1
where
go i j
| i `seq` j `seq` j >= n = i
| otherwise = go (i * j) (j + 1)
oproduct list `shouldBe` fact y `div` (fact (x - 1))
describe "clength" $ do
prop "list" $ \i' ->
let x = replicate i () :: [()]
i = min 500 $ abs i'
in olength x == i
prop "text" $ \i' ->
let x = replicate i 'a' :: Text
i = min 500 $ abs i'
in olength x == i
prop "lazy bytestring" $ \i' ->
let x = replicate i 6 :: L.ByteString
i = min 500 $ abs i'
in olength64 x == i
describe "ccompareLength" $ do
prop "list" $ \i' j ->
let i = min 500 $ abs i'
x = replicate i () :: [()]
in ocompareLength x j == compare i j
describe "groupAll" $ do
it "list" $ groupAll ("abcabcabc" :: String) == ["aaa", "bbb", "ccc"]
it "Text" $ groupAll ("abcabcabc" :: Text) == ["aaa", "bbb", "ccc"]
describe "unsnoc" $ do
let test name dummy = prop name $ \xs ->
let seq' = fromList xs `asTypeOf` dummy
in case (unsnoc seq', onull seq', onull xs) of
(Nothing, True, True) -> return ()
(Just (y, z), False, False) -> do
(y SG.<> singleton z) `shouldBe` seq'
snoc y z `shouldBe` seq'
otoList (snoc y z) `shouldBe` xs
x -> Prelude.error $ show x
test "list" ([] :: [Int])
test "Text" ("" :: Text)
test "lazy ByteString" L.empty
describe "index" $ do
let test name dummy = prop name $ \(abs -> i) xs ->
let seq' = fromList xs `asTypeOf` dummy
mx = index xs (fromIntegral i)
in mx == index seq' i &&
(case mx of
Nothing -> True
Just x -> indexEx seq' i == x &&
unsafeIndex seq' i == x)
test "list" ([] :: [Int])
test "Text" ("" :: Text)
test "lazy Text" ("" :: TL.Text)
test "ByteString" S.empty
test "lazy ByteString" L.empty
test "Vector" (V.singleton (1 :: Int))
test "SVector" (VS.singleton (1 :: Int))
test "UVector" (U.singleton (1 :: Int))
test "Seq" (Seq.fromList [1 :: Int])
describe "groupAllOn" $ do
it "list" $ groupAllOn (`mod` 3) ([1..9] :: [Int]) == [[1, 4, 7], [2, 5, 8], [3, 6, 9]]
describe "breakWord" $ do
let test x y z = it (show (x, y, z)) $ breakWord (x :: Text) `shouldBe` (y, z)
test "hello world" "hello" "world"
test "hello world" "hello" "world"
test "hello\r\nworld" "hello" "world"
test "hello there world" "hello" "there world"
test "" "" ""
test "hello \n\r\t" "hello" ""
describe "breakLine" $ do
let test x y z = it (show (x, y, z)) $ breakLine (x :: Text) `shouldBe` (y, z)
test "hello world" "hello world" ""
test "hello\r\n world" "hello" " world"
test "hello\n world" "hello" " world"
test "hello\r world" "hello\r world" ""
test "hello\r\nworld" "hello" "world"
test "hello\r\nthere\nworld" "hello" "there\nworld"
test "hello\n\r\nworld" "hello" "\r\nworld"
test "" "" ""
describe "omapM_" $ do
let test typ dummy = prop typ $ \input ->
let res = execWriter $ omapM_ (tell . return) (fromList input `asTypeOf` dummy)
in res == input
test "strict ByteString" S.empty
test "lazy ByteString" L.empty
test "strict Text" T.empty
test "lazy Text" TL.empty
describe "NonNull" $ do
describe "fromNonEmpty" $ do
prop "toMinList" $ \(ne :: NE.NonEmpty Int) ->
let m = NN.toMinList ne
in NE.toList ne `shouldBe` NN.toNullable m
let test' forceTyp typ dummy = describe typ $ do
prop "head" $ \x xs ->
let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.head nn `shouldBe` x
prop "tail" $ \x xs ->
let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.tail nn `shouldBe` fromList xs
prop "last" $ \x xs ->
let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.last nn `shouldBe` x
prop "init" $ \x xs ->
let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.init nn `shouldBe` reverse (fromList xs)
prop "maximum" $ \x xs ->
let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.maximum nn `shouldBe` Prelude.maximum (x:xs)
prop "maximumBy" $ \x xs ->
let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.maximumBy compare nn `shouldBe` Prelude.maximum (x:xs)
prop "minimum" $ \x xs ->
let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.minimum nn `shouldBe` Prelude.minimum (x:xs)
prop "minimumBy" $ \x xs ->
let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.minimumBy compare nn `shouldBe` Prelude.minimum (x:xs)
prop "ofoldMap1" $ \x xs ->
let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in SG.getMax (NN.ofoldMap1 SG.Max nn) `shouldBe` Prelude.maximum (x:xs)
prop "ofoldr1" $ \x xs ->
let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.ofoldr1 (Prelude.min) nn `shouldBe` Prelude.minimum (x:xs)
prop "ofoldl1'" $ \x xs ->
let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy)
in NN.ofoldl1' (Prelude.min) nn `shouldBe` Prelude.minimum (x:xs)
test :: (OrdSequence typ, Arbitrary (Element typ), Show (Element typ), Show typ, Eq typ, Eq (Element typ))
=> String -> typ -> Spec
test = test' id
test "strict ByteString" S.empty
test "lazy ByteString" L.empty
test "strict Text" T.empty
test "lazy Text" TL.empty
test "Vector" (V.empty :: V.Vector Int)
test "unboxed Vector" (U.empty :: U.Vector Int)
test "storable Vector" (VS.empty :: VS.Vector Int)
test "list" ([5 :: Int])
-- test' (id :: NE.NonEmpty Int -> NE.NonEmpty Int) "NonEmpty" ([] :: [Int])
describe "Containers" $ do
let test typ dummy xlookup xinsert xdelete = describe typ $ do
prop "difference" $ \(filterDups -> xs) (filterDups -> ys) -> do
let m1 = mapFromList xs `difference` mapFromList ys
m2 = mapFromList (xs `difference` ys) `asTypeOf` dummy
m1 `shouldBe` m2
prop "lookup" $ \(fixK -> k) (filterDups -> xs) -> do
let m = mapFromList xs
v1 = lookup k m
v2 = lookup k (xs :: [(Int, Int)])
v3 = xlookup k m
v1 `shouldBe` v2
v1 `shouldBe` v3
prop "insert" $ \(fixK -> k) v (filterDups -> xs) -> do
let m = mapFromList (xs :: [(Int, Int)])
m1 = insertMap k v m
m2 = mapFromList (insertMap k v xs)
m3 = xinsert k v m
m1 `shouldBe` m2
m1 `shouldBe` m3
prop "delete" $ \(fixK -> k) (filterDups -> xs) -> do
let m = mapFromList (xs :: [(Int, Int)]) `asTypeOf` dummy
m1 = deleteMap k m
m2 = mapFromList (deleteMap k xs)
m3 = xdelete k m
m1 `shouldBe` m2
m1 `shouldBe` m3
prop "singletonMap" $ \(fixK -> k) v -> do
singletonMap k v `shouldBe` (mapFromList [(k, v)] `asTypeOf` dummy)
prop "findWithDefault" $ \(fixK -> k) v (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
findWithDefault v k m `shouldBe` findWithDefault v k xs
prop "insertWith" $ \(fixK -> k) v (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
f = (+)
insertWith f k v m `shouldBe` mapFromList (insertWith f k v xs)
prop "insertWithKey" $ \(fixK -> k) v (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
f x y z = x + y + z
insertWithKey f k v m `shouldBe` mapFromList (insertWithKey f k v xs)
prop "insertLookupWithKey" $ \(fixK -> k) v (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
f x y z = x + y + z
insertLookupWithKey f k v m `shouldBe`
second mapFromList (insertLookupWithKey f k v xs)
prop "adjustMap" $ \(fixK -> k) (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
adjustMap succ k m `shouldBe` mapFromList (adjustMap succ k xs)
prop "adjustWithKey" $ \(fixK -> k) (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
adjustWithKey (+) k m `shouldBe` mapFromList (adjustWithKey (+) k xs)
prop "updateMap" $ \(fixK -> k) (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
f i = if i < 0 then Nothing else Just $ i * 2
updateMap f k m `shouldBe` mapFromList (updateMap f k xs)
prop "updateWithKey" $ \(fixK -> k) (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
f k i = if i < 0 then Nothing else Just $ i * k
updateWithKey f k m `shouldBe` mapFromList (updateWithKey f k xs)
prop "updateLookupWithKey" $ \(fixK -> k) (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
f k i = if i < 0 then Nothing else Just $ i * k
updateLookupWithKey f k m `shouldBe` second mapFromList (updateLookupWithKey f k xs)
prop "alter" $ \(fixK -> k) (filterDups -> xs) -> do
let m = mapFromList xs `asTypeOf` dummy
f Nothing = Just (-1)
f (Just i) = if i < 0 then Nothing else Just (i * 2)
lookup k (alterMap f k m) `shouldBe` f (lookup k m)
prop "unionWith" $ \(filterDups -> xs) (filterDups -> ys) -> do
let m1 = unionWith (+)
(mapFromList xs `asTypeOf` dummy)
(mapFromList ys `asTypeOf` dummy)
m2 = mapFromList (unionWith (+) xs ys)
m1 `shouldBe` m2
prop "unionWithKey" $ \(filterDups -> xs) (filterDups -> ys) -> do
let f k x y = k + x + y
m1 = unionWithKey f
(mapFromList xs `asTypeOf` dummy)
(mapFromList ys `asTypeOf` dummy)
m2 = mapFromList (unionWithKey f xs ys)
m1 `shouldBe` m2
prop "unionsWith" $ \(map filterDups -> xss) -> do
let ms = map mapFromList xss `asTypeOf` [dummy]
unionsWith (+) ms `shouldBe` mapFromList (unionsWith (+) xss)
prop "mapWithKey" $ \(filterDups -> xs) -> do
let m1 = mapWithKey (+) (mapFromList xs) `asTypeOf` dummy
m2 = mapFromList $ mapWithKey (+) xs
m1 `shouldBe` m2
prop "omapKeysWith" $ \(filterDups -> xs) -> do
let m1 = omapKeysWith (+) f (mapFromList xs) `asTypeOf` dummy
m2 = mapFromList $ omapKeysWith (+) f xs
f = flip mod 5
m1 `shouldBe` m2
filterDups :: [(Int, v)] -> [(Int, v)]
filterDups =
loop IntSet.empty . map (first (`mod` 20))
where
loop _ [] = []
loop used ((k, v):rest)
| k `member` used = loop used rest
| Prelude.otherwise = (k, v) : loop (insertSet k used) rest
fixK :: Int -> Int
fixK = flip mod 20
test "Data.Map" Map.empty Map.lookup Map.insert Map.delete
test "Data.IntMap" IntMap.empty IntMap.lookup IntMap.insert IntMap.delete
test "Data.HashMap" HashMap.empty HashMap.lookup HashMap.insert HashMap.delete
describe "foldl integration" $ do
prop "vector" $ \xs -> do
x1 <- Foldl.foldM Foldl.vector (xs :: [Int])
x2 <- Foldl.impurely ofoldMUnwrap Foldl.vector xs
x2 `shouldBe` (x1 :: V.Vector Int)
prop "length" $ \xs -> do
let x1 = Foldl.fold Foldl.length (xs :: [Int])
x2 = Foldl.purely ofoldlUnwrap Foldl.length xs
x2 `shouldBe` x1
describe "sorting" $ do
let test typ dummy = describe typ $ do
prop "sortBy" $ \input -> do
let orig = fromList input `asTypeOf` dummy
f x y = compare y x
fromList (sortBy f input) `shouldBe` sortBy f orig
fromList input `shouldBe` orig
prop "sort" $ \input -> do
let orig = fromList input `asTypeOf` dummy
fromList (sort input) `shouldBe` sort orig
fromList input `shouldBe` orig
test "list" ([] :: [Int])
test "vector" (V.empty :: V.Vector Int)
test "storable vector" (VS.empty :: VS.Vector Int)
test "unboxed vector" (U.empty :: U.Vector Int)
test "strict ByteString" S.empty
test "lazy ByteString" L.empty
test "strict Text" T.empty
test "lazy Text" TL.empty
it "headEx on a list works #26" $
headEx (1 : filter Prelude.odd [2,4..]) `shouldBe` (1 :: Int)
it "find doesn't infinitely loop on NonEmpty #31" $
find (== "a") ("a" NE.:| ["d","fgf"]) `shouldBe` Just "a"
prop "toByteVector works" $ \ws ->
(otoList . toByteVector . fromList $ ws) `shouldBe` ws
prop "fromByteVector works" $ \ws ->
(otoList . fromByteVector . fromList $ ws) `shouldBe` ws