Wrapping existing interpreter - Polysemy

Welcome to the Functional Programming Zulip Chat Archive. You can join the chat here.

Yuriy Lazarev

Hi All!

Please help me to a higher order effect:

data Fx (m :: Type -> Type) a where
  WithTempDir ::  m x -> Fx m x

runShellIO :: forall r a. Members '[Shell.Fx, Final IO] r => Sem (Fx ': r) a -> Sem r a
runShellIO = interpretH $ \case
  WithTempDir  fx ->
      runShellIO (runT fx) -- <-- this does not compile with a cryptic error message.. what am I doing wrong?
TheMatten

@Yuriy Lazarev What's the signature of runShellIO?

Yuriy Lazarev
runShellIO :: forall r a. Members '[Shell.Fx, Final IO] r => Sem (Fx ': r) a -> Sem r a
Yuriy Lazarev

I basically interpret Fx in terms of other effects: Shell.Fx, Final IO

TheMatten

What should withTempDir do?

TheMatten

Interpreting in terms of other effects usually means using them in body of interpret - but runShellIO just calls itself recursively

Yuriy Lazarev

The idea is that it creates a temp directory, then runs action in that directory, drops directory afterwards. Like a bracket.

Yuriy Lazarev

fx here is an effect that needs to be run inside temp directory

TheMatten

Alright - So Shell.Fx has some actions that depend on that directory?

TheMatten

How does it look like?

Yuriy Lazarev

Shell.Fx runs an external program (using shell command) inside a temp folder and then collects all files that external program has created in the temp dir.

Yuriy Lazarev

so its like a bracket:
init = create temp dir
finalize = drop temp dir
use = run external program via shell command

TheMatten

Okay - it seems like "the effect of interest" here is actually Shell.Fx - withTempDir actually better fits description of an interpreter, because it runs Shell.Fx effect in concrete directory

Yuriy Lazarev

I already have a Shell effect/interpreter that runs any cmd, I was thinking to re-use it

Yuriy Lazarev
module Shell
  ( Fx,
    runLogIO,
    run,
    run_,
    Arguments,
    Command,
  )
where

import qualified Data.Text as Text
import qualified Log
import Polysemy hiding (run)
import System.Process.Typed

type Command = Text

type Arguments = [Text]

data Fx (m :: Type -> Type) a where
  Run :: Command -> Arguments -> Fx m LByteString
  Run_ :: Command -> Arguments -> Fx m ()

