Different behavior of higher-order effects libraries

eff-test.hs

#!/usr/bin/env stack
{-
stack script
    --resolver lts-22.14
    --package freer-simple
    --package fused-effects
    --package hspec
    --package list-t
    --package mtl
    --package polysemy
    --package transformers
-}
{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs,
             LambdaCase, MultiParamTypeClasses, PackageImports,
             PolyKinds, RankNTypes, ScopedTypeVariables,
             TypeApplications, TypeFamilies, TypeOperators
#-}

module Main where

import           Control.Applicative (Alternative, (<|>))
import           Data.Functor.Identity (runIdentity, Identity)
import           Test.Hspec (describe, it, shouldBe, Spec, hspec)
import           Data.Void (vacuous)
import           Control.Monad (join)
import qualified Control.Algebra as F
import qualified Control.Carrier.Error.Either as F
import qualified Control.Carrier.NonDet.Church as F
import qualified Control.Monad.Except as MTL
import qualified Control.Monad.Freer as FS
import qualified Control.Monad.Freer.Coroutine as FS
import qualified Control.Monad.Freer.Error as FS
import qualified Control.Monad.Freer.NonDet as FS
import qualified ListT as ListT
import qualified Polysemy as P
import qualified Polysemy.Error as P
import qualified Polysemy.NonDet as P
-- import qualified "in-other-words" Control.Effect as IOW
-- import qualified "in-other-words" Control.Effect.Error as IOW
-- import qualified "in-other-words" Control.Effect.NonDet as IOW

-- catchError :: m a -> (e -> m a) -> m a
--
-- catchError (Left e) k = k e

listT1 :: ListT.ListT (MTL.Except ()) Bool
listT1 =
    (MTL.throwError () <|> pure True)
    `MTL.catchError` (\() -> pure False) -- [Right False, Right True]

listT2 :: MTL.ExceptT () (ListT.ListT Identity) Bool
listT2 =
    (MTL.throwError () <|> pure True)
    `MTL.catchError` (\() -> pure False) -- Right [False]

polysemy :: (P.Members '[P.NonDet, P.Error ()] r) => P.Sem r Bool
polysemy =
    (P.throw () <|> pure True)
    `P.catch` (\() -> pure False)

fusedEffects :: (F.Has F.NonDet sig m, F.Has (F.Error ()) sig m, Alternative m) => m Bool
fusedEffects =
    (F.throwError () <|> pure True)
    `F.catchError` (\() -> pure False)

freerSimple :: FS.Members '[FS.Error (), FS.NonDet] effs => FS.Eff effs Bool
freerSimple =
    (FS.throwError () <|> pure True)
    `FS.catchError` (\() -> pure False)

-- inOtherWords :: (IOW.Effs '[IOW.Error (), IOW.NonDet] m) => m Bool
-- inOtherWords =
--     (IOW.throw () `IOW.choose` pure True)
--     `IOW.catch` (\() -> pure False)

main :: IO ()
main = do
    putStrLn "Running the following:"
    putStrLn ""
    putStrLn "\t(throw () <|> pure True)"
    putStrLn "\t`catch` (\\() -> pure False)"
    putStrLn ""
    hspec spec

spec :: Spec
spec = do
    describe "mtl + list-t" $ do
        it "Incorrectly returns (Right [False]) with ListT over ExceptT" $
            MTL.runExcept (ListT.toList listT1)
            `shouldBe` Right [False]
        it "Incorrectly returns [Right True] with ExceptT over ListT" $
            runIdentity (ListT.toList (MTL.runExceptT listT2))
            `shouldBe` [Right True]

    describe "polysemy" $ do
        it "Incorrectly returns (Right [False]) with NonDet over Error" $
            P.run (P.runError @() (P.runNonDet @[] polysemy))
            `shouldBe` Right [False]
        it "Returns [Right False, Right True] with Error over NonDet" $
            P.run (P.runNonDet @[] (P.runError @() polysemy))
            `shouldBe` [Right False, Right True]

    describe "fused-effects" $ do
        it "Incorrectly returns (Right [False]) with NonDet over Error" $
            F.run (F.runError @() (F.runNonDetA @[] fusedEffects))
            `shouldBe` Right [False]
        it "Returns [Right False, Right True] with Error over NonDet" $
            F.run (F.runNonDetA @[] (F.runError @() fusedEffects))
            `shouldBe` [Right False, Right True]

    describe "freer-simple" $ do
        it "Returns (Right [False, True]) with NonDet over Error" $
            FS.run (FS.runError @() (FS.makeChoiceA @[] freerSimple))
            `shouldBe` Right [False, True]
        it "Returns [Right False, Right True] with Error over NonDet" $
            FS.run (FS.makeChoiceA @[] (FS.runError @() freerSimple))
            `shouldBe` [Right False, Right True]

    -- describe "in-other-words" $ do
    --     it "Incorrectly returns (Right [False]) with NonDet over Error" $
    --         IOW.run (IOW.runError @() (IOW.runNonDet @[] inOtherWords))
    --         `shouldBe` Right [False]
    --     it "Returns [Right False, Right True] with Error over NonDet" $
    --         IOW.run (IOW.runNonDet @[] (IOW.runError @() inOtherWords))
    --         `shouldBe` [Right False, Right True]