Skip to content

Instantly share code, notes, and snippets.

@Skyb0rg007
Created January 28, 2025 19:28
Show Gist options
  • Save Skyb0rg007/79c96fbdbf834c020a9e8183589ad1f4 to your computer and use it in GitHub Desktop.
Save Skyb0rg007/79c96fbdbf834c020a9e8183589ad1f4 to your computer and use it in GitHub Desktop.
Different behavior of higher-order effects libraries
#!/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