Last active
June 23, 2018 23:08
-
-
Save rehno-lindeque/85f3a61ea16d02386652bca1d7923c5a to your computer and use it in GitHub Desktop.
FreeT MonadMask experimentation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #! /usr/bin/env nix-shell | |
| #! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ text free exceptions_0_10_0 ])" | |
| #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs-channels/archive/nixpkgs-unstable.tar.gz | |
| -- #! nix-shell -i runghc -p haskellPackages.text haskellPackages.free "haskellPackages.callHackage ''exceptions'' ''0.10.0'' {}" | |
| {-# language DeriveFunctor, FlexibleInstances #-} | |
| import Control.Monad.Trans.Free | |
| import Control.Monad.Trans.State | |
| import Control.Monad.Catch | |
| import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) | |
| data Interaction cont | |
| = Misc | |
| | Fail | |
| | Done | |
| deriving Functor | |
| data ScriptError = ScriptError | |
| data ScriptState = State1 | State2 | |
| type ScriptT m result = FreeT Interaction m result | |
| type InteractiveIO = ExceptT ScriptError (StateT ScriptState IO) | |
| type InteractiveScript result = ScriptT InteractiveIO result | |
| -- This may well be a bad idea. | |
| -- Lets find out: | |
| instance MonadMask (FreeT Interaction InteractiveIO) where | |
| generalBracket acquire release use = lift $ generalBracket | |
| (iterT interpret acquire) | |
| (\resource exitCase -> case exitCase of | |
| ExitCaseSuccess b -> iterT interpret (release resource (ExitCaseSuccess b)) | |
| ExitCaseException e -> iterT interpret (release resource (ExitCaseException e)) | |
| ExitCaseAbort -> iterT interpret (release resource ExitCaseAbort) | |
| ) | |
| _ | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment