Writers.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RecordWildCards #-}

module Main (main) where

import           Control.Monad.Writer
import qualified Control.Monad.Writer.CPS  as CPS
import qualified Control.Monad.Writer.Lazy as Lazy
import           Data.Foldable             (toList)
import           Data.Monoid
import qualified Data.Sequence             as Seq
import           Data.Void                 (Void, absurd)
import           System.Environment        (getEnv)
import           System.Exit

type Warning = ()

data TestCase = forall w t. (MonadWriter w (t (Either Void))) => TestCase{
    warnings    :: [Warning] -> w,
    exec        :: t (Either Void) () -> Either Void w,
    getWarnings :: w -> [Warning]}

testCases :: [(String, TestCase)]
testCases = [
    ("CPS/[]", TestCase
        id
        CPS.execWriterT
        id),
    ("CPS/Seq", TestCase
        Seq.fromList
        CPS.execWriterT
        toList),
    ("Lazy/Endo[]", TestCase
        (Endo . (++))
        Lazy.execWriterT
        (flip appEndo [])),
    ("CPS/Dual[]", TestCase
        Dual
        CPS.execWriterT
        getDual),
    ("CPS/Endo[]", TestCase
        (Endo . (++))
        CPS.execWriterT
        (flip appEndo []))]

run :: TestCase -> IO ()
run TestCase{..} =
    let f n = tell $ warnings $ if n `mod` 10 == 0 then [(), ()] else [()]
    in case exec $ mapM_ f [1 .. 10_000_000 :: Int] of
        Left e  -> absurd e
        Right r -> print $ length $ getWarnings r

main :: IO ()
main = getEnv "TEST" >>= \testName -> case lookup testName testCases of
    Just testCase -> run testCase
    Nothing       -> die $ "TEST must be one of " ++ show (map fst testCases)

WritersMonomorphic.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}

module Main (main) where

import           Control.Monad.Writer
import qualified Control.Monad.Writer.CPS    as CPS
import qualified Control.Monad.Writer.Lazy   as Lazy
import qualified Control.Monad.Writer.Strict as Strict
import           Data.Foldable               (toList)
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Sequence               as Seq
import           Data.Void                   (Void, absurd)

#define STRICT_ENDO_LIST

main :: IO ()
main =
    let f n = tell $ warnings $ if n `mod` 10 == 0 then [(), ()] else [()]
#if defined(CPS_LIST)
        warnings = id
        exec = CPS.execWriterT
        getWarnings = id
#elif defined(CPS_SEQ)
        warnings = Seq.fromList
        exec = CPS.execWriterT
        getWarnings = toList
#elif defined(LAZY_ENDO_LIST)
        warnings = Endo . (++)
        exec = Lazy.execWriterT
        getWarnings = flip appEndo []
#elif defined(CPS_DUAL_LIST)
        warnings = Dual
        exec = CPS.execWriterT
        getWarnings = getDual
#elif defined(CPS_ENDO_LIST)
        warnings = Endo . (++)
        exec = CPS.execWriterT
        getWarnings = (`appEndo` [])
#elif defined(STRICT_ENDO_LIST)
        warnings = Endo . (++)
        exec = Strict.execWriterT
        getWarnings = (`appEndo` [])
#endif
    in case exec $ mapM_ f [1 .. 10_000_000 :: Int] of
        Left e  -> absurd e
        Right r -> print $ length $ getWarnings r