monad-journal-0.7.2/Control/0000755000000000000000000000000012502344666014104 5ustar0000000000000000monad-journal-0.7.2/Control/Monad/0000755000000000000000000000000012502344666015142 5ustar0000000000000000monad-journal-0.7.2/Control/Monad/Journal/0000755000000000000000000000000012502344666016554 5ustar0000000000000000monad-journal-0.7.2/Control/Monad/Trans/0000755000000000000000000000000012502344666016231 5ustar0000000000000000monad-journal-0.7.2/Control/Monad/Journal.hs0000644000000000000000000000100312502344666017102 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Copyright : (C) Dimitri Sabadie -- License : BSD3 -- -- Maintainer : dimitri.sabadie@gmail.com -- Stability : stable -- Portability : portable -- -- This module re-exports anything about the 'MonadJournal' *typeclass*. ----------------------------------------------------------------------------- module Control.Monad.Journal ( module Control.Monad.Journal.Class ) where import Control.Monad.Journal.Class monad-journal-0.7.2/Control/Monad/Journal/Class.hs0000644000000000000000000000726212502344666020164 0ustar0000000000000000{-# LANGUAGE FunctionalDependencies, UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) Dimitri Sabadie -- License : BSD3 -- -- Maintainer : dimitri.sabadie@gmail.com -- Stability : stable -- Portability : portable -- -- 'MonadWriter' on steroids. -- -- 'MonadJournal' is a more controlable version of 'MonadWriter' because it -- enables you to access the 'Monoid' being computed up. You can then access -- logs inside the computation itself, whereas you cannot with -- 'MonadWriter' – unless you use specific functions like 'listen', but that -- still stacks 'Monoid' in the monad. -- -- Typically, you can use 'MonadJournal' when you come across the logging -- problem and you need logs as long as you proceed. ----------------------------------------------------------------------------- module Control.Monad.Journal.Class ( -- * MonadJournal MonadJournal(..) , sink , absorb ) where import Control.Monad ( Monad ) import Control.Monad.Trans ( MonadIO, MonadTrans, lift, liftIO ) import Control.Monad.Trans.Either ( EitherT ) import Control.Monad.Trans.Identity ( IdentityT ) import Control.Monad.Trans.List ( ListT ) import Control.Monad.Trans.Maybe ( MaybeT ) import Control.Monad.Trans.RWS ( RWST ) import Control.Monad.Trans.Reader ( ReaderT ) import Control.Monad.Trans.State ( StateT ) import Control.Monad.Trans.Writer ( WriterT ) import Data.Monoid ( Monoid, mappend, mempty ) -- |This typeclass provides the ability to accumulate 'Monoid' in a monad -- via the 'journal' function; to get them via the 'history' function and -- finally, to purge them all with the 'clear' function. -- -- In most cases, you won’t need 'history' neither 'clear'. There’s a -- cool function that combines both and enables you to deal with the -- 'Monoid': 'sink'. class (Monoid w, Monad m) => MonadJournal w m | m -> w where -- |Log something. journal :: w -> m () -- |Extract the logs history. history :: m w -- |Clear the logs history. clear :: m () -- |Sink all logs history through 'MonadIO' then clean it. sink :: (MonadJournal w m, MonadIO m) => (w -> IO ()) -> m () sink out = history >>= liftIO . out >> clear -- |Absorb a logs history and pass around the value. absorb :: (MonadJournal w m) => (a,w) -> m a absorb (a,w) = journal w >> return a instance (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (IdentityT m) where journal !w = lift (journal w) history = lift history clear = lift clear instance (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (ListT m) where journal !w = lift (journal w) history = lift history clear = lift clear instance (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (MaybeT m) where journal !w = lift (journal w) history = lift history clear = lift clear instance (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (RWST r w s m) where journal !w = lift (journal w) history = lift history clear = lift clear instance (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (ReaderT r m) where journal !w = lift (journal w) history = lift history clear = lift clear instance (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (StateT s m) where journal !w = lift (journal w) history = lift history clear = lift clear instance (Monad m, Monoid w, Monoid q, MonadJournal w m) => MonadJournal w (WriterT q m) where journal !w = lift (journal w) history = lift history clear = lift clear instance (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (EitherT e m) where journal !w = lift (journal w) history = lift history clear = lift clear monad-journal-0.7.2/Control/Monad/Trans/Journal.hs0000644000000000000000000001042012502344666020174 0ustar0000000000000000{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, TypeFamilies , UndecidableInstances #-} {-# OPTIONS_HADDOCK prune #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) Dimitri Sabadie -- License : BSD3 -- -- Maintainer : dimitri.sabadie@gmail.com -- Stability : stable -- Portability : portable -- -- Monad transformer version of 'MonadJournal'. 'JournalT' provides -- journaling over a monad. -- -- This modules defines a few useful instances. Check the list below for -- further information. ----------------------------------------------------------------------------- module Control.Monad.Trans.Journal ( -- * JournalT monad transformer JournalT , runJournalT , evalJournalT , execJournalT -- * Re-exported , module Control.Monad.Journal.Class ) where import Control.Applicative ( Applicative, Alternative ) import Control.Monad ( MonadPlus, liftM ) import Control.Monad.Base ( MonadBase, liftBase, liftBaseDefault ) import Control.Monad.Error.Class ( MonadError(..) ) import Control.Monad.Journal.Class import Control.Monad.Reader.Class ( MonadReader(..) ) import Control.Monad.State.Class ( MonadState ) import Control.Monad.Trans ( MonadTrans, MonadIO, lift ) import Control.Monad.Trans.State ( StateT(..), evalStateT, execStateT, get , modify, put, runStateT ) import Control.Monad.Trans.Control ( MonadTransControl(..) , MonadBaseControl(..), ComposeSt , defaultLiftBaseWith, defaultRestoreM ) import Control.Monad.Writer.Class ( MonadWriter(..) ) import Data.Monoid ( Monoid(..) ) import qualified Control.Monad.State.Class as MS ( MonadState(..) ) -- |Transformer version of 'MonadJournal'. newtype JournalT w m a = JournalT (StateT w m a) deriving ( Applicative , Alternative , Functor , Monad , MonadError e , MonadIO , MonadPlus , MonadReader r , MonadTrans , MonadWriter w' ) instance (Monoid w,Monad m) => MonadJournal w (JournalT w m) where journal !w = JournalT . modify $ flip mappend w history = JournalT get clear = JournalT (put mempty) instance MonadState s m => MonadState s (JournalT w m) where get = lift MS.get put = lift . MS.put state = lift . MS.state instance (MonadBase b m) => MonadBase b (JournalT w m) where liftBase = liftBaseDefault #if MIN_VERSION_monad_control(1,0,0) instance Monoid w => MonadTransControl (JournalT w) where type StT (JournalT w) a = (a,w) liftWith f = JournalT $ StateT $ \w -> liftM (\x -> (x, w)) (f $ \t -> runJournalT (journal w >> t)) restoreT = JournalT . StateT . const {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance (Monoid w,MonadBaseControl b m) => MonadBaseControl b (JournalT w m) where type StM (JournalT w m) a = ComposeSt (JournalT w) m a liftBaseWith = defaultLiftBaseWith restoreM = defaultRestoreM {-# INLINE liftBaseWith #-} {-# INLINE restoreM #-} #else instance Monoid w => MonadTransControl (JournalT w) where newtype StT (JournalT w) a = StJournal {unStJournal :: (a, w)} liftWith f = JournalT $ StateT $ \w -> liftM (\x -> (x, w)) (f $ \t -> liftM StJournal $ runJournalT (journal w >> t)) restoreT = JournalT . StateT . const . liftM unStJournal {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance (Monoid w,MonadBaseControl b m) => MonadBaseControl b (JournalT w m) where newtype StM (JournalT w m) a = StMJournal { unStMJournal :: ComposeSt (JournalT w) m a } liftBaseWith = defaultLiftBaseWith StMJournal restoreM = defaultRestoreM unStMJournal {-# INLINE liftBaseWith #-} {-# INLINE restoreM #-} #endif -- |Retrieve the value and the log history. runJournalT :: (Monoid w,Monad m) => JournalT w m a -> m (a,w) runJournalT (JournalT s) = runStateT s mempty -- |Only retrieve the value. evalJournalT :: (Monoid w,Monad m) => JournalT w m a -> m a evalJournalT (JournalT s) = evalStateT s mempty -- |Only retrieve the log history. execJournalT :: (Monoid w,Monad m) => JournalT w m a -> m w execJournalT (JournalT s) = execStateT s mempty monad-journal-0.7.2/LICENSE0000644000000000000000000000277012502344666013477 0ustar0000000000000000Copyright (c) 2014, Dimitri Sabadie 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 Dimitri Sabadie 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. monad-journal-0.7.2/Setup.hs0000644000000000000000000000005612502344666014121 0ustar0000000000000000import Distribution.Simple main = defaultMain monad-journal-0.7.2/monad-journal.cabal0000644000000000000000000000374412716714365016232 0ustar0000000000000000name: monad-journal license: BSD3 license-file: LICENSE version: 0.7.2 synopsis: Pure logger typeclass and monad transformer description: This package provides a typeclass for logging in pure code, or more generally, in any kind of context. You can do whatever you want with logs, especially get them, clear them or even sink them through 'IO' if you're logging in @(MonadIO m) => m@. homepage: http://github.com/phaazon/monad-journal bug-reports: http://github.com/phaazon/monad-journal/issues author: Dimitri Sabadie maintainer: Dimitri Sabadie category: Control build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGELOG.md , README.md source-repository head type: git location: git://github.com/phaazon/monad-journal.git library default-extensions: BangPatterns , FlexibleInstances , MultiParamTypeClasses other-extensions: CPP , FunctionalDependencies , GeneralizedNewtypeDeriving , TypeFamilies , UndecidableInstances exposed-modules: Control.Monad.Journal , Control.Monad.Journal.Class , Control.Monad.Trans.Journal build-depends: base >= 4.5 && < 5.0 , mtl >= 2.1 && < 2.3 , transformers >= 0.3 && < 0.6 , either >= 4.1 && < 4.5 , monad-control >= 0.3 && < 1.1 , transformers-base >= 0.4 && < 0.5 default-language: Haskell2010 monad-journal-0.7.2/CHANGELOG.md0000644000000000000000000000160612716714445014303 0ustar0000000000000000# CHANGELOG ### 0.7.2 - Added support for transformers-0.5. ### 0.7.1 - Added support for either 4.4.1. ### 0.7 - Added support for GHC 7.10. ### 0.6.0.2 - Fixed compilation error. That was due to the change regarding monad-control-1.0. ### 0.6.0.1 - Fixed bug about monad-control and type / data families. ### 0.6 - monad-control 1.0.0.1 qualified. ### 0.5 - license is now BSD3!; - enhanced the documentation in all modules; - added README.md. ### 0.4.0.2 - added the changelog in the package description (.cabal). ### 0.4.0.1 - added the *source-repository head* field in the .cabal file; - added the *bug-reports* field in the .cabal file; - change *author* and *maintainer* format. ### 0.4 - actually, lower bound is better for now; using mtl-2.1. ### 0.3 - now using lower-bound mtl’s version 0.2.2.1 for Control.Monad.Except. ### 0.2.4 - added `MonadExcept` instances. monad-journal-0.7.2/README.md0000644000000000000000000000115312502344666013743 0ustar0000000000000000# monad-journal ## Pure logger typeclass and monad transformer ### What is `monad-journal`? `monad-journal` is a simple but powerful answer to the logging problem. A lot of people think that “logging” is `IO`-related, while it’s not. Everyone must know [MonadWriter](http://hackage.haskell.org/packages/archive/mtl/latest/doc/html/Control-Monad-Writer-Class.html#t:MonadWriter) , which is perfect to log things in pure computations. The issue is that you can’t access those “things” inside the computation itself. `monad-journal` exposes a cool typeclass called `MonadJournal` that enables you to do so.