├── cabal.project ├── Setup.hs ├── .gitignore ├── src ├── EffectZoo │ └── Scenario │ │ ├── Reinterpretation │ │ ├── Shared.hs │ │ ├── FreerSimple │ │ │ ├── HTTP.hs │ │ │ ├── Logging.hs │ │ │ ├── Zooit.hs │ │ │ └── Main.hs │ │ ├── SimpleEffects │ │ │ ├── HTTP.hs │ │ │ ├── Logging.hs │ │ │ ├── Zooit.hs │ │ │ └── Main.hs │ │ └── FusedEffects │ │ │ ├── Main.hs │ │ │ ├── HTTP.hs │ │ │ ├── Logging.hs │ │ │ └── Zooit.hs │ │ ├── CountDown │ │ ├── MTL │ │ │ ├── LazyStateT.hs │ │ │ ├── StrictStateT.hs │ │ │ └── Program.hs │ │ ├── Reference.hs │ │ ├── FreerSimple │ │ │ ├── Main.hs │ │ │ └── Program.hs │ │ ├── FusedEffects │ │ │ ├── Main.hs │ │ │ └── Program.hs │ │ └── SimpleEffects │ │ │ ├── Program.hs │ │ │ └── Main.hs │ │ ├── BigStack │ │ ├── SimpleEffects │ │ │ ├── Identity.hs │ │ │ ├── Program.hs │ │ │ └── Main.hs │ │ ├── MTL │ │ │ ├── Program.hs │ │ │ ├── Identity.hs │ │ │ └── Main.hs │ │ ├── FreerSimple │ │ │ ├── Identity.hs │ │ │ ├── Program.hs │ │ │ └── Main.hs │ │ └── FusedEffects │ │ │ ├── Program.hs │ │ │ ├── Identity.hs │ │ │ └── Main.hs │ │ ├── FileSizes │ │ ├── SimpleEffects │ │ │ ├── Main.hs │ │ │ ├── File.hs │ │ │ ├── Logging.hs │ │ │ └── Program.hs │ │ ├── Shared.hs │ │ ├── FreerSimple │ │ │ ├── Main.hs │ │ │ ├── File.hs │ │ │ ├── Logging.hs │ │ │ └── Program.hs │ │ ├── FusedEffects │ │ │ ├── Main.hs │ │ │ ├── Program.hs │ │ │ ├── File.hs │ │ │ └── Logging.hs │ │ ├── MTL │ │ │ ├── File.hs │ │ │ ├── Main.hs │ │ │ ├── Program.hs │ │ │ └── Logging.hs │ │ └── Reference.hs │ │ ├── Reinterpretation.hs │ │ ├── FileSizes.hs │ │ ├── CountDown.hs │ │ └── BigStack.hs └── Main.hs ├── README.md ├── shell.nix ├── LICENSE ├── plot.r └── effect-zoo.cabal /cabal.project: -------------------------------------------------------------------------------- 1 | packages: 2 | effect-zoo.cabal 3 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.hi 2 | *.o 3 | .ghc.environment* 4 | dist/ 5 | dist-newstyle 6 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/Shared.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.Reinterpretation.Shared where 2 | 3 | response :: String 4 | response = 5 | unlines 6 | [ "BigStack" 7 | , "CountDown" 8 | , "FileSizes" 9 | , "Inline" 10 | , "NoInline" 11 | ] 12 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/MTL/LazyStateT.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.CountDown.MTL.LazyStateT where 2 | 3 | import Control.Monad.Trans.State.Lazy 4 | import EffectZoo.Scenario.CountDown.MTL.Program 5 | 6 | countDown :: Int -> (Int, Int) 7 | countDown initial = runState program initial 8 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/MTL/StrictStateT.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.CountDown.MTL.StrictStateT where 2 | 3 | import Control.Monad.Trans.State.Strict 4 | import EffectZoo.Scenario.CountDown.MTL.Program 5 | 6 | countDown :: Int -> (Int, Int) 7 | countDown initial = runState program initial 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Effect Zoo: Subjective and Objective Analysis of Haskell Effect Frameworks 2 | 3 | This project aims to demonstrate effect systems through a variety of scenarios to allow users to understand their strengths and weaknesses, both in raw performance (as benchmarked by criterion) and more subjective measures like ease of use by manual code review. 4 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/SimpleEffects/Identity.hs: -------------------------------------------------------------------------------- 1 | {-# language KindSignatures #-} 2 | 3 | module EffectZoo.Scenario.BigStack.SimpleEffects.Identity where 4 | 5 | import Control.Effects 6 | 7 | data Identity (m :: * -> *) = Identity 8 | 9 | runIdentity :: RuntimeImplemented Identity m a -> m a 10 | runIdentity = implement Identity 11 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/Reference.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.CountDown.Reference where 4 | 5 | import Data.Functor.Identity 6 | 7 | countDown :: Int -> (Int, Int) 8 | countDown = program 9 | 10 | program :: Int -> (Int, Int) 11 | program n = if n <= 0 then (n, n) else program (n - 1) 12 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/FreerSimple/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.CountDown.FreerSimple.Main where 2 | 3 | import Control.Monad.Freer 4 | import Control.Monad.Freer.State 5 | import EffectZoo.Scenario.CountDown.FreerSimple.Program 6 | 7 | countDown :: Int -> (Int, Int) 8 | countDown initial = run (runState initial program) 9 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/FusedEffects/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.CountDown.FusedEffects.Main where 2 | 3 | import Control.Effect 4 | import Control.Effect.State 5 | import Control.Effect.Void 6 | import EffectZoo.Scenario.CountDown.FusedEffects.Program 7 | 8 | countDown :: Int -> (Int, Int) 9 | countDown initial = run (runState initial program) 10 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/MTL/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.BigStack.MTL.Program where 4 | 5 | import Control.Monad 6 | import Control.Monad.Reader.Class 7 | import Control.Monad.State.Class 8 | 9 | program :: (MonadReader Int m, MonadState Int m) => m () 10 | program = do 11 | n <- ask 12 | replicateM_ n (modify (+ n)) 13 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/SimpleEffects/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.CountDown.SimpleEffects.Program where 4 | 5 | import Control.Effects 6 | import Control.Effects.State 7 | 8 | program :: MonadEffect (State Int) m => m Int 9 | program = do 10 | n <- getState 11 | if n <= 0 12 | then pure n 13 | else do 14 | setState (n - 1) 15 | program 16 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/FreerSimple/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.CountDown.FreerSimple.Program where 4 | 5 | import Control.Monad.Freer 6 | import Control.Monad.Freer.State 7 | 8 | program :: Member (State Int) effects => Eff effects Int 9 | program = do 10 | n <- get 11 | if n <= 0 12 | then pure n 13 | else do 14 | put (n - 1) 15 | program 16 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/FusedEffects/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.CountDown.FusedEffects.Program where 4 | 5 | import Control.Effect 6 | import Control.Effect.State 7 | 8 | program :: (Member (State Int) sig, Carrier sig m, Monad m) => m Int 9 | program = do 10 | n <- get 11 | if n <= 0 12 | then pure n 13 | else do 14 | put (n - 1) 15 | program 16 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/FreerSimple/Identity.hs: -------------------------------------------------------------------------------- 1 | {-# language GADTs, FlexibleContexts, TypeOperators, DataKinds #-} 2 | module EffectZoo.Scenario.BigStack.FreerSimple.Identity where 3 | 4 | import Control.Monad.Freer 5 | 6 | data Identity a where 7 | Noop :: Identity () 8 | 9 | noop :: Member Identity effs => Eff effs () 10 | noop = send Noop 11 | 12 | runIdentity :: Eff (Identity ': effs) a -> Eff effs a 13 | runIdentity = interpret $ \Noop -> return () 14 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/SimpleEffects/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds, FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.BigStack.SimpleEffects.Program where 4 | 5 | import Control.Effects 6 | import Control.Effects.Reader 7 | import Control.Effects.State 8 | import Control.Monad 9 | 10 | program :: MonadEffects '[State Int, ReadEnv Int] m => m () 11 | program = do 12 | n <- readEnv 13 | replicateM_ n (modifyState (+ n)) 14 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/FreerSimple/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.BigStack.FreerSimple.Program where 4 | 5 | import Control.Monad 6 | import Control.Monad.Freer 7 | import Control.Monad.Freer.Reader 8 | import Control.Monad.Freer.State 9 | 10 | program :: (Member (Reader Int) effs, Member (State Int) effs) => Eff effs () 11 | program = do 12 | n <- ask 13 | replicateM_ n (modify (+ n)) 14 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/FusedEffects/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.BigStack.FusedEffects.Program where 4 | 5 | import Control.Effect 6 | import Control.Effect.Reader 7 | import Control.Effect.State 8 | import Control.Monad 9 | 10 | program 11 | :: (Member (Reader Int) sig, Member (State Int) sig, Carrier sig m, Monad m) 12 | => m () 13 | program = do 14 | n <- ask 15 | replicateM_ n (modify (+ n)) 16 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/SimpleEffects/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.CountDown.SimpleEffects.Main where 2 | 3 | import Control.Effects 4 | import Control.Effects.State 5 | import Data.Functor.Identity 6 | import EffectZoo.Scenario.CountDown.SimpleEffects.Program 7 | 8 | countDown :: Int -> (Int, Int) 9 | countDown initial = runIdentity 10 | (implementStateViaStateT 11 | initial 12 | (program >>= \x -> getState >>= \y -> return (x, y)) 13 | ) 14 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/MTL/Identity.hs: -------------------------------------------------------------------------------- 1 | {-# language GeneralizedNewtypeDeriving, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses #-} 2 | module EffectZoo.Scenario.BigStack.MTL.Identity where 3 | 4 | import Control.Monad 5 | import Control.Monad.Reader.Class 6 | import Control.Monad.State.Class 7 | 8 | newtype IdentityT m a = IdentityT { runIdentityT :: m a } 9 | deriving (Functor, Applicative, Monad) 10 | 11 | instance MonadState s m => MonadState s (IdentityT m) where 12 | get = IdentityT get 13 | put = IdentityT . put 14 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/FreerSimple/HTTP.hs: -------------------------------------------------------------------------------- 1 | {-# language DataKinds, FlexibleContexts, GADTs, TypeOperators #-} 2 | module EffectZoo.Scenario.Reinterpretation.FreerSimple.HTTP where 3 | 4 | import Control.Monad.Freer 5 | import Control.Monad.Freer.Reader 6 | 7 | data HTTP a where 8 | GET :: String -> HTTP String 9 | 10 | 11 | httpGET :: Member HTTP effs => String -> Eff effs String 12 | httpGET = send . GET 13 | 14 | 15 | mockResponses :: Eff ( HTTP ': effs ) a -> Eff ( Reader String ': effs ) a 16 | mockResponses = 17 | reinterpret $ \( GET _path ) -> ask 18 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown/MTL/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.CountDown.MTL.Program where 4 | 5 | import Control.Monad.State ( MonadState 6 | , get 7 | , put 8 | ) 9 | 10 | program :: MonadState Int m => m Int 11 | program = do 12 | n <- get 13 | if n <= 0 14 | then pure n 15 | else do 16 | put (n - 1) 17 | program 18 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/SimpleEffects/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.FileSizes.SimpleEffects.Main where 2 | 3 | import Data.IORef 4 | import EffectZoo.Scenario.FileSizes.SimpleEffects.File 5 | import EffectZoo.Scenario.FileSizes.SimpleEffects.Logging 6 | import EffectZoo.Scenario.FileSizes.SimpleEffects.Program 7 | 8 | calculateFileSizes :: [FilePath] -> IO (Int, [String]) 9 | calculateFileSizes files = do 10 | logs <- newIORef [] 11 | size <- fileIO (logToIORef logs (program files)) 12 | finalLogs <- readIORef logs 13 | return (size, finalLogs) 14 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/FreerSimple/Logging.hs: -------------------------------------------------------------------------------- 1 | {-# language DataKinds, FlexibleContexts, GADTs, TypeOperators #-} 2 | module EffectZoo.Scenario.Reinterpretation.FreerSimple.Logging where 3 | 4 | import Control.Monad.Freer 5 | import Control.Monad.Freer.Writer 6 | 7 | data Logging a where 8 | LogMsg :: String -> Logging () 9 | 10 | 11 | logMsg :: Member Logging effs => String -> Eff effs () 12 | logMsg = send . LogMsg 13 | 14 | 15 | accumulateLogMessages :: Eff ( Logging ': effs ) a -> Eff ( Writer [String] ': effs ) a 16 | accumulateLogMessages = 17 | reinterpret $ \( LogMsg m ) -> tell [m] 18 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/Shared.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.FileSizes.Shared where 2 | 3 | import Control.Exception 4 | import Data.IORef 5 | import System.Posix 6 | 7 | tryGetFileSize :: FilePath -> IO (Maybe Int) 8 | tryGetFileSize path = do 9 | estat <- try (getFileStatus path) 10 | case estat of 11 | Left SomeException{} -> return Nothing 12 | Right stat -> return (Just (fromIntegral (fileSize stat))) 13 | 14 | {-# INLINE tryGetFileSize #-} 15 | logToIORef :: IORef [String] -> String -> IO () 16 | logToIORef r msg = modifyIORef r (msg :) 17 | 18 | {-# INLINE logToIORef #-} 19 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/FreerSimple/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.FileSizes.FreerSimple.Main where 2 | 3 | import Control.Monad.Freer 4 | import Data.IORef 5 | import EffectZoo.Scenario.FileSizes.FreerSimple.File 6 | import EffectZoo.Scenario.FileSizes.FreerSimple.Logging 7 | import EffectZoo.Scenario.FileSizes.FreerSimple.Program 8 | 9 | calculateFileSizes :: [FilePath] -> IO (Int, [String]) 10 | calculateFileSizes files = do 11 | logs <- newIORef [] 12 | size <- runM (fileIO (logToIORef logs (program files))) 13 | finalLogs <- readIORef logs 14 | return (size, finalLogs) 15 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/FusedEffects/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.FileSizes.FusedEffects.Main where 2 | 3 | import Control.Effect 4 | import Data.IORef 5 | import EffectZoo.Scenario.FileSizes.FusedEffects.File 6 | import EffectZoo.Scenario.FileSizes.FusedEffects.Logging 7 | import EffectZoo.Scenario.FileSizes.FusedEffects.Program 8 | 9 | calculateFileSizes :: [FilePath] -> IO (Int, [String]) 10 | calculateFileSizes files = do 11 | logs <- newIORef [] 12 | size <- runM (runFileIOC2 (runLogIOC2 logs (program files))) 13 | finalLogs <- readIORef logs 14 | return (size, finalLogs) 15 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/MTL/File.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | module EffectZoo.Scenario.FileSizes.MTL.File where 4 | 5 | import Control.Monad.IO.Class 6 | import qualified EffectZoo.Scenario.FileSizes.Shared 7 | as Shared 8 | 9 | class Monad m => 10 | MonadFile m 11 | where 12 | tryFileSize :: FilePath -> m (Maybe Int) 13 | 14 | newtype FileT m a = FileT 15 | { runFileT :: m a 16 | } deriving (Functor, Applicative, Monad, MonadIO) 17 | 18 | instance MonadIO m => MonadFile (FileT m) where 19 | tryFileSize path = liftIO (Shared.tryGetFileSize path) 20 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/FreerSimple/File.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds, FlexibleContexts, GADTs, TypeOperators #-} 2 | 3 | module EffectZoo.Scenario.FileSizes.FreerSimple.File where 4 | 5 | import Control.Monad.Freer 6 | import qualified EffectZoo.Scenario.FileSizes.Shared 7 | as Shared 8 | 9 | data File a where 10 | TryFileSize :: FilePath -> File (Maybe Int) 11 | 12 | tryFileSize :: Member File effs => FilePath -> Eff effs (Maybe Int) 13 | tryFileSize = send . TryFileSize 14 | 15 | fileIO :: LastMember IO effs => Eff (File ': effs) a -> Eff effs a 16 | fileIO = interpret (\(TryFileSize path) -> sendM $ Shared.tryGetFileSize path) 17 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/MTL/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.FileSizes.MTL.Main where 2 | 3 | import Control.Monad.Trans.Class 4 | import Data.IORef 5 | import EffectZoo.Scenario.FileSizes.MTL.File 6 | import EffectZoo.Scenario.FileSizes.MTL.Logging 7 | import EffectZoo.Scenario.FileSizes.MTL.Program 8 | 9 | instance MonadFile m => MonadFile (LogToIORef m) where 10 | tryFileSize = lift . tryFileSize 11 | 12 | calculateFileSizes :: [FilePath] -> IO (Int, [String]) 13 | calculateFileSizes files = do 14 | logs <- newIORef [] 15 | size <- runFileT (runLogToIORefT (program files) logs) 16 | finalLogs <- readIORef logs 17 | return (size, finalLogs) 18 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/SimpleEffects/HTTP.hs: -------------------------------------------------------------------------------- 1 | {-# language GADTs, DeriveAnyClass, DeriveGeneric, FlexibleContexts, NoMonomorphismRestriction #-} 2 | 3 | module EffectZoo.Scenario.Reinterpretation.SimpleEffects.HTTP where 4 | 5 | import Control.Effects 6 | import Control.Effects.Reader 7 | import GHC.Generics 8 | 9 | data HTTP m = 10 | HTTP 11 | { _GET :: String -> m String 12 | } 13 | deriving (Generic, Effect) 14 | 15 | httpGET :: MonadEffect HTTP m => String -> m String 16 | HTTP httpGET = effect 17 | 18 | 19 | mockResponses 20 | :: MonadEffect (ReadEnv String) m => RuntimeImplemented HTTP m a -> m a 21 | mockResponses = implement HTTP {_GET = \_path -> readEnv} 22 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/FreerSimple/Zooit.hs: -------------------------------------------------------------------------------- 1 | {-# language DataKinds, FlexibleContexts, GADTs, TypeOperators #-} 2 | module EffectZoo.Scenario.Reinterpretation.FreerSimple.Zooit where 3 | 4 | import Control.Monad.Freer 5 | import EffectZoo.Scenario.Reinterpretation.FreerSimple.Logging 6 | import EffectZoo.Scenario.Reinterpretation.FreerSimple.HTTP 7 | 8 | data Zooit a where 9 | ListScenarios :: Zooit [String] 10 | 11 | 12 | listScenarios :: Member Zooit effs => Eff effs [String] 13 | listScenarios = send ListScenarios 14 | 15 | 16 | toLoggedHTTP :: Eff ( Zooit ': effs ) a -> Eff ( HTTP ': Logging ': effs ) a 17 | toLoggedHTTP = 18 | reinterpret2 $ \ListScenarios -> do 19 | logMsg "Fetching a list of scenarios" 20 | lines <$> httpGET "/scenarios" 21 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/SimpleEffects/Logging.hs: -------------------------------------------------------------------------------- 1 | {-# language DeriveAnyClass, GADTs, DeriveGeneric, FlexibleContexts, NoMonomorphismRestriction #-} 2 | 3 | module EffectZoo.Scenario.Reinterpretation.SimpleEffects.Logging where 4 | 5 | import Control.Effects 6 | import Control.Effects.State 7 | import GHC.Generics 8 | 9 | data Logging m = 10 | Logging 11 | { _logMsg :: String -> m () 12 | } 13 | deriving (Generic, Effect) 14 | 15 | logMsg :: MonadEffect Logging m => String -> m () 16 | Logging logMsg = effect 17 | 18 | 19 | accumulateLogMessages 20 | :: MonadEffect (State [String]) m => RuntimeImplemented Logging m a -> m a 21 | accumulateLogMessages = 22 | implement Logging {_logMsg = \m -> modifyState (++ [m])} 23 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/FreerSimple/Logging.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds, FlexibleContexts, GADTs, TypeOperators #-} 2 | 3 | module EffectZoo.Scenario.FileSizes.FreerSimple.Logging where 4 | 5 | import Control.Monad.Freer 6 | import Control.Monad.IO.Class 7 | import Data.IORef 8 | import qualified EffectZoo.Scenario.FileSizes.Shared 9 | as Shared 10 | 11 | data Logging a where 12 | LogMsg :: String -> Logging () 13 | 14 | logMsg :: Member Logging effs => String -> Eff effs () 15 | logMsg = send . LogMsg 16 | 17 | logToIORef 18 | :: LastMember IO effs 19 | => IORef [String] 20 | -> Eff (Logging ': effs) a 21 | -> Eff effs a 22 | logToIORef r = interpret (\(LogMsg m) -> sendM (Shared.logToIORef r m)) 23 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/MTL/Program.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.FileSizes.MTL.Program where 2 | 3 | import Control.Effects 4 | import EffectZoo.Scenario.FileSizes.MTL.File 5 | import EffectZoo.Scenario.FileSizes.MTL.Logging 6 | 7 | program :: (MonadLog m, MonadFile m) => [FilePath] -> m Int 8 | program files = do 9 | sizes <- traverse calculateFileSize files 10 | return (sum sizes) 11 | 12 | calculateFileSize :: (MonadLog m, MonadFile m) => FilePath -> m Int 13 | calculateFileSize path = do 14 | logMsg ("Calculating the size of " ++ path) 15 | msize <- tryFileSize path 16 | case msize of 17 | Nothing -> 0 <$ logMsg ("Could not calculate the size of " ++ path) 18 | Just size -> size <$ logMsg (path ++ " is " ++ show size ++ " bytes") 19 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/SimpleEffects/File.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass, DeriveGeneric, FlexibleContexts, 2 | NoMonomorphismRestriction #-} 3 | 4 | module EffectZoo.Scenario.FileSizes.SimpleEffects.File where 5 | 6 | import Control.Effects 7 | import Control.Monad.IO.Class 8 | import qualified EffectZoo.Scenario.FileSizes.Shared 9 | as Shared 10 | import GHC.Generics 11 | 12 | data File m = File 13 | { _tryFileSize :: FilePath -> m (Maybe Int) 14 | } deriving (Generic, Effect) 15 | 16 | tryFileSize :: MonadEffect File m => FilePath -> m (Maybe Int) 17 | File tryFileSize = effect 18 | 19 | fileIO :: MonadIO m => RuntimeImplemented File m a -> m a 20 | fileIO = 21 | implement File {_tryFileSize = \path -> liftIO (Shared.tryGetFileSize path)} 22 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/SimpleEffects/Logging.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass, DeriveGeneric, FlexibleContexts, 2 | NoMonomorphismRestriction #-} 3 | 4 | module EffectZoo.Scenario.FileSizes.SimpleEffects.Logging where 5 | 6 | import Control.Effects 7 | import Control.Monad.IO.Class 8 | import Data.IORef 9 | import qualified EffectZoo.Scenario.FileSizes.Shared 10 | as Shared 11 | import GHC.Generics 12 | 13 | data Logging m = Logging 14 | { _logMsg :: String -> m () 15 | } deriving (Generic, Effect) 16 | 17 | logMsg :: MonadEffect Logging m => String -> m () 18 | Logging logMsg = effect 19 | 20 | logToIORef 21 | :: MonadIO m => IORef [String] -> RuntimeImplemented Logging m a -> m a 22 | logToIORef ref = 23 | implement Logging {_logMsg = \m -> liftIO (Shared.logToIORef ref m)} 24 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/SimpleEffects/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | 3 | module EffectZoo.Scenario.FileSizes.SimpleEffects.Program where 4 | 5 | import Control.Effects 6 | import EffectZoo.Scenario.FileSizes.SimpleEffects.File 7 | import EffectZoo.Scenario.FileSizes.SimpleEffects.Logging 8 | 9 | program :: MonadEffects '[File, Logging] m => [FilePath] -> m Int 10 | program files = do 11 | sizes <- traverse calculateFileSize files 12 | return (sum sizes) 13 | 14 | calculateFileSize :: MonadEffects '[File, Logging] m => FilePath -> m Int 15 | calculateFileSize path = do 16 | logMsg ("Calculating the size of " ++ path) 17 | msize <- tryFileSize path 18 | case msize of 19 | Nothing -> 0 <$ logMsg ("Could not calculate the size of " ++ path) 20 | Just size -> size <$ logMsg (path ++ " is " ++ show size ++ " bytes") 21 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.Reinterpretation where 2 | 3 | import Criterion 4 | import qualified EffectZoo.Scenario.Reinterpretation.FreerSimple.Main 5 | as FreerSimple 6 | import qualified EffectZoo.Scenario.Reinterpretation.FusedEffects.Main 7 | as FusedEffects 8 | import qualified EffectZoo.Scenario.Reinterpretation.SimpleEffects.Main 9 | as SimpleEffects 10 | 11 | benchmarks :: [(String, String, Benchmarkable)] 12 | benchmarks = do 13 | (name, program) <- 14 | [ ("freer-simple" , FreerSimple.listScenarios) 15 | , ("fused-effects" , FusedEffects.listScenarios) 16 | , ("simple-effects", SimpleEffects.listScenarios) 17 | ] 18 | 19 | n <- [1, 10, 100] 20 | 21 | return (name, show n, nfIO (program n)) 22 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/FreerSimple/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.FileSizes.FreerSimple.Program where 4 | 5 | import Control.Monad.Freer 6 | import EffectZoo.Scenario.FileSizes.FreerSimple.File 7 | import EffectZoo.Scenario.FileSizes.FreerSimple.Logging 8 | 9 | program :: (Member File effs, Member Logging effs) => [FilePath] -> Eff effs Int 10 | program files = do 11 | sizes <- traverse calculateFileSize files 12 | return (sum sizes) 13 | 14 | calculateFileSize 15 | :: (Member File effs, Member Logging effs) => FilePath -> Eff effs Int 16 | calculateFileSize path = do 17 | logMsg ("Calculating the size of " ++ path) 18 | msize <- tryFileSize path 19 | case msize of 20 | Nothing -> 0 <$ logMsg ("Could not calculate the size of " ++ path) 21 | Just size -> size <$ logMsg (path ++ " is " ++ show size ++ " bytes") 22 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/FusedEffects/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.Reinterpretation.FusedEffects.Main where 2 | 3 | import Control.Monad 4 | import Control.Effect 5 | import Control.Effect.Reader 6 | import Control.Effect.Writer 7 | import Data.Function 8 | import EffectZoo.Scenario.Reinterpretation.FusedEffects.HTTP 9 | import EffectZoo.Scenario.Reinterpretation.FusedEffects.Logging 10 | import EffectZoo.Scenario.Reinterpretation.FusedEffects.Zooit 11 | as Zooit 12 | import EffectZoo.Scenario.Reinterpretation.Shared 13 | 14 | listScenarios :: Int -> IO ([String], [String]) 15 | listScenarios n = 16 | fmap concat (replicateM n Zooit.listScenarios) 17 | & toLoggedHTTP 18 | & mockResponses 19 | & runReader response 20 | & accumulateLogMessages 21 | & runWriter 22 | & runM 23 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/SimpleEffects/Zooit.hs: -------------------------------------------------------------------------------- 1 | {-# language DeriveAnyClass, DataKinds, GADTs, DeriveGeneric, FlexibleContexts, NoMonomorphismRestriction #-} 2 | 3 | module EffectZoo.Scenario.Reinterpretation.SimpleEffects.Zooit where 4 | 5 | import Control.Effects 6 | import GHC.Generics 7 | import EffectZoo.Scenario.Reinterpretation.SimpleEffects.Logging 8 | import EffectZoo.Scenario.Reinterpretation.SimpleEffects.HTTP 9 | 10 | data Zooit m = 11 | Zooit 12 | { _listScenarios :: m [String] 13 | } 14 | deriving (Generic, Effect) 15 | 16 | listScenarios :: MonadEffect Zooit m => m [String] 17 | Zooit listScenarios = effect 18 | 19 | 20 | toLoggedHTTP 21 | :: MonadEffects '[Logging, HTTP] m => RuntimeImplemented Zooit m a -> m a 22 | toLoggedHTTP = implement Zooit 23 | { _listScenarios = do 24 | logMsg "Fetching a list of scenarios" 25 | lines <$> httpGET "/scenarios" 26 | } 27 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/FreerSimple/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.Reinterpretation.FreerSimple.Main where 2 | 3 | import Control.Monad 4 | import Control.Monad.Freer 5 | import Control.Monad.Freer.Reader 6 | import Control.Monad.Freer.Writer 7 | import Data.Function 8 | import EffectZoo.Scenario.Reinterpretation.FreerSimple.HTTP 9 | import EffectZoo.Scenario.Reinterpretation.FreerSimple.Logging 10 | import EffectZoo.Scenario.Reinterpretation.FreerSimple.Zooit 11 | as Zooit 12 | import EffectZoo.Scenario.Reinterpretation.Shared 13 | 14 | listScenarios :: Int -> IO ([String], [String]) 15 | listScenarios n = 16 | fmap concat (replicateM n Zooit.listScenarios) 17 | & toLoggedHTTP 18 | & runReader response 19 | . mockResponses 20 | & runWriter 21 | . accumulateLogMessages 22 | & runM 23 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/FusedEffects/Program.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.FileSizes.FusedEffects.Program where 4 | 5 | import Control.Effect 6 | import EffectZoo.Scenario.FileSizes.FusedEffects.File 7 | import EffectZoo.Scenario.FileSizes.FusedEffects.Logging 8 | 9 | program 10 | :: (Member File sig, Member Logging sig, Carrier sig m, Monad m) 11 | => [FilePath] 12 | -> m Int 13 | program files = do 14 | sizes <- traverse calculateFileSize files 15 | return (sum sizes) 16 | 17 | calculateFileSize 18 | :: (Member File sig, Member Logging sig, Carrier sig m, Monad m) 19 | => FilePath 20 | -> m Int 21 | calculateFileSize path = do 22 | logMsg ("Calculating the size of " ++ path) 23 | msize <- tryFileSize path 24 | case msize of 25 | Nothing -> 0 <$ logMsg ("Could not calculate the size of " ++ path) 26 | Just size -> size <$ logMsg (path ++ " is " ++ show size ++ " bytes") 27 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import {}, compiler ? "default", doBenchmark ? false }: 2 | 3 | let 4 | 5 | inherit (nixpkgs) pkgs; 6 | 7 | f = { mkDerivation, base, criterion, freer-simple, mtl 8 | , simple-effects, stdenv, transformers 9 | }: 10 | mkDerivation { 11 | pname = "effect-zoo"; 12 | version = "0.1.0.0"; 13 | src = ./.; 14 | isLibrary = false; 15 | isExecutable = true; 16 | executableHaskellDepends = [ 17 | base criterion freer-simple mtl simple-effects transformers 18 | ]; 19 | license = stdenv.lib.licenses.bsd3; 20 | }; 21 | 22 | haskellPackages = if compiler == "default" 23 | then pkgs.haskellPackages 24 | else pkgs.haskell.packages.${compiler}; 25 | 26 | variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id; 27 | 28 | drv = variant (haskellPackages.callPackage f {}); 29 | 30 | in 31 | 32 | if pkgs.lib.inNixShell then drv.env else drv 33 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/SimpleEffects/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.Reinterpretation.SimpleEffects.Main where 2 | 3 | import Data.Function ( (&) ) 4 | import Control.Monad 5 | import Control.Effects.Reader 6 | import Control.Effects.State 7 | import EffectZoo.Scenario.Reinterpretation.SimpleEffects.HTTP 8 | import EffectZoo.Scenario.Reinterpretation.SimpleEffects.Logging 9 | import EffectZoo.Scenario.Reinterpretation.SimpleEffects.Zooit 10 | as Zooit 11 | import EffectZoo.Scenario.Reinterpretation.Shared 12 | 13 | listScenarios :: Int -> IO ([String], [String]) 14 | listScenarios n = 15 | ( fmap concat (replicateM n (Zooit.listScenarios)) 16 | >>= \x -> getState >>= \y -> return (x, y) 17 | ) 18 | & toLoggedHTTP 19 | & mockResponses 20 | & accumulateLogMessages 21 | & implementReadEnv (return response) 22 | & implementStateViaStateT [] 23 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/MTL/Logging.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | module EffectZoo.Scenario.FileSizes.MTL.Logging where 4 | 5 | import Control.Monad.IO.Class 6 | import Control.Monad.Trans.Class 7 | import Control.Monad.Trans.Reader 8 | import Data.IORef 9 | import qualified EffectZoo.Scenario.FileSizes.Shared 10 | as Shared 11 | 12 | class Monad m => 13 | MonadLog m 14 | where 15 | logMsg :: String -> m () 16 | 17 | newtype LogToIORef m a = 18 | LogToIORef (ReaderT (IORef [String]) m a) 19 | deriving (Functor, Applicative, Monad, MonadIO) 20 | 21 | instance MonadTrans LogToIORef where 22 | lift = LogToIORef . lift 23 | 24 | instance MonadIO m => MonadLog (LogToIORef m) where 25 | logMsg msg = 26 | LogToIORef $ do 27 | ref <- ask 28 | liftIO (Shared.logToIORef ref msg) 29 | 30 | runLogToIORefT :: LogToIORef m a -> IORef [String] -> m a 31 | runLogToIORefT (LogToIORef (ReaderT m)) ref = m ref 32 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/Reference.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.FileSizes.Reference where 4 | 5 | import Data.IORef 6 | import qualified EffectZoo.Scenario.FileSizes.Shared 7 | as Shared 8 | 9 | calculateFileSizes :: [FilePath] -> IO (Int, [String]) 10 | calculateFileSizes files = do 11 | logs <- newIORef [] 12 | size <- program logs files 13 | finalLogs <- readIORef logs 14 | return (size, finalLogs) 15 | 16 | program :: IORef [String] -> [FilePath] -> IO Int 17 | program logs files = do 18 | sizes <- traverse (calculateFileSize logs) files 19 | return (sum sizes) 20 | 21 | calculateFileSize :: IORef [String] -> FilePath -> IO Int 22 | calculateFileSize logs path = do 23 | Shared.logToIORef logs ("Calculating the size of " ++ path) 24 | msize <- Shared.tryGetFileSize path 25 | case msize of 26 | Nothing -> 27 | 0 <$ Shared.logToIORef logs ("Could not calculate the size of " ++ path) 28 | Just size -> 29 | size <$ Shared.logToIORef logs (path ++ " is " ++ show size ++ " bytes") 30 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/FusedEffects/Identity.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances, KindSignatures #-} 2 | module EffectZoo.Scenario.BigStack.FusedEffects.Identity where 3 | 4 | import Data.Coerce 5 | import Control.Effect.Carrier 6 | import Control.Effect.Sum 7 | import Control.Effect.Internal 8 | 9 | data Identity (m :: * -> *) k 10 | = Noop k 11 | deriving (Functor) 12 | 13 | instance HFunctor Identity where 14 | hmap _ = coerce 15 | 16 | instance Effect Identity where 17 | handle state handler (Noop k) = Noop (handler (k <$ state)) 18 | 19 | newtype IdentityC m a = IdentityC { runIdentityC :: m a } 20 | 21 | instance (Carrier sig m, Effect sig) => Carrier (Identity :+: sig) (IdentityC m) where 22 | ret = IdentityC . ret 23 | eff = IdentityC . handleSum (eff . handleCoercible) (\( Noop k ) -> runIdentityC k) 24 | 25 | runIdentity :: (Effect sig, Carrier sig m) => Eff (IdentityC m) a -> m a 26 | runIdentity m = runIdentityC (interpret m) 27 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.FileSizes where 2 | 3 | import Criterion 4 | import qualified EffectZoo.Scenario.FileSizes.FreerSimple.Main 5 | as FreerSimple 6 | import qualified EffectZoo.Scenario.FileSizes.FusedEffects.Main 7 | as FusedEffects 8 | import qualified EffectZoo.Scenario.FileSizes.MTL.Main 9 | as MTL 10 | import qualified EffectZoo.Scenario.FileSizes.Reference 11 | as Reference 12 | import qualified EffectZoo.Scenario.FileSizes.SimpleEffects.Main 13 | as SimpleEffects 14 | 15 | benchmarks :: [ ( String, String, Benchmarkable ) ] 16 | benchmarks = do 17 | ( implementation, go ) <- 18 | [ ( "simple-effects" , SimpleEffects.calculateFileSizes ) 19 | , ( "freer-simple", FreerSimple.calculateFileSizes ) 20 | , ( "fused-effects" , FusedEffects.calculateFileSizes ) 21 | , ( "mtl" , MTL.calculateFileSizes ) 22 | , ( "Reference", Reference.calculateFileSizes ) 23 | ] 24 | 25 | n <- 26 | [1, 10, 100] 27 | 28 | return ( implementation, ( show n ++ " files" ), nfAppIO go ( take n files ) ) 29 | 30 | 31 | files :: [FilePath] 32 | files = repeat "effect-zoo.cabal" 33 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/FusedEffects/HTTP.hs: -------------------------------------------------------------------------------- 1 | {-# language KindSignatures, FlexibleContexts, DeriveFunctor, TypeOperators, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} 2 | module EffectZoo.Scenario.Reinterpretation.FusedEffects.HTTP where 3 | 4 | import Control.Effect 5 | import Control.Effect.Carrier 6 | import Control.Effect.Sum 7 | import Control.Effect.Reader 8 | import Data.Coerce 9 | 10 | data HTTP (m :: * -> *) k = GET String ( String -> k) 11 | deriving (Functor) 12 | 13 | instance Effect HTTP where 14 | handle state handler (GET path k) = GET path (handler . (<$ state) . k) 15 | 16 | httpGET :: (Carrier sig m, Member HTTP sig) => String -> m String 17 | httpGET url = send (GET url ret) 18 | 19 | instance HFunctor HTTP where 20 | hmap _ = coerce 21 | 22 | newtype ReaderHTTPC m a = ReaderHTTPC { runReaderHTTPC :: m a } 23 | 24 | instance (Carrier sig m, Effect sig, Member (Reader String) sig, Monad m) => Carrier (HTTP :+: sig) (ReaderHTTPC m) where 25 | ret = ReaderHTTPC . ret 26 | eff = 27 | ReaderHTTPC 28 | . handleSum 29 | ( eff . handleCoercible ) 30 | ( \( GET _path k ) -> ask >>= runReaderHTTPC . k ) 31 | 32 | mockResponses 33 | :: (Monad m, Carrier sig m, Effect sig, Member (Reader String) sig) 34 | => Eff (ReaderHTTPC m) a 35 | -> m a 36 | mockResponses m = runReaderHTTPC (interpret m) 37 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/CountDown.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.CountDown where 2 | 3 | import Criterion 4 | import qualified EffectZoo.Scenario.CountDown.FreerSimple.Main 5 | as FreerSimple 6 | import qualified EffectZoo.Scenario.CountDown.FusedEffects.Main 7 | as FusedEffects 8 | import qualified EffectZoo.Scenario.CountDown.MTL.LazyStateT 9 | as MTLLazyStateT 10 | import qualified EffectZoo.Scenario.CountDown.MTL.StrictStateT 11 | as MTLStrictStateT 12 | import qualified EffectZoo.Scenario.CountDown.Reference 13 | as Reference 14 | import qualified EffectZoo.Scenario.CountDown.SimpleEffects.Main 15 | as SimpleEffects 16 | 17 | benchmarks :: [(String, String, Benchmarkable)] 18 | benchmarks = do 19 | (implementation, countDown) <- 20 | [ ("mtl (lazy)" , nf MTLLazyStateT.countDown) 21 | , ("mtl (strict)" , nf MTLStrictStateT.countDown) 22 | , ("freer-simple" , nf FreerSimple.countDown) 23 | , ("simple-effects", nf SimpleEffects.countDown) 24 | , ("fused-effects" , nf FusedEffects.countDown) 25 | , ("Reference" , nf Reference.countDown) 26 | ] 27 | 28 | n <- [100, 1000, 1000000] 29 | 30 | return (implementation, show n, countDown n) 31 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Criterion 4 | import Criterion.Types 5 | import qualified Data.ByteString.Lazy as BS 6 | import qualified Data.Csv as Csv 7 | import Data.Traversable ( for ) 8 | import qualified EffectZoo.Scenario.BigStack as BigStack 9 | import qualified EffectZoo.Scenario.CountDown as CountDown 10 | import qualified EffectZoo.Scenario.FileSizes as FileSizes 11 | import qualified EffectZoo.Scenario.Reinterpretation 12 | as Reinterpretation 13 | import Statistics.Types 14 | 15 | main :: IO () 16 | main = do 17 | for 18 | [ ("big-stack.csv" , BigStack.benchmarks) 19 | , ("countdown.csv" , CountDown.benchmarks) 20 | , ("file-sizes.csv" , FileSizes.benchmarks) 21 | , ("reinterpretation.csv", Reinterpretation.benchmarks) 22 | ] 23 | (\(csvFile, scenario) -> do 24 | reports <- for 25 | scenario 26 | (\(implementation, scenario, benchmarkable) -> do 27 | Report { reportAnalysis = SampleAnalysis { anMean = e@Estimate { estPoint = mean } } } <- 28 | Criterion.benchmark' benchmarkable 29 | 30 | let (meanL, meanU) = confidenceInterval e 31 | 32 | return (implementation, scenario, mean, meanL, meanU) 33 | ) 34 | 35 | BS.writeFile csvFile (Csv.encode reports) 36 | ) 37 | 38 | return () 39 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/FusedEffects/Logging.hs: -------------------------------------------------------------------------------- 1 | {-# language KindSignatures, FlexibleContexts, TypeOperators, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, DeriveFunctor #-} 2 | module EffectZoo.Scenario.Reinterpretation.FusedEffects.Logging where 3 | 4 | import Data.Coerce 5 | import Control.Effect 6 | import Control.Effect.Carrier 7 | import Control.Effect.Sum 8 | import Control.Effect.Writer 9 | 10 | data Logging (m :: * -> *) k = LogMsg String k 11 | deriving (Functor) 12 | 13 | logMsg :: (Carrier sig m, Member Logging sig) => String -> m () 14 | logMsg msg = send (LogMsg msg (ret ())) 15 | 16 | instance Effect Logging where 17 | handle state handler (LogMsg msg k) = LogMsg msg (handler (k <$ state)) 18 | 19 | instance HFunctor Logging where 20 | hmap _ = coerce 21 | 22 | newtype WriterLoggingC m a = WriterLoggingC { runWriterLoggingC :: m a } 23 | 24 | instance (Carrier sig m, Effect sig, Member (Writer [ String ]) sig, Monad m) => Carrier (Logging :+: sig) (WriterLoggingC m) where 25 | ret = WriterLoggingC . ret 26 | eff = 27 | WriterLoggingC 28 | . handleSum 29 | ( eff . handleCoercible ) 30 | ( \( LogMsg msg k ) -> tell [ msg ] >> runWriterLoggingC k ) 31 | 32 | accumulateLogMessages 33 | :: (Monad m, Carrier sig m, Effect sig, Member (Writer [String]) sig) 34 | => Eff (WriterLoggingC m) a 35 | -> m a 36 | accumulateLogMessages m = runWriterLoggingC (interpret m) 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, Oliver Charles 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Oliver Charles nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/Reinterpretation/FusedEffects/Zooit.hs: -------------------------------------------------------------------------------- 1 | {-# language KindSignatures, TypeOperators, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, DeriveFunctor, FlexibleContexts #-} 2 | module EffectZoo.Scenario.Reinterpretation.FusedEffects.Zooit where 3 | 4 | import Data.Coerce 5 | import Control.Effect 6 | import Control.Effect.Carrier 7 | import Control.Effect.Sum 8 | import EffectZoo.Scenario.Reinterpretation.FusedEffects.HTTP 9 | import EffectZoo.Scenario.Reinterpretation.FusedEffects.Logging 10 | 11 | data Zooit (m :: * -> *) k 12 | = ListScenarios ( [String] -> k ) 13 | deriving ( Functor ) 14 | 15 | listScenarios :: (Member Zooit sig, Carrier sig m) => m [String] 16 | listScenarios = send (ListScenarios ret) 17 | 18 | instance HFunctor Zooit where 19 | hmap _ = coerce 20 | 21 | instance Effect Zooit where 22 | handle state handler (ListScenarios k) = ListScenarios (handler . (<$ state) . k) 23 | 24 | newtype LoggedHTTPC m a = LoggedHTTPC { runLoggedHTTPC :: m a } 25 | 26 | instance (Carrier sig m, Effect sig, Monad m, Member Logging sig, Member HTTP sig) => Carrier (Zooit :+: sig) (LoggedHTTPC m) where 27 | ret = LoggedHTTPC . ret 28 | eff = 29 | LoggedHTTPC 30 | . handleSum 31 | ( eff . handleCoercible ) 32 | ( \( ListScenarios k ) -> do 33 | logMsg "Fetching a list of scenarios" 34 | scenarios <- lines <$> httpGET "/scenarios" 35 | runLoggedHTTPC (k scenarios) 36 | ) 37 | 38 | toLoggedHTTP 39 | :: (Effect sig, Carrier sig m, Member Logging sig, Member HTTP sig, Monad m) 40 | => Eff (LoggedHTTPC m) a 41 | -> m a 42 | toLoggedHTTP m = runLoggedHTTPC (interpret m) 43 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/MTL/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.BigStack.MTL.Main where 2 | 3 | import Control.Monad.Trans.Reader 4 | import Control.Monad.Trans.State.Strict 5 | import Data.Function 6 | import EffectZoo.Scenario.BigStack.MTL.Program 7 | import EffectZoo.Scenario.BigStack.MTL.Identity 8 | 9 | bigStack0 :: Int -> Int 10 | bigStack0 s = program & (`runReaderT` n) & (`execState` s) 11 | 12 | bigStack1 :: Int -> Int 13 | bigStack1 s = program & (`runReaderT` n) & runIdentityT & (`execState` s) 14 | 15 | bigStack5 :: Int -> Int 16 | bigStack5 s = 17 | program 18 | & (`runReaderT` n) 19 | & runIdentityT 20 | & runIdentityT 21 | & runIdentityT 22 | & runIdentityT 23 | & runIdentityT 24 | & (`execState` s) 25 | 26 | bigStack10 :: Int -> Int 27 | bigStack10 s = 28 | program 29 | & (`runReaderT` n) 30 | & runIdentityT 31 | & runIdentityT 32 | & runIdentityT 33 | & runIdentityT 34 | & runIdentityT 35 | & runIdentityT 36 | & runIdentityT 37 | & runIdentityT 38 | & runIdentityT 39 | & runIdentityT 40 | & (`execState` s) 41 | 42 | bigStack20 :: Int -> Int 43 | bigStack20 s = 44 | program 45 | & (`runReaderT` n) 46 | & runIdentityT 47 | & runIdentityT 48 | & runIdentityT 49 | & runIdentityT 50 | & runIdentityT 51 | & runIdentityT 52 | & runIdentityT 53 | & runIdentityT 54 | & runIdentityT 55 | & runIdentityT 56 | & runIdentityT 57 | & runIdentityT 58 | & runIdentityT 59 | & runIdentityT 60 | & runIdentityT 61 | & runIdentityT 62 | & runIdentityT 63 | & runIdentityT 64 | & runIdentityT 65 | & runIdentityT 66 | & (`execState` s) 67 | n :: Int 68 | n = 1000 69 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/FusedEffects/File.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds, FlexibleContexts, GADTs, TypeOperators, 2 | KindSignatures, FlexibleInstances, MultiParamTypeClasses, 3 | UndecidableInstances, DeriveFunctor, GeneralizedNewtypeDeriving #-} 4 | 5 | module EffectZoo.Scenario.FileSizes.FusedEffects.File where 6 | 7 | import Control.Effect 8 | import Control.Effect.Carrier 9 | import Control.Effect.Sum 10 | import Control.Monad.IO.Class 11 | import Control.Monad.Trans.Reader 12 | import Data.Coerce 13 | import qualified EffectZoo.Scenario.FileSizes.Shared 14 | as Shared 15 | 16 | data File (m :: * -> *) k = 17 | TryFileSize FilePath 18 | (Maybe Int -> k) 19 | deriving (Functor) 20 | 21 | instance Effect File where 22 | handle state handler (TryFileSize p k) = 23 | TryFileSize p (handler . (<$ state) . k) 24 | 25 | instance HFunctor File where 26 | hmap _ = coerce 27 | 28 | tryFileSize :: (Member File sig, Carrier sig m) => FilePath -> m (Maybe Int) 29 | tryFileSize path = send (TryFileSize path ret) 30 | 31 | newtype FileIOC m a = FileIOC 32 | { runFileIOC :: m a 33 | } deriving (Functor, Applicative, Monad, MonadIO) 34 | 35 | instance (Carrier sig m, MonadIO m) => Carrier (File :+: sig) (FileIOC m) where 36 | ret = FileIOC . ret 37 | eff = 38 | FileIOC . 39 | handleSum 40 | (eff . handleCoercible) 41 | (\t -> 42 | case t of 43 | TryFileSize path k -> do 44 | msize <- liftIO (Shared.tryGetFileSize path) 45 | runFileIOC (k msize)) 46 | 47 | runFileIOC2 48 | :: (MonadIO m, Carrier sig m, Effect sig) => Eff (FileIOC m) a -> m a 49 | runFileIOC2 = runFileIOC . interpret 50 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/FreerSimple/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.BigStack.FreerSimple.Main where 2 | 3 | import Control.Monad.Freer 4 | import Control.Monad.Freer.Reader 5 | import Control.Monad.Freer.State 6 | import Data.Function 7 | import EffectZoo.Scenario.BigStack.FreerSimple.Identity 8 | import EffectZoo.Scenario.BigStack.FreerSimple.Program 9 | 10 | bigStack0 :: Int -> Int 11 | bigStack0 s = program & runReader n & execState s & run 12 | 13 | bigStack1 :: Int -> Int 14 | bigStack1 s = program & runReader n & runIdentity & execState s & run 15 | 16 | bigStack5 :: Int -> Int 17 | bigStack5 s = 18 | program 19 | & runReader n 20 | & runIdentity 21 | & runIdentity 22 | & runIdentity 23 | & runIdentity 24 | & runIdentity 25 | & execState s 26 | & run 27 | 28 | bigStack10 :: Int -> Int 29 | bigStack10 s = 30 | program 31 | & runReader n 32 | & runIdentity 33 | & runIdentity 34 | & runIdentity 35 | & runIdentity 36 | & runIdentity 37 | & runIdentity 38 | & runIdentity 39 | & runIdentity 40 | & runIdentity 41 | & runIdentity 42 | & execState s 43 | & run 44 | 45 | bigStack20 :: Int -> Int 46 | bigStack20 s = 47 | program 48 | & runReader n 49 | & runIdentity 50 | & runIdentity 51 | & runIdentity 52 | & runIdentity 53 | & runIdentity 54 | & runIdentity 55 | & runIdentity 56 | & runIdentity 57 | & runIdentity 58 | & runIdentity 59 | & runIdentity 60 | & runIdentity 61 | & runIdentity 62 | & runIdentity 63 | & runIdentity 64 | & runIdentity 65 | & runIdentity 66 | & runIdentity 67 | & runIdentity 68 | & runIdentity 69 | & execState s 70 | & run 71 | 72 | n :: Int 73 | n = 1000 74 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/FusedEffects/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module EffectZoo.Scenario.BigStack.FusedEffects.Main where 4 | 5 | import Control.Effect 6 | import Control.Effect.Reader 7 | import Control.Effect.State 8 | import Control.Monad 9 | import Data.Function 10 | import EffectZoo.Scenario.BigStack.FusedEffects.Identity 11 | import EffectZoo.Scenario.BigStack.FusedEffects.Program 12 | 13 | bigStack0 :: Int -> Int 14 | bigStack0 s = program & runReader n & execState s & run 15 | 16 | bigStack1 :: Int -> Int 17 | bigStack1 s = program & runReader n & runIdentity & execState s & run 18 | 19 | bigStack5 :: Int -> Int 20 | bigStack5 s = 21 | program 22 | & runReader n 23 | & runIdentity 24 | & runIdentity 25 | & runIdentity 26 | & runIdentity 27 | & runIdentity 28 | & execState s 29 | & run 30 | 31 | bigStack10 :: Int -> Int 32 | bigStack10 s = 33 | program 34 | & runReader n 35 | & runIdentity 36 | & runIdentity 37 | & runIdentity 38 | & runIdentity 39 | & runIdentity 40 | & runIdentity 41 | & runIdentity 42 | & runIdentity 43 | & runIdentity 44 | & runIdentity 45 | & execState s 46 | & run 47 | 48 | bigStack20 :: Int -> Int 49 | bigStack20 s = 50 | program 51 | & runReader n 52 | & runIdentity 53 | & runIdentity 54 | & runIdentity 55 | & runIdentity 56 | & runIdentity 57 | & runIdentity 58 | & runIdentity 59 | & runIdentity 60 | & runIdentity 61 | & runIdentity 62 | & runIdentity 63 | & runIdentity 64 | & runIdentity 65 | & runIdentity 66 | & runIdentity 67 | & runIdentity 68 | & runIdentity 69 | & runIdentity 70 | & runIdentity 71 | & runIdentity 72 | & execState s 73 | & run 74 | 75 | n :: Int 76 | n = 1000 77 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.BigStack where 2 | 3 | import Criterion 4 | import qualified EffectZoo.Scenario.BigStack.FreerSimple.Main 5 | as FreerSimple 6 | import qualified EffectZoo.Scenario.BigStack.FusedEffects.Main 7 | as FusedEffects 8 | import qualified EffectZoo.Scenario.BigStack.MTL.Main 9 | as MTL 10 | import qualified EffectZoo.Scenario.BigStack.SimpleEffects.Main 11 | as SimpleEffects 12 | 13 | benchmarks :: [(String, String, Benchmarkable)] 14 | benchmarks = do 15 | (implementation, bigStacks) <- 16 | [ ( "freer-simple" 17 | , [ (0 , FreerSimple.bigStack0) 18 | , (1 , FreerSimple.bigStack1) 19 | , (5 , FreerSimple.bigStack5) 20 | , (10, FreerSimple.bigStack10) 21 | , (20, FreerSimple.bigStack20) 22 | ] 23 | ) 24 | , ( "fused-effects" 25 | , [ (0 , FusedEffects.bigStack0) 26 | , (1 , FusedEffects.bigStack1) 27 | , (5 , FusedEffects.bigStack5) 28 | , (10, FusedEffects.bigStack10) 29 | , (20, FusedEffects.bigStack20) 30 | ] 31 | ) 32 | , ( "mtl" 33 | , [ (0 , MTL.bigStack0) 34 | , (1 , MTL.bigStack1) 35 | , (5 , MTL.bigStack5) 36 | , (10, MTL.bigStack10) 37 | , (20, MTL.bigStack20) 38 | ] 39 | ) 40 | , ( "simple-effects" 41 | , [ (0 , SimpleEffects.bigStack0) 42 | , (1 , SimpleEffects.bigStack1) 43 | , (5 , SimpleEffects.bigStack5) 44 | , (10, SimpleEffects.bigStack10) 45 | , (20, SimpleEffects.bigStack20) 46 | ] 47 | ) 48 | ] 49 | 50 | (stackSize, go) <- bigStacks 51 | 52 | return (implementation, show stackSize ++ " layers", whnf go 0) 53 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/FileSizes/FusedEffects/Logging.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds, FlexibleContexts, GADTs, TypeOperators, 2 | KindSignatures, FlexibleInstances, MultiParamTypeClasses, 3 | UndecidableInstances, DeriveFunctor, GeneralizedNewtypeDeriving #-} 4 | 5 | module EffectZoo.Scenario.FileSizes.FusedEffects.Logging where 6 | 7 | import Control.Effect 8 | import Control.Effect.Carrier 9 | import Control.Effect.Sum 10 | import Control.Monad.IO.Class 11 | import Control.Monad.Trans.Reader 12 | import Data.Coerce 13 | import Data.IORef 14 | import qualified EffectZoo.Scenario.FileSizes.Shared 15 | as Shared 16 | 17 | data Logging (m :: * -> *) k = 18 | LogMsg String 19 | k 20 | deriving (Functor) 21 | 22 | instance HFunctor Logging where 23 | hmap _ = coerce 24 | 25 | instance Effect Logging where 26 | handle state handler (LogMsg m k) = LogMsg m (handler (k <$ state)) 27 | 28 | logMsg :: (Member Logging sig, Carrier sig m) => String -> m () 29 | logMsg msg = send (LogMsg msg (ret ())) 30 | 31 | newtype LogIOC m a = LogIOC 32 | { unLogIOC :: ReaderT (IORef [String]) m a 33 | } deriving (Functor, Applicative, Monad, MonadIO) 34 | 35 | runLogIOC :: IORef [String] -> LogIOC m a -> m a 36 | runLogIOC r (LogIOC (ReaderT m)) = m r 37 | 38 | instance (Carrier sig m, MonadIO m) => 39 | Carrier (Logging :+: sig) (LogIOC m) where 40 | ret m = LogIOC (ReaderT (\_ -> ret m)) 41 | eff x = 42 | LogIOC $ 43 | ReaderT $ \r -> 44 | handleSum 45 | (eff . handleReader r (\m r' -> runLogIOC r' m)) 46 | (\t -> 47 | case t of 48 | LogMsg msg k -> do 49 | liftIO (Shared.logToIORef r msg) 50 | runLogIOC r k) 51 | x 52 | 53 | runLogIOC2 54 | :: (MonadIO m, Carrier sig m, Effect sig) 55 | => IORef [String] 56 | -> Eff (LogIOC m) a 57 | -> m a 58 | runLogIOC2 r = runLogIOC r . interpret 59 | -------------------------------------------------------------------------------- /src/EffectZoo/Scenario/BigStack/SimpleEffects/Main.hs: -------------------------------------------------------------------------------- 1 | module EffectZoo.Scenario.BigStack.SimpleEffects.Main where 2 | 3 | import Control.Effects 4 | import Control.Effects.Reader 5 | import Control.Effects.State 6 | import Control.Monad.Trans.Identity 7 | import Data.Function 8 | import EffectZoo.Scenario.BigStack.SimpleEffects.Identity 9 | import EffectZoo.Scenario.BigStack.SimpleEffects.Program 10 | import qualified Data.Functor.Identity 11 | 12 | bigStack0 :: Int -> Int 13 | bigStack0 s = 14 | (program >> getState) 15 | & implementReadEnv (return n) 16 | & implementStateViaStateT s 17 | & Data.Functor.Identity.runIdentity 18 | 19 | bigStack1 :: Int -> Int 20 | bigStack1 s = 21 | (program >> getState) 22 | & implementReadEnv (return n) 23 | & runIdentity 24 | & implementStateViaStateT s 25 | & Data.Functor.Identity.runIdentity 26 | 27 | bigStack5 :: Int -> Int 28 | bigStack5 s = 29 | (program >> getState) 30 | & implementReadEnv (return n) 31 | & runIdentity 32 | & runIdentity 33 | & runIdentity 34 | & runIdentity 35 | & runIdentity 36 | & implementStateViaStateT s 37 | & Data.Functor.Identity.runIdentity 38 | 39 | bigStack10 :: Int -> Int 40 | bigStack10 s = 41 | (program >> getState) 42 | & implementReadEnv (return n) 43 | & runIdentity 44 | & runIdentity 45 | & runIdentity 46 | & runIdentity 47 | & runIdentity 48 | & runIdentity 49 | & runIdentity 50 | & runIdentity 51 | & runIdentity 52 | & runIdentity 53 | & implementStateViaStateT s 54 | & Data.Functor.Identity.runIdentity 55 | 56 | bigStack20 :: Int -> Int 57 | bigStack20 s = 58 | (program >> getState) 59 | & implementReadEnv (return n) 60 | & runIdentity 61 | & runIdentity 62 | & runIdentity 63 | & runIdentity 64 | & runIdentity 65 | & runIdentity 66 | & runIdentity 67 | & runIdentity 68 | & runIdentity 69 | & runIdentity 70 | & runIdentity 71 | & runIdentity 72 | & runIdentity 73 | & runIdentity 74 | & runIdentity 75 | & runIdentity 76 | & runIdentity 77 | & runIdentity 78 | & runIdentity 79 | & runIdentity 80 | & implementStateViaStateT s 81 | & Data.Functor.Identity.runIdentity 82 | 83 | n :: Int 84 | n = 1000 85 | -------------------------------------------------------------------------------- /plot.r: -------------------------------------------------------------------------------- 1 | library('ggplot2') 2 | options(scipen = 20) 3 | 4 | plotByScenario <- function(data) 5 | { 6 | ggplot(data, 7 | aes(x = Scenario, y = Mean, fill = Implementation), 8 | environment = environment()) + 9 | geom_bar(stat = "identity", 10 | colour = "black", 11 | position = position_dodge()) + 12 | geom_errorbar(aes(ymin = MeanL, ymax = MeanU), 13 | position = position_dodge(0.9), 14 | width = 0.2) + 15 | facet_wrap( ~ Scenario, scales = "free") + 16 | labs(y = "Execution time (s)") + theme_linedraw() + 17 | theme( 18 | panel.grid.major.x = element_blank(), 19 | axis.text.x = element_blank(), 20 | axis.ticks.x = element_blank() 21 | ) 22 | } 23 | 24 | plotByImplementation <- function(data) 25 | { 26 | ggplot(data, aes(x = Implementation, y = Mean, fill = Scenario)) + 27 | geom_bar(stat = "identity", 28 | colour = "black", 29 | position = position_dodge()) + 30 | geom_errorbar(aes(ymin = MeanL, ymax = MeanU), 31 | position = position_dodge(0.9), 32 | width = 0.2) + 33 | theme_linedraw() + 34 | facet_wrap(~ Implementation, scales = "free") + 35 | theme( 36 | panel.grid.major.x = element_blank(), 37 | axis.text.x = element_blank(), 38 | axis.ticks.x = element_blank() 39 | ) + 40 | labs(y = "Execution time (s)") 41 | } 42 | 43 | loadData <- function(file) 44 | { 45 | data <- 46 | read.csv( 47 | file, 48 | header = FALSE, 49 | col.names = c("Implementation", "Scenario", "Mean", "MeanL", "MeanU") 50 | ) 51 | data$Scenario <- as.character(data$Scenario) 52 | data$Scenario <- 53 | factor(data$Scenario, level = unique(data$Scenario)) 54 | data 55 | } 56 | 57 | 58 | BigStack <- loadData('big-stack.csv') 59 | plotByScenario(BigStack) + labs(title = "BigStack (by scenario)") 60 | plotByImplementation(BigStack) + labs(title = "BigStack (by implementation)") 61 | 62 | Countdown <- loadData('countdown.csv') 63 | plotByScenario(Countdown) + labs(title = "Countdown (by n)", x = "n") 64 | plotByImplementation(Countdown) + labs(title = "Countdown (by implementation)") 65 | 66 | FileSizes <- loadData('file-sizes.csv') 67 | plotByScenario(FileSizes) + labs(title = "FileSizes (by scenario)") 68 | plotByImplementation(FileSizes) + labs(title = "FileSizes (by implementation)") 69 | 70 | Reinterpretation <- loadData('reinterpretation.csv') 71 | plotByScenario(Reinterpretation) + labs(title = "Reinterpretation (by scenario)") 72 | plotByImplementation(Reinterpretation) + labs(title = "Reinterpretation (by implementation)") 73 | -------------------------------------------------------------------------------- /effect-zoo.cabal: -------------------------------------------------------------------------------- 1 | name: effect-zoo 2 | version: 0.1.0.0 3 | license: BSD3 4 | license-file: LICENSE 5 | author: Oliver Charles 6 | maintainer: ollie@ocharles.org.uk 7 | build-type: Simple 8 | cabal-version: >=1.10 9 | 10 | executable effect-zoo 11 | main-is: Main.hs 12 | build-depends: base >=4.11 && <4.12, 13 | criterion >=1.5 && <1.6, 14 | simple-effects >=0.13 && <0.14, 15 | freer-simple >=1.1 && <1.2, 16 | transformers >=0.5 && <0.6, 17 | mtl >=2.2 && <2.3, 18 | fused-effects >=0.1.2.1 && < 0.2, 19 | unix, 20 | cassava, 21 | bytestring, 22 | statistics 23 | hs-source-dirs: src 24 | other-modules: 25 | EffectZoo.Scenario.BigStack 26 | EffectZoo.Scenario.BigStack.FreerSimple.Identity 27 | EffectZoo.Scenario.BigStack.FreerSimple.Main 28 | EffectZoo.Scenario.BigStack.FreerSimple.Program 29 | EffectZoo.Scenario.BigStack.FusedEffects.Identity 30 | EffectZoo.Scenario.BigStack.FusedEffects.Main 31 | EffectZoo.Scenario.BigStack.FusedEffects.Program 32 | EffectZoo.Scenario.BigStack.MTL.Identity 33 | EffectZoo.Scenario.BigStack.MTL.Main 34 | EffectZoo.Scenario.BigStack.MTL.Program 35 | EffectZoo.Scenario.BigStack.SimpleEffects.Identity 36 | EffectZoo.Scenario.BigStack.SimpleEffects.Main 37 | EffectZoo.Scenario.BigStack.SimpleEffects.Program 38 | EffectZoo.Scenario.CountDown 39 | EffectZoo.Scenario.CountDown.FreerSimple.Main 40 | EffectZoo.Scenario.CountDown.FreerSimple.Program 41 | EffectZoo.Scenario.CountDown.FusedEffects.Main 42 | EffectZoo.Scenario.CountDown.FusedEffects.Program 43 | EffectZoo.Scenario.CountDown.MTL.LazyStateT 44 | EffectZoo.Scenario.CountDown.MTL.Program 45 | EffectZoo.Scenario.CountDown.MTL.StrictStateT 46 | EffectZoo.Scenario.CountDown.Reference 47 | EffectZoo.Scenario.CountDown.SimpleEffects.Main 48 | EffectZoo.Scenario.CountDown.SimpleEffects.Program 49 | EffectZoo.Scenario.FileSizes 50 | EffectZoo.Scenario.FileSizes.FreerSimple.File 51 | EffectZoo.Scenario.FileSizes.FreerSimple.Logging 52 | EffectZoo.Scenario.FileSizes.FreerSimple.Main 53 | EffectZoo.Scenario.FileSizes.FreerSimple.Program 54 | EffectZoo.Scenario.FileSizes.FusedEffects.File 55 | EffectZoo.Scenario.FileSizes.FusedEffects.Logging 56 | EffectZoo.Scenario.FileSizes.FusedEffects.Main 57 | EffectZoo.Scenario.FileSizes.FusedEffects.Program 58 | EffectZoo.Scenario.FileSizes.MTL.File 59 | EffectZoo.Scenario.FileSizes.MTL.Logging 60 | EffectZoo.Scenario.FileSizes.MTL.Main 61 | EffectZoo.Scenario.FileSizes.MTL.Program 62 | EffectZoo.Scenario.FileSizes.Reference 63 | EffectZoo.Scenario.FileSizes.Shared 64 | EffectZoo.Scenario.FileSizes.SimpleEffects.File 65 | EffectZoo.Scenario.FileSizes.SimpleEffects.Logging 66 | EffectZoo.Scenario.FileSizes.SimpleEffects.Main 67 | EffectZoo.Scenario.FileSizes.SimpleEffects.Program 68 | EffectZoo.Scenario.Reinterpretation 69 | EffectZoo.Scenario.Reinterpretation.FreerSimple.HTTP 70 | EffectZoo.Scenario.Reinterpretation.FreerSimple.Logging 71 | EffectZoo.Scenario.Reinterpretation.FreerSimple.Main 72 | EffectZoo.Scenario.Reinterpretation.FreerSimple.Zooit 73 | EffectZoo.Scenario.Reinterpretation.FusedEffects.HTTP 74 | EffectZoo.Scenario.Reinterpretation.FusedEffects.Logging 75 | EffectZoo.Scenario.Reinterpretation.FusedEffects.Main 76 | EffectZoo.Scenario.Reinterpretation.FusedEffects.Zooit 77 | EffectZoo.Scenario.Reinterpretation.SimpleEffects.HTTP 78 | EffectZoo.Scenario.Reinterpretation.SimpleEffects.Logging 79 | EffectZoo.Scenario.Reinterpretation.SimpleEffects.Main 80 | EffectZoo.Scenario.Reinterpretation.SimpleEffects.Zooit 81 | EffectZoo.Scenario.Reinterpretation.Shared 82 | default-language: Haskell2010 83 | ghc-options: -O2 84 | --------------------------------------------------------------------------------