packages feed

monad-introspect (empty) → 0.1.0.0

raw patch · 5 files changed

+365/−0 lines, 5 filesdep +basedep +coercion-extrasdep +mmorphsetup-changed

Dependencies added: base, coercion-extras, mmorph, mtl, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, mniip++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of mniip nor the names of other+      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+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ monad-introspect.cabal view
@@ -0,0 +1,24 @@+name:                monad-introspect+version:             0.1.0.0+synopsis:            A reader monad that gives the environment access to the entire transformer stack+description:         A reader monad that gives the environment access to the entire transformer stack.+homepage:            https://github.com/mniip/monad-introspect+license:             BSD3+license-file:        LICENSE+author:              mniip+maintainer:          mniip@mniip.com+copyright:           (C) mniip 2019+category:            Control+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:       Control.Monad.Introspect.Class+                       , Control.Monad.Trans.Introspect+  build-depends:       base >= 4.12 && < 4.15,+                       coercion-extras,+                       mmorph,+                       mtl,+                       transformers+  hs-source-dirs:      src+  default-language:    Haskell2010
+ src/Control/Monad/Introspect/Class.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-deprecations #-}++module Control.Monad.Introspect.Class where++import Control.Applicative+import Control.Monad hiding (fail)+import Control.Monad.Error (ErrorT(..), mapErrorT)+import Control.Monad.Error.Class +import Control.Monad.Except (ExceptT(..), mapExceptT)+import Control.Monad.Trans.Class+import Control.Monad.Trans.Compose+import Control.Monad.Trans.Cont (ContT(..), mapContT)+import Control.Monad.Trans.Identity (IdentityT(..), mapIdentityT)+import Control.Monad.Trans.List (ListT(..), mapListT)+import Control.Monad.Trans.Maybe (MaybeT(..), mapMaybeT)+import Control.Monad.Trans.Reader (ReaderT(..), mapReaderT)+import Control.Monad.Trans.RWS (RWST(..), mapRWST)+import qualified Control.Monad.Trans.State.Lazy as L+import qualified Control.Monad.Trans.State.Strict as S+import qualified Control.Monad.Trans.Writer.Lazy as L+import qualified Control.Monad.Trans.Writer.Strict as S+import Data.Coerce+import Prelude hiding (fail)+import Data.Type.Role.Representational++-- * Abstract interface++-- | A monad with introspection capability is able to query an environment @r@+-- that is parameterized by the monad itself, i.e. can contain effectful+-- functions.+--+-- The caveat is that sometimes the monad changes (e.g. we locally run a+-- transformer, or we globally run our transformer steck), so the monad in the+-- environment can "desync" from the ambient monad. This warrants a more general+-- class: 'MonadIntrospectTrans', of which 'MonadIntrospect' is a special case.+--+-- The machinery sometimes requires newtype wrapping/unwrapping the monad that+-- goes to the environment. We use/require 'Coercible' for that, as the+-- "functorial" operations are deemed expensive. The constraint+-- @'Representational' r@ ensures that the environment can be coerced provided+-- the monad can be coerced.+--+-- Otherwise the interface is identical to that of+-- 'Control.Monad.Reader.Class.MonadReader'.+class (Representational r, MonadIntrospectTrans IdentityT r m)+  => MonadIntrospect (r :: (* -> *) -> *) (m :: * -> *) where+  -- | Essentially 'Control.Monad.Reader.Class.ask'.+  introspect :: m (r m)+  -- | Essentially 'Control.Monad.Reader.Class.local'.+  substitute :: (r m -> r m) -> m a -> m a++-- | If the ambient monad is @m@ and the environment @r@ has additional effects+-- @t@, we can ask for that environment, or substitute it. Multiple (or zero)+-- effects can be combined into a single @t@ with 'ComposeT' (or 'IdentityT').+class (Monad m, MonadTrans t) => MonadIntrospectTrans+  (t :: (* -> *) -> * -> *)+  (r :: (* -> *) -> *)+  (m :: * -> *)+  | m -> t where+  -- | Essentially 'Control.Monad.Reader.Class.ask'.+  introspectTrans :: m (r (t m))+  -- | Essentially 'Control.Monad.Reader.Class.local'.+  substituteTrans :: (r (t m) -> r (t m)) -> m a -> m a++instance (Representational r, MonadIntrospectTrans IdentityT r m)+  => MonadIntrospect r m where+  introspect = liftTransEnv <$> introspectTrans+  substitute = substituteTrans . liftTransMapper++-- * Utility functions for coercing environments++liftTransEnv :: (Representational r, Coercible m n) => r m -> r n+liftTransEnv = coerce++liftTransMapper :: (Representational r, Coercible m n)+  => (r m -> r m) -> r n -> r n+liftTransMapper = coerce++-- Other effects proxy MonadIntrospect++instance+  ( Representational r+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t IdentityT) r m )+  => MonadIntrospectTrans t r (IdentityT m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = mapIdentityT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t ListT) r m )+  => MonadIntrospectTrans t r (ListT m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = mapListT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t (ContT e)) r m )+  => MonadIntrospectTrans t r (ContT e m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = mapContT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t (ExceptT e)) r m )+  => MonadIntrospectTrans t r (ExceptT e m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = mapExceptT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , Error e+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t (ErrorT e)) r m )+  => MonadIntrospectTrans t r (ErrorT e m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = mapErrorT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t (ReaderT e)) r m )+  => MonadIntrospectTrans t r (ReaderT e m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = mapReaderT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t MaybeT) r m )+  => MonadIntrospectTrans t r (MaybeT m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = mapMaybeT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t (L.StateT s)) r m )+  => MonadIntrospectTrans t r (L.StateT s m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = L.mapStateT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t (S.StateT s)) r m )+  => MonadIntrospectTrans t r (S.StateT s m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = S.mapStateT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , Monoid w+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t (L.WriterT w)) r m )+  => MonadIntrospectTrans t r (L.WriterT w m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = L.mapWriterT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , Monoid w+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t (S.WriterT w)) r m )+  => MonadIntrospectTrans t r (S.WriterT w m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = S.mapWriterT . substituteTrans . liftTransMapper++instance+  ( Representational r+  , Monoid w+  , MonadTrans t+  , MonadIntrospectTrans (ComposeT t (RWST e w s)) r m )+  => MonadIntrospectTrans t r (RWST e w s m) where+  introspectTrans = lift $ liftTransEnv <$> introspectTrans+  substituteTrans = mapRWST . substituteTrans . liftTransMapper
+ src/Control/Monad/Trans/Introspect.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-deprecations #-}++module Control.Monad.Trans.Introspect where++import Control.Applicative+import Control.Monad hiding (fail)+import Control.Monad.Cont.Class +import Control.Monad.Error.Class +import Control.Monad.Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Reader.Class+import Control.Monad.Signatures+import Control.Monad.State.Class+import Control.Monad.Trans.Class+import Control.Monad.Writer.Class+import Control.Monad.Zip+import Data.Coerce+import Prelude hiding (fail)+import Control.Monad.Introspect.Class+import Data.Type.Role.Representational++-- * Concrete interface++-- | @'IntrospectT' t r m a@ extends the monad @m@ with access to an environment+-- @r@ parameterized by @m@ with additional effects @t@ on top.+newtype IntrospectT+  (t :: (* -> *) -> * -> *)+  (r :: (* -> *) -> *)+  (m :: * -> *)+  (a :: *)+  = IntrospectT { runIntrospectT :: r (t (IntrospectT t r m)) -> m a }++-- | Run an 'IntrospectT'. If introspection is the outermost effect then you+-- will likely have @t ~ 'Control.Monad.Trans.Identity.IdentityT'@ and thus you+-- can pick @n ~ 'IntrospectT' t r m@.+runIntrospect :: (Representational r, Coercible (t (IntrospectT t r m)) n)+  => r n -> IntrospectT t r m a -> m a+runIntrospect e (IntrospectT h) = h $ liftTransEnv e++instance Functor m => Functor (IntrospectT t r m) where+  fmap f (IntrospectT h) = IntrospectT $ fmap f . h++instance Applicative m => Applicative (IntrospectT t r m) where+  pure x = IntrospectT $ const $ pure x+  IntrospectT f <*> IntrospectT x = IntrospectT $ liftA2 (<*>) f x++instance Alternative m => Alternative (IntrospectT t r m) where+  empty = IntrospectT $ const empty+  IntrospectT f <|> IntrospectT g = IntrospectT $ liftA2 (<|>) f g++instance Monad m => Monad (IntrospectT t r m) where+  IntrospectT k >>= f = IntrospectT $ \e -> k e >>= \x -> runIntrospectT (f x) e++instance MonadPlus m => MonadPlus (IntrospectT t r m) where+  mzero = IntrospectT $ const mzero+  mplus (IntrospectT f) (IntrospectT g) = IntrospectT $ liftA2 mplus f g++instance MonadTrans (IntrospectT t r) where+  lift k = IntrospectT $ const k++instance (Monad m, MonadTrans t)+  => MonadIntrospectTrans t r (IntrospectT t r m) where+  introspectTrans = IntrospectT return+  substituteTrans f (IntrospectT h) = IntrospectT $ h . f++-- * Utility functions for proxying other effects++mapIntrospectT :: (m a -> m b) -> IntrospectT t r m a -> IntrospectT t r m b+mapIntrospectT f (IntrospectT h) = IntrospectT $ f . h++liftCallCC :: CallCC m a b -> CallCC (IntrospectT t r m) a b+liftCallCC cCC f = IntrospectT $ \r ->+  cCC $ \c -> runIntrospectT (f (IntrospectT . const . c)) r++liftCatch :: Catch e m a -> Catch e (IntrospectT t r m) a+liftCatch f m h = IntrospectT $ \r ->+  f (runIntrospectT m r) $ \e -> runIntrospectT (h e) r++-- IntrospectT proxies other effects++instance MonadError e m => MonadError e (IntrospectT t r m) where+  throwError = lift . throwError+  catchError = liftCatch catchError++instance MonadReader e m => MonadReader e (IntrospectT t r m) where+  ask = lift ask+  local = mapIntrospectT . local+  reader = lift . reader++instance MonadState s m => MonadState s (IntrospectT t r m) where+   get = lift get+   put = lift . put+   state = lift . state++instance MonadWriter w m => MonadWriter w (IntrospectT t r m) where+   writer = lift . writer+   tell = lift . tell+   listen = mapIntrospectT listen+   pass = mapIntrospectT pass++instance MonadCont m => MonadCont (IntrospectT t r m) where+  callCC = liftCallCC callCC++instance MonadFix m => MonadFix (IntrospectT t r m) where+  mfix f = IntrospectT $ \r -> mfix $ \a -> runIntrospectT (f a) r++instance MonadFail m => MonadFail (IntrospectT t r m) where+  fail = lift . fail++instance MonadZip m => MonadZip (IntrospectT t r m) where+  mzip (IntrospectT f) (IntrospectT g) = IntrospectT $ \r -> mzip (f r) (g r)+  mzipWith h (IntrospectT f) (IntrospectT g) = IntrospectT $ \r ->+    mzipWith h (f r) (g r)++instance MonadIO m => MonadIO (IntrospectT t r m) where+  liftIO = lift . liftIO