{-# LANGUAGE CPP #-} module TestDeep (spec) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Test.Hspec import Test.QuickCheck import Skulk.Deep #if __GLASGOW_HASKELL__ < 708 -- Backport from base-4.7.0.0 import Control.Applicative((<$>), pure) import Data.Foldable(Foldable, foldMap, foldr) import Data.Traversable(Traversable, traverse) instance Foldable (Either a) where foldr _ z (Left _) = z foldr f z (Right y) = f y z instance Traversable (Either a) where traverse _ (Left x) = pure (Left x) traverse f (Right y) = Right <$> f y #endif type M a = Maybe a type E a = Either Int a validateEM :: E (M String) -> M (E String) -> Spec validateEM x y = do it "reduce BAB to AB" $ do reduceBAB (Just x) `shouldBe` x reduceBAB (Right y) `shouldBe` y it "reduce ABA to AB" $ do reduceABA (Just x) `shouldBe` y reduceABA (Right y) `shouldBe` x it "reduce ABAB to AB" $ do reduceABAB (Right $ Just x) `shouldBe` x reduceABAB (Just $ Right y) `shouldBe` y it "reduce BABA to AB" $ do reduceBABA (Right $ Just x) `shouldBe` y reduceBABA (Just $ Right y) `shouldBe` x spec :: Spec spec = do describe "Right.Just vs Just.Right" $ do validateEM (Right (Just "foo")) (Just (Right "foo")) describe "Left vs Just.Left" $ do validateEM (Left 9) (Just (Left 9)) describe "Right.Nothing vs Nothing" $ do validateEM (Right Nothing) Nothing describe "[Maybe a] vs Maybe [a]" $ do it "reduceBAB [Just [foo]]" $ reduceBAB [Just ["foo", "bar"], Just ["baz"]] `shouldBe` Just ["foo", "bar", "baz"] it "reduceABA [Just [foo]]" $ reduceABA [Just ["foo", "bar"], Just ["baz"]] `shouldBe` [Just "foo", Just "bar", Just "baz"] describe "<$$>" $ do it "<$$> over [Maybe String]" $ do (++ "bar") <$$> [Just "foo", Nothing] `shouldBe` [Just "foobar", Nothing] it "<$$> over [[String]]" $ do (++ "x") <$$> [["foo", "bar"]] `shouldBe` [["foox", "barx"]] describe ">>>=" $ do it ">>>= over [Maybe String]" $ do let f x = case x of { "foo" -> [] ; "bar" -> [Nothing] ; _ -> [Just x, Just (x ++ "baz")] } let y = ([Nothing, Just "foo", Just "bar", Just "baz"] >>>= f) y `shouldBe` [Nothing, Nothing, Just "baz", Just "bazbaz"] describe ">>==" $ do it ">>== over [Maybe String]" $ do let f x = case x of { "foo" -> Nothing ; "bar" -> Just "bar" ; _ -> Just (x ++ "xxx") } let y = ([Nothing, Just "foo", Just "bar", Just "baz"] >>== f) y `shouldBe` [Nothing, Nothing, Just "bar", Just "bazxxx"] describe ">=>=" $ do it ">=>= over [Maybe String]" $ do let f x = case x of { "foo" -> [] ; "bar" -> ["bar"] ; _ -> [x, x ++ "xxx"] } let y = ([Nothing, Just "foo", Just "bar", Just "baz"] >=>= f) y `shouldBe` [Nothing, Just "bar", Just "baz", Just "bazxxx"] describe "Deep" $ do it "wrap" $ property $ \x -> do let y = [x] :: [Int] wrap y `shouldBe` (Deep [y]) wrap y `shouldBe` (Deep (Just y)) it "inject+expose+eject" $ property $ \x -> do let y = [x] :: [Int] inject y `shouldBe` (Deep [y]) (expose $ inject y) `shouldBe` [y] (eject head $ inject y) `shouldBe` y inject y `shouldBe` (Deep [Just x]) (expose $ inject y) `shouldBe` [Just x] it "return" $ property $ \x -> do let y = [[x]] :: [[Int]] return x `shouldBe` (Deep y) pure x `shouldBe` (Deep y) it "<*> + <$>" $ property $ \x -> do let f = (\k -> k * 2) :: Int -> Int f <$> (pure x) `shouldBe` (Deep (Just [x * 2])) ((pure f) <*> (pure x)) `shouldBe` (Deep (Just [x * 2]))