runLogIO ::
  forall r a.
  Members '[Log.Fx, Final IO] r =>
  Sem (Fx ': r) a ->
  Sem r a
runLogIO = interpret $ \case
  Run command arguments -> sh readProcessStdout_ command arguments
  Run_ command arguments -> sh runProcess_ command arguments
  where
    sh :: (ProcessConfig () () () -> IO x) -> Text -> [Text] -> Sem r x
    sh f command arguments = do
      let cmd = Text.unwords $ command : arguments
      Log.exec cmd
      embedFinal @IO . f . shell . toString $ cmd

$(makeSem ''Fx)
Yuriy Lazarev

Sure, I can extend shell interpreter, say by adding a "run in temp folder" parameter, but it feels wrong... Instead, it makes sense to interpret shell effect as a higher order effect, surrounded by some other effect (similar to Resource)

TheMatten

@Yuriy Lazarev Okay, maybe something like this?:

runInTempDir :: forall r a. Members '[Log.Fx, Final IO] r => FilePath -> String -> (FilePath -> Sem (Fx : r) a) -> Sem r a
runInTempDir dir template m = resourceToIOFinal $ bracket
  (embedFinal $ createTempDirectory dir template)
  (embedFinal . removeDirectoryRecursive)
  (raise . runLogIO . m)
Yuriy Lazarev

This would work (and most likely I'll end up doing it this way) however, this is a workaround for the higher-order effect problem, not a solution. I wanted to get a working example how to use Tactics stuff to be able to use higher-order effects in other cases too.

Yuriy Lazarev

Anyway, thank for the suggestion!

TheMatten

I'm not sure why it should be considered a workaround - running commands in specific directory is actually sort of interpretation.
You're "pinning" your effect to some specific meaning - if we instead made separate effect that extends this one with support for temporary directories, it's not going to provide any value, because it's just going to duplicate or wrap interface of existing one - that only adds more boilerplate to manage.

Yuriy Lazarev

I want to delay interpretation of withTempDir :: Fx m-> Sem r () to be able to interpret it differently, e.g. not to create temp directory in tests at all

Yuriy Lazarev

This is an example of effect that takes other effect as a parameter. Lets call it sandbox effect for example, then I want to interpret things inside a sandbox effect, where there could be different interpretations (meaning) of what sandbox means.

TheMatten

Tests are still going to be run in some directory, aren't they?

Yuriy Lazarev

in tests there could be no file io at all

Yuriy Lazarev

instead, interpretation of "temp dir" could be just logging

Yuriy Lazarev

I have already a FileSystem effect that abstracts over file/dir operations

Yuriy Lazarev

so it makes sense to abstract over temp directory creation

Yuriy Lazarev
data Fx (m :: Type -> Type) a where
  Copy :: (AbsRel ar, FileDir fd) => Path ar fd -> Path ar fd -> Fx m ()
  MoveFile :: AbsRel ar => FilePath ar -> FilePath ar -> Fx m ()
  TestFile :: AbsRel ar => FilePath ar -> Fx m Bool
  GetCurrentDirectory :: Fx m AbsDir
  SetCurrentDirectory :: AbsRel ar => DirPath ar -> Fx m ()
  MakeDirectory :: AbsRel ar => DirPath ar -> Fx m ()
  MoveDirectory :: AbsRel ar => DirPath ar -> DirPath ar -> Fx m ()
  RemoveDirectoryEmpty :: AbsRel ar => DirPath ar -> Fx m ()
  RemoveDirectoryRecursive :: AbsRel ar => DirPath ar -> Fx m ()
TheMatten

Then runLogIO and runInTempDirwon't be used at all during testing
Hmm, so you are parsing and executing shell commands in some specific way during testing?

Yuriy Lazarev

Depending on the interpreter I could run shell commands insider Docker for example

TheMatten

This effect is pretty different from what you've described above - in this case, I would probably implement createTemporaryDirectory directly in it instead of using IO

Yuriy Lazarev

I apologize for not describing my use-case well enough

Yuriy Lazarev

I have effects for OS processes, File operations, and some business logic, I want File operations effect to wrap around other effects (receiving them as higher-order parameters)

Yuriy Lazarev

where some file operations could be interpreted into shell effects (e.g. calling cp command) others could be interpreted into IO

Yuriy Lazarev

Here is the bigger picture:

data Fx (m :: Type -> Type) a where
  Copy :: (AbsRel ar, FileDir fd) => Path ar fd -> Path ar fd -> Fx m ()
  MoveFile :: AbsRel ar => FilePath ar -> FilePath ar -> Fx m ()
  TestFile :: AbsRel ar => FilePath ar -> Fx m Bool
  GetCurrentDirectory :: Fx m AbsDir
  SetCurrentDirectory :: AbsRel ar => DirPath ar -> Fx m ()
  MakeDirectory :: AbsRel ar => DirPath ar -> Fx m ()
  MoveDirectory :: AbsRel ar => DirPath ar -> DirPath ar -> Fx m ()
  RemoveDirectoryEmpty :: AbsRel ar => DirPath ar -> Fx m ()
  RemoveDirectoryRecursive :: AbsRel ar => DirPath ar -> Fx m ()
  TestDirectory :: AbsRel ar => DirPath ar -> Fx m Bool
  WithTempDir :: AbsDir -> m x -> Fx m x

runShellIO :: forall r a. Members '[Shell.Fx, Final IO] r => Sem (Fx ': r) a -> Sem r a
runShellIO = interpretH $ \case
  Copy src dst ->
    Shell.run_ "mv" [Path.toText src, Path.toText dst]
  MoveFile src dst ->
    embedFinal $ Dir.renameFile src dst
  TestFile file ->
    embedFinal $ Dir.doesFileExist file
  GetCurrentDirectory ->
    embedFinal Dir.getCurrentDirectory
  SetCurrentDirectory dir ->
    embedFinal $ Dir.setCurrentDirectory dir
  MakeDirectory dir ->
    embedFinal $ Dir.createDirectory dir
  MoveDirectory src dst ->
    embedFinal $ Dir.renameDirectory src dst
  RemoveDirectoryEmpty dir ->
    embedFinal $ Dir.removeDirectory dir
  RemoveDirectoryRecursive dir ->
    embedFinal $ Dir.removeDirectoryRecursive dir
  TestDirectory dir ->
    embedFinal $ Dir.doesDirectoryExist dir
  WithTempDir parent fx ->
      _ (runT fx)
    where
      wtd :: IO ()
      wtd = withTempDirectory parentFilePath "hasmer_" $ \dir -> pure ()
      parentFilePath = toString . Path.toText $ parent

$(makeSem ''Fx)
TheMatten

One does usually wrap other effect ~ create "effect transformer", when they want to alter meaning of effect in some way - in what way should file-effect alter meaning of other effects?