Passing around effectful actions

[eddiemundo]

Sometimes I want to do something like

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Sandbox () where

import Data.Function ((&))
import Effectful (Eff, IOE, Subset, inject, (:>), runEff, MonadIO (liftIO))
import Effectful.Concurrent (Concurrent, runConcurrent)
import Effectful.FileSystem (FileSystem, runFileSystem)
import Prelude hiding (writeFile)
import Effectful.FileSystem.IO.File (writeBinaryFile)
import qualified Data.ByteString.Char8 as Bs8
import Effectful.Concurrent.MVar.Strict (MVar, putMVar, newEmptyMVar, readMVar)

data Env es = Env {getInitialState :: Eff es Int}

main :: IO ()
main = do
  let env :: Env '[IOE] = Env {getInitialState = pure 0}
  startServer env
    & runConcurrent
    & runEff

startServer :: (Concurrent :> es0, IOE :> es0, Subset es1 es0) => Env es1 -> Eff es0 ()
startServer env = do
  stateMVar <- newEmptyMVar
  getInitialStateWriteState env stateMVar & runFileSystem
  -- ^ compile error here
  runServer stateMVar

getInitialStateWriteState :: (FileSystem :> es0, Concurrent :> es0, Subset es1 es0) => Env es1 -> MVar Int -> Eff es0 ()
getInitialStateWriteState Env{getInitialState} stateMVar = do
  state <- getInitialState & inject
  putMVar stateMVar state
  writeBinaryFile "state.txt" (Bs8.pack $ show state)

runServer :: (Concurrent :> es, IOE :> es) => MVar Int -> Eff es ()
runServer stateMVar = do
  state <- readMVar stateMVar
  liftIO $ print state

but I get a compile error

• Couldn't match type ‘es1’ with ‘es0’
    arising from a use of ‘getInitialStateWriteState’
  ‘es1’ is a rigid type variable bound by
    the type signature for:
      startServer :: forall (es0 :: [Effectful.Internal.Effect.Effect])
                            (es1 :: [Effectful.Internal.Effect.Effect]).
                     (Concurrent :> es0, IOE :> es0, Subset es1 es0) =>
                     Env es1 -> Eff es0 ()
    at /home/jon/projects/optim-jbo/src/Sandbox.hs:23:1-87
  ‘es0’ is a rigid type variable bound by
    the type signature for:
      startServer :: forall (es0 :: [Effectful.Internal.Effect.Effect])
                            (es1 :: [Effectful.Internal.Effect.Effect]).
                     (Concurrent :> es0, IOE :> es0, Subset es1 es0) =>
                     Env es1 -> Eff es0 ()
    at /home/jon/projects/optim-jbo/src/Sandbox.hs:23:1-87
• In the first argument of ‘(&)’, namely
    ‘getInitialStateWriteState env stateMVar’
  In a stmt of a 'do' block:
    getInitialStateWriteState env stateMVar & runFileSystem
  In the expression:
    do stateMVar <- newEmptyMVar
       getInitialStateWriteState env stateMVar & runFileSystem
       runServer stateMVar
• Relevant bindings include
    env :: Env es1
      (bound at /home/jon/projects/optim-jbo/src/Sandbox.hs:24:13)
    startServer :: Env es1 -> Eff es0 ()
      (bound at /home/jon/projects/optim-jbo/src/Sandbox.hs:24:1) [-Wdeferred-type-errors]

which probably comes from the fact that instance xs ~ es => IsUnknownSuffixOf xs es.

Is there a way to do this or is this kinda thing just avoid and don't put Eff es as inside anything?

[arybczak]

I'm not sure what you're trying to accomplish 🤔 Can you give a more specific example (preferably with a code I can try to compile)?

[eddiemundo]

Oh right sorry. I've edited the above to a slightly more fleshed out dummy example that compiles. I also use the following extensions:

default-extensions:
  DuplicateRecordFields
  NoFieldSelectors
  DerivingVia
  GADTs 
  OverloadedStrings
  PatternSynonyms
  ViewPatterns
  TemplateHaskell
  TypeFamilies 
  DataKinds 
  LambdaCase 
  DefaultSignatures
  RoleAnnotations
  OverloadedLabels
  DeriveAnyClass

default-language:    GHC2021

[eddiemundo]

The example isn't close to realistic but what it does is sort of what I want. I just want to work with effectful actions that don't have concrete effect lists inside data structures by using Subset and inject but I also want to be able to interpret effects locally. Actually maybe I can come up with a more useful example.

[evanrelf]

You could create an inject equivalent for your Env type, like this:

injectEnv :: Subset xs es => Env xs -> Env es
injectEnv env = Env {getInitialState = inject env.getInitialState}

And then you don't need to use Subset elsewhere. This compiles for me:

#!/usr/bin/env nix-shell
#!nix-shell -i ghcid -p ghcid "ghc.withPackages (p: with p; [ effectful effectful-core ])"

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Sandbox () where

import Data.Function ((&))
import Effectful (Eff, IOE, Subset, inject, (:>), runEff, MonadIO (liftIO))
import Effectful.Concurrent (Concurrent, runConcurrent)
import Effectful.FileSystem (FileSystem, runFileSystem)
import Prelude hiding (writeFile)
import Effectful.FileSystem.IO.File (writeBinaryFile)
import qualified Data.ByteString.Char8 as Bs8
import Effectful.Concurrent.MVar.Strict (MVar, putMVar, newEmptyMVar, readMVar)

data Env es = Env {getInitialState :: Eff es Int}

injectEnv :: Subset xs es => Env xs -> Env es
injectEnv env = Env {getInitialState = inject env.getInitialState}

main :: IO ()
main = do
  let env :: Env '[IOE] = Env {getInitialState = pure 0}
  startServer (injectEnv env)
    & runConcurrent
    & runEff

startServer :: (Concurrent :> es, IOE :> es) => Env es -> Eff es ()
startServer env = do
  stateMVar <- newEmptyMVar
  getInitialStateWriteState (injectEnv env) stateMVar & runFileSystem
  -- ^ compile error here
  runServer stateMVar

getInitialStateWriteState :: (FileSystem :> es, Concurrent :> es) => Env es -> MVar Int -> Eff es ()
getInitialStateWriteState Env{getInitialState} stateMVar = do
  state <- getInitialState
  putMVar stateMVar state
  writeBinaryFile "state.txt" (Bs8.pack $ show state)

runServer :: (Concurrent :> es, IOE :> es) => MVar Int -> Eff es ()
runServer stateMVar = do
  state <- readMVar stateMVar
  liftIO $ print state

[eddiemundo]

🤦 I actually tried that earlier except going in the opposite direction with Subsets on the way up but I think I left off a Subset constraint on a function and thought it didn't work. Your way of injecting once at the top makes more sense and is cleaner, but it is cool that it works both ways. Thank you!