instances for classes from

indexed-transformers.cabal

@@ -1,6 +1,6 @@
 cabal-version: 2.2
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -57,7 +57,9 @@ library
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
+    , exceptions
     , free
+    , mmorph
     , mtl
     , transformers
   default-language: Haskell2010

package.yaml

@@ -16,7 +16,9 @@ description: Please see the README on GitHub at <https://github.com/morphismtech
 
 dependencies:
 - base >= 4.7 && < 5
+- exceptions
 - free
+- mmorph
 - mtl
 - transformers
 

src/Control/Monad/Trans/Indexed/State.hs

@@ -17,6 +17,7 @@ module Control.Monad.Trans.Indexed.State
   , fromStateT
   ) where
 
+import Control.Monad.Catch
 import Control.Monad.State
 import Control.Monad.Trans.Indexed
 
@@ -36,6 +37,31 @@ instance i ~ j => MonadTrans (StateIx i j) where
   lift m = StateIx $ \i -> (, i) <$> m
 instance (i ~ j, Monad m) => MonadState i (StateIx i j m) where
   state f = StateIx (return . f)
+instance (i ~ j, MonadThrow m)
+  => MonadThrow (StateIx i j m) where
+    throwM = lift . throwM
+instance (i ~ j, MonadCatch m)
+  => MonadCatch (StateIx i j m) where
+    catch (StateIx m) h = StateIx $ \i ->
+      catch (m i) (\e -> runStateIx (h e) i)
+instance (i ~ j, MonadMask m)
+  => MonadMask (StateIx i j m) where
+  mask a = StateIx $ \s -> mask $ \u -> runStateIx (a $ q u) s
+    where q u (StateIx b) = StateIx (u . b)
+  uninterruptibleMask a =
+    StateIx $ \s -> uninterruptibleMask $ \u -> runStateIx (a $ q u) s
+      where q u (StateIx b) = StateIx (u . b)
+  generalBracket acquire release use = StateIx $ \s0 -> do
+    ((b, _s2), (c, s3)) <- generalBracket
+      (runStateIx acquire s0)
+      (\(resource, s1) exitCase -> case exitCase of
+        ExitCaseSuccess (b, s2) -> runStateIx (release resource (ExitCaseSuccess b)) s2
+        -- In the two other cases, the base monad overrides @use@'s state
+        -- changes and the state reverts to @s1@.
+        ExitCaseException e     -> runStateIx (release resource (ExitCaseException e)) s1
+        ExitCaseAbort           -> runStateIx (release resource ExitCaseAbort) s1)
+      (\(resource, s1) -> runStateIx (use resource) s1)
+    return ((b, c), s3)
 
 evalStateIx :: Monad m => StateIx i j m x -> i -> m x
 evalStateIx m i = fst <$> runStateIx m i

src/Control/Monad/Trans/Indexed/Writer.hs

@@ -20,8 +20,11 @@ module Control.Monad.Trans.Indexed.Writer
   ) where
 
 import Prelude hiding (id, (.))
+import Control.Applicative
 import Control.Category
-import Control.Monad.Trans
+import Control.Monad
+import Control.Monad.Catch
+import Control.Monad.Morph
 import Control.Monad.Trans.Indexed
 
 newtype WriterIx w i j m x = WriterIx {runWriterIx :: m (x, w i j)}
@@ -32,20 +35,67 @@ instance Category w => IxMonadTrans (WriterIx w) where
     (WriterIx m, ij) <- mm
     (x, jk) <- m
     return (x, ij >>> jk)
-instance (i ~ j, Applicative m, Category w) => Applicative (WriterIx w i j m) where
-  pure x = WriterIx (pure (x, id))
-  WriterIx mf <*> WriterIx mx =
-    let
-      apply (f, ij) (x, jk) = (f x, ij >>> jk)
-    in
-      WriterIx $ apply <$> mf <*> mx
+instance (i ~ j, Applicative m, Category w)
+  => Applicative (WriterIx w i j m) where
+    pure x = WriterIx (pure (x, id))
+    WriterIx mf <*> WriterIx mx =
+      let
+        apply (f, ij) (x, jk) = (f x, ij >>> jk)
+      in
+        WriterIx $ apply <$> mf <*> mx
+instance (i ~ j, Alternative m, Category w)
+  => Alternative (WriterIx w i j m) where
+    empty = WriterIx empty
+    WriterIx mx <|> WriterIx my = WriterIx (mx <|> my)
 instance (i ~ j, Monad m, Category w) => Monad (WriterIx w i j m) where
   return = pure
   (>>=) = flip bindIx
+instance (i ~ j, MonadPlus m, Category w)
+  => MonadPlus (WriterIx w i j m) where
+  mzero = WriterIx mzero
+  mplus (WriterIx mx) (WriterIx my) = WriterIx (mplus mx my)
 instance (i ~ j, Category w) => MonadTrans (WriterIx w i j) where
   lift m = WriterIx $ do
     x <- m
     return (x, id)
+instance MFunctor (WriterIx w i j) where
+  hoist f (WriterIx m) = WriterIx $ f m
+instance (i ~ j, Category w) => MMonad (WriterIx w i j) where
+  embed f (WriterIx m) = WriterIx $ do
+    ((b,w0),w1) <- runWriterIx $ f m
+    return (b, w0 >>> w1)
+instance (i ~ j, Category w, MonadThrow m)
+  => MonadThrow (WriterIx w i j m) where
+    throwM = lift . throwM
+instance (i ~ j, Category w, MonadCatch m)
+  => MonadCatch (WriterIx w i j m) where
+    catch (WriterIx m) h = WriterIx $ catch m (runWriterIx . h)
+instance (i ~ j, Category w, MonadMask m)
+  => MonadMask (WriterIx w i j m) where
+  mask a = WriterIx $ mask $ \u -> runWriterIx (a $ q u)
+    where q u b = WriterIx $ u (runWriterIx b)
+  uninterruptibleMask a =
+    WriterIx $ uninterruptibleMask $ \u -> runWriterIx (a $ q u)
+      where q u b = WriterIx $ u (runWriterIx b)
+  generalBracket acquire release use = WriterIx $ do
+    ((b, _w12), (c, w123)) <- generalBracket
+      (runWriterIx acquire)
+      (\(resource, w1) exitCase -> case exitCase of
+        ExitCaseSuccess (b, w12) -> do
+          (c, w3) <- runWriterIx (release resource (ExitCaseSuccess b))
+          return (c, w12 >>> w3)
+        -- In the two other cases, the base monad overrides @use@'s state
+        -- changes and the state reverts to @w1@.
+        ExitCaseException e -> do
+          (c, w3) <- runWriterIx (release resource (ExitCaseException e))
+          return (c, w1 >>> w3)
+        ExitCaseAbort -> do
+          (c, w3) <- runWriterIx (release resource ExitCaseAbort)
+          return (c, w1 >>> w3))
+      (\(resource, w1) -> do
+        (a, w2) <- runWriterIx (use resource)
+        return (a, w1 >>> w2))
+    return ((b, c), w123)
 
 evalWriterIx :: Monad m => WriterIx w i j m x -> m x
 evalWriterIx (WriterIx m) = fst <$> m