packages feed

indexed-transformers (empty) → 0.1.0.0

raw patch · 13 files changed

+757/−0 lines, 13 filesdep +basedep +freedep +mtlsetup-changed

Dependencies added: base, free, mtl, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,9 @@+# Changelog for indexed-transformers++* 0.0.1+  - indexed monad transformers+  - free indexed monad transformer+  - continuation indexed monad transformer+  - state indexed monad transformer+  - writer indexed monad transformer+  - qualified indexed do notation
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2024, Morphism, LLC+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,14 @@+# indexed-transformers++An [Atkey indexed monad](https://bentnib.org/paramnotions-jfp.pdf)+is a `Functor` [enriched category](https://ncatlab.org/nlab/show/enriched+category).+An indexed monad transformer transforms a `Monad` into an indexed monad.++This library provides+  - a typeclass for indexed monad transformers+  - qualified @do@ notation to use with them+  - and instances for the+    - free indexed monad transformer+    - continuation indexed monad transformer+    - state indexed monad transfomer+    - writer indexed monad transformer
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ indexed-transformers.cabal view
@@ -0,0 +1,63 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name:           indexed-transformers+version:        0.1.0.0+synopsis:       Atkey indexed monad transformers+description:    Please see the README on GitHub at <https://github.com/morphismtech/indexed-transformers#readme>+category:       Control+homepage:       https://github.com/morphismtech/indexed-transformers#readme+bug-reports:    https://github.com/morphismtech/indexed-transformers/issues+author:         Eitan Chatav+maintainer:     eitan@morphism.tech+copyright:      2024 Eitan Chatav+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/morphismtech/indexed-transformers++library+  exposed-modules:+      Control.Monad.Trans.Indexed+      Control.Monad.Trans.Indexed.Cont+      Control.Monad.Trans.Indexed.Do+      Control.Monad.Trans.Indexed.Free+      Control.Monad.Trans.Indexed.Free.Fold+      Control.Monad.Trans.Indexed.Free.Wrap+      Control.Monad.Trans.Indexed.State+      Control.Monad.Trans.Indexed.Writer+  other-modules:+      Paths_indexed_transformers+  autogen-modules:+      Paths_indexed_transformers+  hs-source-dirs:+      src+  default-extensions:+      ConstraintKinds+      DeriveFunctor+      FlexibleInstances+      GADTs+      LambdaCase+      MultiParamTypeClasses+      PolyKinds+      QuantifiedConstraints+      RankNTypes+      StandaloneKindSignatures+      TupleSections+      TypeOperators+  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+    , free+    , mtl+    , transformers+  default-language: Haskell2010
+ src/Control/Monad/Trans/Indexed.hs view
@@ -0,0 +1,127 @@+{- |+Module      :  Control.Monad.Trans.Indexed+Copyright   :  (C) 2024 Eitan Chatav+License     :  BSD 3-Clause License (see the file LICENSE)+Maintainer  :  Eitan Chatav <eitan.chatav@gmail.com>++Indexed monad transformers.+-}++module Control.Monad.Trans.Indexed+  ( IxMonadTrans (..)+  , Indexed (..)+  , (&)+  ) where++import Control.Category (Category (..))+import Control.Monad+import Control.Monad.Trans+import Data.Function ((&))+import Data.Kind+import Prelude hiding (id, (.))++{- |+An [Atkey indexed monad]+(https://bentnib.org/paramnotions-jfp.pdf)+is a `Functor` [enriched category]+(https://ncatlab.org/nlab/show/enriched+category).+An indexed monad transformer transforms a `Monad` into an indexed monad.+It is a monad and monad transformer when its source and target index+are the same, enabling use of standard @do@ notation in that case.+In the general case, qualified @Indexed.do@ notation can be used,+even if the source and target index are different.++>>> :set -XQualifiedDo+>>> import qualified Control.Monad.Trans.Indexed.Do as Indexed+-}+type IxMonadTrans+  :: (k -> k -> (Type -> Type) -> Type -> Type)+  -> Constraint+class+  ( forall i j m. Monad m => Functor (t i j m)+  , forall i j m. (i ~ j, Monad m) => Monad (t i j m)+  , forall i j. i ~ j => MonadTrans (t i j)+  ) => IxMonadTrans t where++  {-# MINIMAL joinIx | bindIx #-}++  {- |+  indexed analog of `<*>`++  prop> (<*>) = apIx+  -}+  apIx+    :: Monad m+    => t i j m (x -> y)+    -> t j k m x+    -> t i k m y+  apIx tf tx = bindIx (<$> tx) tf++  {- |+  indexed analog of `join`++  prop> join = joinIx+  prop> joinIx = bindIx id+  -}+  joinIx+    :: Monad m+    => t i j m (t j k m y)+    -> t i k m y+  joinIx = bindIx id++  {- |+  indexed analog of `=<<`++  prop> (=<<) = bindIx+  prop> bindIx f x = joinIx (f <$> x)+  prop> x & bindIx return = x+  prop> x & bindIx f & bindIx g = x & bindIx (f & andThenIx g)+  -}+  bindIx+    :: Monad m+    => (x -> t j k m y)+    -> t i j m x+    -> t i k m y+  bindIx f t = joinIx (f <$> t)++  {- |+  indexed analog of flipped `>>`++  prop> (>>) = flip thenIx+  prop> return () & thenIx y = y+  -}+  thenIx+    :: Monad m+    => t j k m y+    -> t i j m x+    -> t i k m y+  thenIx ix2 ix1 = ix1 & bindIx (\ _ -> ix2)++  {- |+  indexed analog of `<=<`++  prop> (<=<) = andThenIx+  prop> andThenIx g f x = bindIx g (f x)+  prop> f & andThen return = f+  prop> return & andThen f = f+  prop> f & andThenIx g & andThenIx h = f & andThenIx (g & andThenIx h)+  -}+  andThenIx+    :: Monad m+    => (y -> t j k m z)+    -> (x -> t i j m y)+    -> x -> t i k m z+  andThenIx g f x = bindIx g (f x)++{- |+`Indexed` reshuffles the type parameters of an `IxMonadTrans`,+exposing its `Category` instance.+-}+newtype Indexed t m r i j = Indexed {runIndexed :: t i j m r}+instance+  ( IxMonadTrans t+  , Monad m+  , Monoid r+  ) => Category (Indexed t m r) where+    id = Indexed (pure mempty)+    Indexed g . Indexed f = Indexed $ apIx (fmap (<>) f) g
+ src/Control/Monad/Trans/Indexed/Cont.hs view
@@ -0,0 +1,62 @@+{- |+Module      :  Control.Monad.Trans.Indexed.Cont+Copyright   :  (C) 2024 Eitan Chatav+License     :  BSD 3-Clause License (see the file LICENSE)+Maintainer  :  Eitan Chatav <eitan.chatav@gmail.com>++The continuation indexed monad transformer.+-}++module Control.Monad.Trans.Indexed.Cont+  ( ContIx (..)+  , callCCIx+  , evalContIx+  , mapContIx+  , withContIx+  , resetIx+  , shiftIx+  , toContT+  , fromContT+  ) where++import Control.Monad.Cont+import Control.Monad.Trans+import Control.Monad.Trans.Indexed++newtype ContIx i j m x = ContIx {runContIx :: (x -> m j) -> m i}+  deriving Functor+instance IxMonadTrans ContIx where+  joinIx (ContIx k) = ContIx $ \f -> k $ \(ContIx g) -> g f+instance i ~ j => Applicative (ContIx i j m) where+  pure x = ContIx $ \k -> k x+  ContIx cf <*> ContIx cx = ContIx $ \ k -> cf $ \ f -> cx (k . f)+instance i ~ j => Monad (ContIx i j m) where+  return = pure+  ContIx cx >>= k = ContIx $ \ c -> cx (\ x -> runContIx (k x) c)+instance i ~ j => MonadTrans (ContIx i j) where+  lift = ContIx . (>>=)+instance i ~ j => MonadCont (ContIx i j m) where callCC = callCCIx++evalContIx :: Monad m => ContIx x j m j -> m x+evalContIx c = runContIx c return++mapContIx :: (m i -> m j) -> ContIx i k m x -> ContIx j k m x+mapContIx g (ContIx f) = ContIx $ g . f++withContIx :: ((y -> m k) -> x -> m j) -> ContIx i j m x -> ContIx i k m y+withContIx f (ContIx g) = ContIx $ g . f++callCCIx :: ((x -> ContIx j k m y) -> ContIx i j m x) -> ContIx i j m x+callCCIx f = ContIx $ \k -> runContIx (f (ContIx . const . k)) k++shiftIx :: Monad m => ((x -> m j) -> ContIx i k m k) -> ContIx i j m x+shiftIx f = ContIx (evalContIx . f)++resetIx :: Monad m => ContIx x j m j -> ContIx i i m x+resetIx = lift . evalContIx++toContT :: ContIx i i m x -> ContT i m x+toContT (ContIx f) = ContT f++fromContT :: ContT i m x -> ContIx i i m x+fromContT (ContT f) = ContIx f
+ src/Control/Monad/Trans/Indexed/Do.hs view
@@ -0,0 +1,43 @@+{- |+Module      :  Control.Monad.Trans.Indexed.Do+Copyright   :  (C) 2024 Eitan Chatav+License     :  BSD 3-Clause License (see the file LICENSE)+Maintainer  :  Eitan Chatav <eitan.chatav@gmail.com>++Qualified @Indexed.do@ notation.++>>> :set -XQualifiedDo+>>> import qualified Control.Monad.Trans.Indexed.Do as Indexed+-}++module Control.Monad.Trans.Indexed.Do+  ( (>>=)+  , (>>)+  , return+  , fail+  ) where++import qualified Control.Monad as M+import qualified Control.Monad.Trans as T+import qualified Control.Monad.Trans.Indexed as Ix+import Prelude hiding ((>>=), (>>), fail)++(>>=)+  :: (Ix.IxMonadTrans t, M.Monad m)+  => t i j m x+  -> (x -> t j k m y)+  -> t i k m y+(>>=) = flip Ix.bindIx++(>>)+  :: (Ix.IxMonadTrans t, M.Monad m)+  => t i j m x+  -> t j k m y+  -> t i k m y+(>>) = flip Ix.thenIx++fail+  :: (Ix.IxMonadTrans t, M.MonadFail m, i ~ j)+  => String+  -> t i j m x+fail = T.lift . M.fail
+ src/Control/Monad/Trans/Indexed/Free.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++{- |+Module      :  Control.Monad.Trans.Indexed.Free+Copyright   :  (C) 2024 Eitan Chatav+License     :  BSD 3-Clause License (see the file LICENSE)+Maintainer  :  Eitan Chatav <eitan.chatav@gmail.com>++The free indexed monad transformer.+-}++module Control.Monad.Trans.Indexed.Free+  ( IxMonadTransFree (liftFreeIx, hoistFreeIx, foldFreeIx), coerceFreeIx+  , IxFunctor, IxMap (IxMap), liftFreerIx, hoistFreerIx, foldFreerIx+  ) where++import Control.Monad.Free+import Control.Monad.Trans.Indexed+import Data.Kind++{- |+The free `IxMonadTrans` generated by an `IxFunctor`+is characterized by the `IxMonadTransFree` class+up to the isomorphism `coerceFreeIx`.++`IxMonadTransFree` and `IxMap`, the free `IxMonadTrans` and+the free `IxFunctor`, can be combined as a "freer" `IxMonadTrans`+and used as a DSL generated by primitive commands like this+[Conor McBride example]+(https://stackoverflow.com/questions/28690448/what-is-indexed-monad).++>>> :set -XGADTs -XDataKinds+>>> import Data.Kind+>>> type DVD = String+>>> :{+data DVDCommand+  :: Bool -- ^ drive is full before command+  -> Bool -- ^ drive is full after command+  -> Type -- ^ return type+  -> Type where+  Insert :: DVD -> DVDCommand 'False 'True ()+  Eject :: DVDCommand 'True 'False DVD+:}++>>> :{+insert+  :: (IxMonadTransFree freeIx, Monad m)+  => DVD -> freeIx (IxMap DVDCommand) 'False 'True m ()+insert dvd = liftFreerIx (Insert dvd)+:}++>>> :{+eject+  :: (IxMonadTransFree freeIx, Monad m)+  => freeIx (IxMap DVDCommand) 'True 'False m DVD+eject = liftFreerIx Eject+:}++>>> :set -XQualifiedDo+>>> import qualified Control.Monad.Trans.Indexed.Do as Indexed+>>> :{+swap+  :: (IxMonadTransFree freeIx, Monad m)+  => DVD -> freeIx (IxMap DVDCommand) 'True 'True m DVD+swap dvd = Indexed.do+  dvd' <- eject+  insert dvd+  return dvd'+:}++>>> import Control.Monad.Trans+>>> :{+printDVD :: IxMonadTransFree freeIx => freeIx (IxMap DVDCommand) 'True 'True IO ()+printDVD = Indexed.do+  dvd <- eject+  insert dvd+  lift $ putStrLn dvd+:}++-}+class+  ( forall f. IxFunctor f => IxMonadTrans (freeIx f)+  , forall f m i j. (IxFunctor f, Monad m, i ~ j)+    => MonadFree (f i j) (freeIx f i j m)+  ) => IxMonadTransFree freeIx where+  liftFreeIx+    :: (IxFunctor f, Monad m)+    => f i j x+    -> freeIx f i j m x+  hoistFreeIx+    :: (IxFunctor f, IxFunctor g, Monad m)+    => (forall i j x. f i j x -> g i j x)+    -> freeIx f i j m x -> freeIx g i j m x+  foldFreeIx+    :: (IxFunctor f, IxMonadTrans t, Monad m)+    => (forall i j x. f i j x -> t i j m x)+    -> freeIx f i j m x -> t i j m x++{- |+prop> coerceFreeIx = foldFreeIx liftFreeIx+prop> id = coerceFreeIx . coerceFreeIx+-}+coerceFreeIx+  :: (IxMonadTransFree freeIx0, IxMonadTransFree freeIx1, IxFunctor f, Monad m)+  => freeIx0 f i j m x -> freeIx1 f i j m x +coerceFreeIx = foldFreeIx liftFreeIx++type IxFunctor+  :: (k -> k -> Type -> Type)+  -> Constraint+type IxFunctor f = forall i j. Functor (f i j)++{- |+`IxMap` is the free `IxFunctor`. It's a left Kan extension.+Combining `IxMonadTransFree` with `IxMap` as demonstrated in the above example,+gives the "freer" `IxMonadTrans`, modeled on this+[Oleg Kiselyov explanation]+(https://okmij.org/ftp/Computation/free-monad.html#freer).+-}+data IxMap f i j x where+  IxMap :: (x -> y) -> f i j x -> IxMap f i j y+instance Functor (IxMap f i j) where+  fmap g (IxMap f x) = IxMap (g . f) x++liftFreerIx+  :: (IxMonadTransFree freeIx, Monad m)+  => f i j x -> freeIx (IxMap f) i j m x+liftFreerIx x = liftFreeIx (IxMap id x)++hoistFreerIx+  :: (IxMonadTransFree freeIx, Monad m)+  => (forall i j x. f i j x -> g i j x)+  -> freeIx (IxMap f) i j m x -> freeIx (IxMap g) i j m x+hoistFreerIx f = hoistFreeIx (\(IxMap g x) -> IxMap g (f x))++foldFreerIx+  :: (IxMonadTransFree freeIx, IxMonadTrans t, Monad m)+  => (forall i j x. f i j x -> t i j m x)+  -> freeIx (IxMap f) i j m x -> t i j m x+foldFreerIx f x = foldFreeIx (\(IxMap g y) -> g <$> f y) x
+ src/Control/Monad/Trans/Indexed/Free/Fold.hs view
@@ -0,0 +1,55 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++{- |+Module      :  Control.Monad.Trans.Indexed.Free.Fold+Copyright   :  (C) 2024 Eitan Chatav+License     :  BSD 3-Clause License (see the file LICENSE)+Maintainer  :  Eitan Chatav <eitan.chatav@gmail.com>++An instance of the free indexed monad transformer encoded as `foldFreeIx`.+-}++module Control.Monad.Trans.Indexed.Free.Fold+  ( FreeIx (..)+  ) where++import Control.Monad+import Control.Monad.Free+import Control.Monad.Trans+import Control.Monad.Trans.Indexed+import Control.Monad.Trans.Indexed.Free++{- |+`FreeIx` is the free indexed monad transformer encoded as its `foldFreeIx`.++prop> foldFreeIx f freeIx = runFreeIx freeIx f+-}+newtype FreeIx g i j m x = FreeIx+  {runFreeIx :: forall t. (IxMonadTrans t, Monad m)+    => (forall i j x. g i j x -> t i j m x) -> t i j m x}+instance (IxFunctor f, Monad m) => Functor (FreeIx f i j m) where+  fmap f (FreeIx k) = FreeIx $ \step -> fmap f (k step)+instance (IxFunctor f, i ~ j, Monad m)+  => Applicative (FreeIx f i j m) where+    pure x = FreeIx $ const $ pure x+    (<*>) = apIx+instance (IxFunctor f, i ~ j, Monad m)+  => Monad (FreeIx f i j m) where+    return = pure+    (>>=) = flip bindIx+instance (IxFunctor f, i ~ j)+  => MonadTrans (FreeIx f i j) where+    lift m = FreeIx $ const $ lift m+instance IxFunctor f+  => IxMonadTrans (FreeIx f) where+    joinIx (FreeIx g) = FreeIx $ \k -> bindIx (\(FreeIx f) -> f k) (g k)+instance+  ( IxFunctor f+  , Monad m+  , i ~ j+  ) => MonadFree (f i j) (FreeIx f i j m) where+    wrap = join . liftFreeIx+instance IxMonadTransFree FreeIx where+  liftFreeIx m = FreeIx $ \k -> k m+  hoistFreeIx f (FreeIx k) = FreeIx $ \g -> k (g . f)+  foldFreeIx f (FreeIx k) = k f
+ src/Control/Monad/Trans/Indexed/Free/Wrap.hs view
@@ -0,0 +1,66 @@+{- |+Module      :  Control.Monad.Trans.Indexed.Free.Wrap+Copyright   :  (C) 2024 Eitan Chatav+License     :  BSD 3-Clause License (see the file LICENSE)+Maintainer  :  Eitan Chatav <eitan.chatav@gmail.com>++An instance of the free indexed monad transformer.+-}++module Control.Monad.Trans.Indexed.Free.Wrap+  ( FreeIx (..)+  , WrapIx (..)+  ) where++import Control.Monad.Free+import Control.Monad.Trans+import Control.Monad.Trans.Indexed+import Control.Monad.Trans.Indexed.Free++data WrapIx f i j m x where+  Unwrap :: x -> WrapIx f i i m x+  Wrap :: f i j (FreeIx f j k m x) -> WrapIx f i k m x+instance (IxFunctor f, Monad m)+  => Functor (WrapIx f i j m) where+    fmap f = \case+      Unwrap x -> Unwrap $ f x+      Wrap fm -> Wrap $ fmap (fmap f) fm++newtype FreeIx f i j m x = FreeIx {runFreeIx :: m (WrapIx f i j m x)}+instance (IxFunctor f, Monad m)+  => Functor (FreeIx f i j m) where+    fmap f (FreeIx m) = FreeIx $ fmap (fmap f) m+instance (IxFunctor f, i ~ j, Monad m)+  => Applicative (FreeIx f i j m) where+    pure = FreeIx . pure . Unwrap+    (<*>) = apIx+instance (IxFunctor f, i ~ j, Monad m)+  => Monad (FreeIx f i j m) where+    return = pure+    (>>=) = flip bindIx+instance (IxFunctor f, i ~ j)+  => MonadTrans (FreeIx f i j) where+    lift = FreeIx . fmap Unwrap+instance IxFunctor f+  => IxMonadTrans (FreeIx f) where+    joinIx (FreeIx mm) = FreeIx $ mm >>= \case+      Unwrap (FreeIx m) -> m+      Wrap fm -> return $ Wrap $ fmap joinIx fm+instance+  ( IxFunctor f+  , Monad m+  , i ~ j+  ) => MonadFree (f i j) (FreeIx f i j m) where+    wrap = FreeIx . return . Wrap+instance IxMonadTransFree FreeIx where+  liftFreeIx = FreeIx . return . Wrap . fmap return+  hoistFreeIx f (FreeIx m) = FreeIx (fmap hoist_f m)+    where+      hoist_f = \case+        Unwrap x -> Unwrap x+        Wrap y -> Wrap (f (fmap (hoistFreeIx f) y))+  foldFreeIx f (FreeIx m) = bindIx foldMap_f (lift m)+    where+      foldMap_f = \case+        Unwrap x -> return x+        Wrap y -> bindIx (foldFreeIx f) (f y)
+ src/Control/Monad/Trans/Indexed/State.hs view
@@ -0,0 +1,56 @@+{- |+Module      :  Control.Monad.Trans.Indexed.State+Copyright   :  (C) 2024 Eitan Chatav+License     :  BSD 3-Clause License (see the file LICENSE)+Maintainer  :  Eitan Chatav <eitan.chatav@gmail.com>++The state indexed monad transformer.+-}++module Control.Monad.Trans.Indexed.State+  ( StateIx (..)+  , evalStateIx+  , execStateIx+  , modifyIx+  , putIx+  , toStateT+  , fromStateT+  ) where++import Control.Monad.State+import Control.Monad.Trans.Indexed++newtype StateIx i j m x = StateIx { runStateIx :: i -> m (x, j)}+  deriving Functor+instance IxMonadTrans StateIx where+  joinIx (StateIx f) = StateIx $ \i -> do+    (StateIx g, j) <- f i+    g j+instance (i ~ j, Monad m) => Applicative (StateIx i j m) where+  pure x = StateIx $ \i -> pure (x, i)+  (<*>) = apIx+instance (i ~ j, Monad m) => Monad (StateIx i j m) where+  return = pure+  (>>=) = flip bindIx+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)++evalStateIx :: Monad m => StateIx i j m x -> i -> m x+evalStateIx m i = fst <$> runStateIx m i++execStateIx :: Monad m => StateIx i j m x -> i -> m j+execStateIx m i = snd <$> runStateIx m i++modifyIx :: Applicative m => (i -> j) -> StateIx i j m ()+modifyIx f = StateIx $ \i -> pure ((), f i)++putIx :: Applicative m => j -> StateIx i j m ()+putIx j = modifyIx (\ _ -> j)++toStateT :: StateIx i i m x -> StateT i m x+toStateT (StateIx f) = StateT f++fromStateT :: StateT i m x -> StateIx i i m x+fromStateT (StateT f) = StateIx f
+ src/Control/Monad/Trans/Indexed/Writer.hs view
@@ -0,0 +1,90 @@+{- |+Module      :  Control.Monad.Trans.Indexed.Writer+Copyright   :  (C) 2024 Eitan Chatav+License     :  BSD 3-Clause License (see the file LICENSE)+Maintainer  :  Eitan Chatav <eitan.chatav@gmail.com>++The writer indexed monad transformer.+-}++module Control.Monad.Trans.Indexed.Writer+  ( WriterIx (..)+  , evalWriterIx+  , execWriterIx+  , mapWriterIx+  , tellIx+  , listenIx+  , listensIx+  , passIx+  , censorIx+  ) where++import Prelude hiding (id, (.))+import Control.Category+import Control.Monad.Trans+import Control.Monad.Trans.Indexed++newtype WriterIx w i j m x = WriterIx {runWriterIx :: m (x, w i j)}+  deriving Functor++instance Category w => IxMonadTrans (WriterIx w) where+  joinIx (WriterIx mm) = WriterIx $ do+    (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, Monad m, Category w) => Monad (WriterIx w i j m) where+  return = pure+  (>>=) = flip bindIx+instance (i ~ j, Category w) => MonadTrans (WriterIx w i j) where+  lift m = WriterIx $ do+    x <- m+    return (x, id)++evalWriterIx :: Monad m => WriterIx w i j m x -> m x+evalWriterIx (WriterIx m) = fst <$> m++execWriterIx :: Monad m => WriterIx w i j m x -> m (w i j)+execWriterIx (WriterIx m) = snd <$> m++mapWriterIx+  :: (m (x, w i j) -> n (y, q i j))+  -> WriterIx w i j m x+  -> WriterIx q i j n y+mapWriterIx f m = WriterIx $ f (runWriterIx m)++tellIx :: Monad m => w i j -> WriterIx w i j m ()+tellIx w = WriterIx (return ((), w))++listenIx :: Monad m => WriterIx w i j m x -> WriterIx w i j m (x, w i j)+listenIx (WriterIx m) = WriterIx $ do+  (x, w) <- m+  return ((x, w),w)++listensIx+  :: Monad m+  => (w i j -> y)+  -> WriterIx w i j m x+  -> WriterIx w i j m (x, y)+listensIx f (WriterIx m) = WriterIx $ do+  (x, w) <- m+  return ((x, f w), w)++passIx+  :: Monad m+  => WriterIx w i j m (x, w i j -> q i j)+  -> WriterIx q i j m x+passIx (WriterIx m) = WriterIx $ do+  ((x, f), w) <- m+  return (x, f w)++censorIx :: Monad m => (w i j -> w i j) -> WriterIx w i j m x -> WriterIx w i j m x+censorIx f (WriterIx m) = WriterIx $ do+  (x, w) <- m+  return (x, f w)