rehno-lindeque · June 23, 2018 23:08 · Jun 23, 2018 · Jun 23, 2018 · Jun 23, 2018 · Jun 23, 2018
diff --git a/mask-freet.hs b/mask-freet.hs
@@ -44,17 +44,24 @@ 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)
-    )
-    _
+
+-- 1. A general implementation is impossible (cannot fill the holes, there's no interpreter available)
+--
+-- instance (Functor f, MonadThrow m) => MonadMask (FreeT f m) where
+--   generalBracket acquire release use = generalBracket (_ acquire) (_ release) (_ use)
+
+-- 2. This is a bad idea because it forces us to pick a specific interpreter:
+--
+-- 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)
+--     )
+--     _
+
+-- 3. Wrap a newtype for this particular (interactive IO) interpretation of the script?
+newtype InteractiveScript result = InteractiveScript _
 
diff --git a/mask-freet.hs b/mask-freet.hs
@@ -23,6 +23,8 @@
 -- * rolling back state (StateT)
 -- * continuation passing...
 --
+-- One reason why MonadMask would be helpful is for interactions with other threads via e.g. withMVar.
+--
 -- Lets find out what all this means for FreeT. Hence experimentation:
 
 import Control.Monad.Trans.Free
@@ -31,7 +33,7 @@ import Control.Monad.Catch
 import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
 
 data Interaction cont
-  = Misc
+  = Print
   | Fail
   | Done
   deriving Functor

diff --git a/mask-freet.hs b/mask-freet.hs
@@ -5,6 +5,26 @@
 
 {-# language DeriveFunctor, FlexibleInstances #-}
 
+-- | Historical background reading for this experiment (in historical order):
+--
+-- * https://stackoverflow.com/questions/41966893/why-is-there-no-monadmask-instance-for-exceptt
+-- * https://www.fpcomplete.com/blog/2017/02/monadmask-vs-monadbracket
+-- * http://hackage.haskell.org/package/exceptions-0.10.0/docs/Control-Monad-Catch.html#t:MonadMask
+--
+-- Additional reading related to FreeT:
+--
+-- * https://stackoverflow.com/questions/17511841/monadtranscontrol-instance-for-proxyfast-proxycorrect/17515535#17515535
+-- * https://stackoverflow.com/a/17515535/167485
+-- * https://github.com/ekmett/free/pull/88/files#diff-32a6f4e068c0071020e712c18bb358be
+--
+-- It's a little tough wrapping your head around
+--
+-- * multiple exit points (ExcepT)
+-- * rolling back state (StateT)
+-- * continuation passing...
+--
+-- Lets find out what all this means for FreeT. Hence experimentation:
+
 import Control.Monad.Trans.Free
 import Control.Monad.Trans.State
 import Control.Monad.Catch

diff --git a/mask-freet.hs b/mask-freet.hs
@@ -1 +1,38 @@
-# Experiment
+#! /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)
+    )
+    _
+
diff --git a/mask-freet.hs b/mask-freet.hs
@@ -0,0 +1 @@
+# Experiment
No results found