Created
January 28, 2025 19:28
-
-
Save Skyb0rg007/79c96fbdbf834c020a9e8183589ad1f4 to your computer and use it in GitHub Desktop.
Different behavior of higher-order effects libraries
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/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] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment