concurrency_and_lazy_io.hs

#!/usr/bin/env stack
-- stack exec ghc --resolver lts-16.2 --package time --package async --package text --package deepseq -- -prof -fprof-auto -threaded -O2 -rtsopts -with-rtsopts=-N -eventlog

{-
See if we can reproduce having to repeatedly generate environments
-}

{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RecordWildCards    #-}

module Main where

import           Control.Concurrent       (threadDelay)
import           Control.Concurrent.Async (async, forConcurrently_)
import           Control.Monad            (void)
import           Data.Char                (ord)
import           Data.Time.Clock          (getCurrentTime)
import           System.IO                (Handle, hReady, stdin)

-- An environment containing actions, it should be expensive to create
data Env m = Env
    { key1 :: !(Log m)
    , key2 :: !(Log m)
    , key3 :: !(Log m)
    , key4 :: !(Log m)
    , key5 :: !(Log m)
    , key6 :: !(Log m)
    , key7 :: !(Log m)
    , key8 :: !(Log m)
    , key9 :: !(Log m)
    }

-- Hypothesis: functions cannot be evaluated strictly
data Log m = Log { runLogger :: String -> m () }


mkEnv :: IO (Env IO)
mkEnv = do
    time <- getCurrentTime
    print time
    return $ Env
        { key1 = Log { runLogger = putStrLn }
        , key2 = Log { runLogger = putStrLn }
        , key3 = Log { runLogger = putStrLn }
        , key4 = Log { runLogger = putStrLn }
        , key5 = Log { runLogger = putStrLn }
        , key6 = Log { runLogger = putStrLn }
        , key7 = Log { runLogger = putStrLn }
        , key8 = Log { runLogger = putStrLn }
        , key9 = Log { runLogger = putStrLn }
        }

-- -- Test if lazy eval works against us in async context
-- main :: IO ()
-- main = do
--     env <- mkEnv
--     forConcurrently_ [1..10000] $ do
--         \_ -> async $ do
--             let Env{..} = env
--             runLogger key1 $ "0"
--             runLogger key2 $ "0"
--             runLogger key3 $ "0"
--             runLogger key4 $ "0"
--             runLogger key5 $ "0"
--             runLogger key6 $ "0"
--             runLogger key7 $ "0"
--             runLogger key8 $ "0"
--             runLogger key9 $ "0"
--     -- Allow async actions to finish
--     threadDelay 3000_000

-- Test if we can make env strict
main :: IO ()
main = do
    !env <- mkEnv
    forConcurrently_ [1..10000] $ do
        \_ -> async $ do
            let Env{..} = env
            runLogger key1 $ "0"
            runLogger key2 $ "0"
            runLogger key3 $ "0"
            runLogger key4 $ "0"
            runLogger key5 $ "0"
            runLogger key6 $ "0"
            runLogger key7 $ "0"
            runLogger key8 $ "0"
            runLogger key9 $ "0"
    -- Allow async actions to finish
    threadDelay 3000_000

Making env strict also fails, mkEnv still branches out.

Experiments with strictness

[nix-shell:~/projects/haskell-experiments]$ ghci
GHCi, version 8.8.4: https://www.haskell.org/ghc/  :? for help
Prelude> data A = A String
Prelude> a = A "hello"
Prelude> :sprint
Prelude> :sprint a
a = <A> _
Prelude> data A = A !String
Prelude> a = A "hello"
Prelude> :sprint a
a = _
Prelude> b = a `seq` a
Prelude> :sprint a
a = _
Prelude> :sprint b
b = _
Prelude> !b = a `seq` a

<interactive>:11:1: error:
    Illegal bang-pattern (use BangPatterns):
    ! b
Prelude> :set -XBangPatterns
Prelude> !b = a `seq` a
Prelude> :sprint b
b = <A> ('h' : _)
Prelude> import Control.DeepSeq
Prelude Control.DeepSeq> :sprint a
a = <A> ('h' : _)
Prelude Control.DeepSeq> c = A "abc"
Prelude Control.DeepSeq> :sprint c
c = _
Prelude Control.DeepSeq> !c = A "abc"
Prelude Control.DeepSeq> :sprint c
c = <A> ('a' : _)
Prelude Control.DeepSeq> !d = force c

<interactive>:21:6: error:
    • No instance for (NFData A) arising from a use of ‘force’
    • In the expression: force c
      In an equation for ‘d’: !d = force c
Prelude Control.DeepSeq> data A = A String deriving Generic; instance NFData A

<interactive>:22:28: error:
    Not in scope: type constructor or class ‘Generic’
Prelude Control.DeepSeq> import GHC.Generics
Prelude Control.DeepSeq GHC.Generics> data A = A String deriving Generic; instance NFData A

<interactive>:24:28: error:
    • Can't make a derived instance of ‘Generic A’:
        You need DeriveGeneric to derive an instance for this class
    • In the data declaration for ‘A’
Prelude Control.DeepSeq GHC.Generics> :set -XDeriveGeneric
Prelude Control.DeepSeq GHC.Generics> data A = A String deriving Generic; instance NFData A
Prelude Control.DeepSeq GHC.Generics> data A = A !String deriving Generic; instance NFData A
Prelude Control.DeepSeq GHC.Generics> :sprint c
c = <A> ('a' : _)
Prelude Control.DeepSeq GHC.Generics> !c = A "hello"
Prelude Control.DeepSeq GHC.Generics> :sprint 
Prelude Control.DeepSeq GHC.Generics> :sprint c
c = <A> ('h' : _)
Prelude Control.DeepSeq GHC.Generics> !d = force c
Prelude Control.DeepSeq GHC.Generics> :sprint d
d = <A> "hello"
Prelude Control.DeepSeq GHC.Generics>