co-log-core 0.1.0 → 0.1.1

raw patch · 6 files changed

+320/−28 lines, 6 filesdep +doctestdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: doctest

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +22/−6
• co-log-core.cabal +41/−7
• src/Colog/Core.hs +2/−0
• src/Colog/Core/Action.hs +134/−15
• src/Colog/Core/IO.hs +108/−0
• test/Doctests.hs +13/−0

@@ -1,20 +1,36 @@-Change log-==========+# Change log  `co-log-core` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. -0.1.0-=====+## 0.1.1 — Nov 15, 2018 +* [#63](https://github.com/kowainik/co-log/issues/63):+  Add `logPrint`, `logPrintStderr`, `logPrintHandle` and `withLogPrintFile` to `Colog.Core.IO`.+* [#46](https://github.com/kowainik/co-log/issues/46):+  Moves `logStringStdout`, `logStringStderr`, `logStringHandle`,+  `withLogStringFile` from `Colog.Actions` to `Colog.Core.IO`.+* [#48](https://github.com/kowainik/co-log/issues/48):+  Adds `liftLogIO` function.+* [#49](https://github.com/kowainik/co-log/issues/49):+  Add `<&` and `&>`operators for `unLogAction`.+* [#47](https://github.com/kowainik/co-log/issues/47):+  Add `doctest` tests.+* [#13](https://github.com/kowainik/co-log/issues/13):+  Add `.cabal` file description and improve documentation.+* [#39](https://github.com/kowainik/co-log/issues/39):+  Support GHC-8.2.2 and GHC-8.6.2.++## 0.1.0+ * [#38](https://github.com/kowainik/co-log/issues/38):   Rename `cbind` to `cmapM`.  * [#37](https://github.com/kowainik/co-log/issues/37):   Add `base` bounds. -0.0.0-=====+## 0.0.0+ * Initially created.  [1]: https://pvp.haskell.org

@@ -1,7 +1,20 @@+cabal-version:       2.0 name:                co-log-core-version:             0.1.0-description:         Logging library-synopsis:            Logging library+version:             0.1.1+synopsis:            Composable Contravariant Comonadic Logging Library+description:+    This package provides core types and functions to work with the @LogAction@ data type which is both simple and powerful.+    .+    @+    __newtype__ LogAction m msg = LogAction+    \    { unLogAction :: msg -> m ()+    \    }+    @+    .+    The ideas behind this package are described in the following blog post:+    .+    * [co-log: Composable Contravariant Combinatorial Comonadic Configurable Convenient Logging](https://kowainik.github.io/posts/2018-09-25-co-log)+ homepage:            https://github.com/kowainik/co-log bug-reports:         https://github.com/kowainik/co-log/issues license:             MPL-2.0@@ -12,8 +25,9 @@ category:            Logging build-type:          Simple extra-doc-files:     CHANGELOG.md-cabal-version:       2.0-tested-with:         GHC == 8.4.3+tested-with:         GHC == 8.2.2+                   , GHC == 8.4.4+                   , GHC == 8.6.2  source-repository head   type:                git@@ -25,8 +39,9 @@                            Colog.Core.Action                            Colog.Core.Class                            Colog.Core.Severity+                           Colog.Core.IO -  build-depends:       base >= 4.11 && < 5+  build-depends:       base >= 4.10 && < 4.13    ghc-options:         -Wall                        -Wincomplete-uni-patterns@@ -38,4 +53,23 @@                        -freverse-errors    default-language:    Haskell2010-  default-extensions:  InstanceSigs+  default-extensions:  ConstraintKinds+                       DeriveGeneric+                       GeneralizedNewtypeDeriving+                       InstanceSigs+                       LambdaCase+                       OverloadedStrings+                       RecordWildCards+                       ScopedTypeVariables+                       StandaloneDeriving+                       TupleSections+                       TypeApplications+                       ViewPatterns++test-suite doctest+  type:                 exitcode-stdio-1.0+  build-depends:        base >= 4.10 && < 4.13+                      , doctest ^>= 0.16.0+  default-language:     Haskell2010+  hs-source-dirs:       test+  main-is:              Doctests.hs

@@ -1,9 +1,11 @@ module Colog.Core        ( module Colog.Core.Action        , module Colog.Core.Class+       , module Colog.Core.IO        , module Colog.Core.Severity        ) where  import Colog.Core.Action import Colog.Core.Class+import Colog.Core.IO import Colog.Core.Severity

@@ -1,4 +1,4 @@-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE CPP #-}  {- | Implements core data types and combinators for logging actions. -}@@ -6,6 +6,8 @@ module Colog.Core.Action        ( -- * Core type and instances          LogAction (..)+       , (<&)+       , (&>)           -- * 'Semigroup' combinators        , foldActions@@ -14,7 +16,7 @@        , cfilter        , cmap        , (>$<)-       , (>$)+       , (Colog.Core.Action.>$)        , cmapM           -- * Divisible combinators@@ -37,12 +39,21 @@        ) where  import Control.Monad (when, (>=>))+import Data.Coerce (coerce) import Data.Foldable (for_) import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..), stimesMonoid) import Data.Void (Void, absurd) +#if MIN_VERSION_base(4,12,0)+import qualified Data.Functor.Contravariant as Contravariant+#endif++{- $setup+>>> import Colog.Core.IO+-}+ ---------------------------------------------------------------------------- -- Core data type with instances ----------------------------------------------------------------------------@@ -107,6 +118,59 @@     mconcat = foldActions     {-# INLINE mconcat #-} +#if MIN_VERSION_base(4,12,0)+instance Contravariant.Contravariant (LogAction m) where+    contramap = cmap+    {-# INLINE contramap #-}++    (>$) = (Colog.Core.Action.>$)+    {-# INLINE (>$) #-}+#endif++{- | Operator version of 'unLogAction'. Note that because of the types, something like:++@+action <& msg1 <& msg2+@++doesn't make sense. Instead you want:++@+action <& msg1 >> action <& msg2+@++In addition, because '<&' has higher precedence than the other operators in this+module, the following:++@+f >$< action <& msg+@++is equivalent to:++@+(f >$< action) <& msg+@+-}+infix 5 <&+(<&) :: LogAction m msg -> msg -> m ()+(<&) = coerce+{-# INLINE (<&) #-}++{- | A flipped version of '<&'.++It shares the same precedence as '<&', so make sure to surround lower precedence+operators in parentheses:++@+msg &> (f >$< action)+@+-}+infix 5 &>+(&>) :: msg -> LogAction m msg -> m ()+(&>) = flip unLogAction+{-# INLINE (&>) #-}+ ---------------------------------------------------------------------------- -- Combinators ----------------------------------------------------------------------------@@ -170,7 +234,11 @@ cmap f (LogAction action) = LogAction (action . f) {-# INLINE cmap #-} --- | Operator version of 'cmap'.+{- | Operator version of 'cmap'.++>>> 1 &> (show >$< logStringStdout)+1+-} infixr 3 >$< (>$<) :: (a -> b) -> LogAction m b -> LogAction m a (>$<) = cmap@@ -179,6 +247,11 @@ {- | This combinator is @>$@ from contravariant functor. Replaces all locations in the output with the same value. The default definition is @contramap . const@, so this is a more efficient version.++>>> "Hello?" &> ("OUT OF SERVICE" >$ logStringStdout)+OUT OF SERVICE+>>> ("OUT OF SERVICE" >$ logStringStdout) <& 42+OUT OF SERVICE -} infixl 4 >$ (>$) :: b -> LogAction m b -> LogAction m a@@ -230,17 +303,38 @@ cmapM f (LogAction action) = LogAction (f >=> action) {-# INLINE cmapM #-} --- | @divide@ combinator from @Divisible@ type class.+{- | @divide@ combinator from @Divisible@ type class.++>>> logInt = LogAction print+>>> "ABC" &> divide (\s -> (s, length s)) logStringStdout logInt+ABC+3+-} divide :: (Applicative m) => (a -> (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a divide f (LogAction actionB) (LogAction actionC) = LogAction $ \(f -> (b, c)) ->     actionB b *> actionC c --- | @conquer@ combinator from @Divisible@ type class.+{- | @conquer@ combinator from @Divisible@ type class.++Concretely, this is a 'LogAction' that does nothing:++>>> conquer <& "hello?"+>>> "hello?" &> conquer+-} conquer :: Applicative m => LogAction m a-conquer = LogAction $ const (pure ())+conquer = mempty  --- | Operator version of @'divide' 'id'@.+{- | Operator version of @'divide' 'id'@.++>>> logInt = LogAction print+>>> (logStringStdout >*< logInt) <& ("foo", 1)+foo+1+>>> (logInt >*< logStringStdout) <& (1, "foo")+1+foo+-} infixr 4 >*< (>*<) :: (Applicative m) => LogAction m a -> LogAction m b -> LogAction m (a, b) (LogAction actionA) >*< (LogAction actionB) = LogAction $ \(a, b) ->@@ -248,12 +342,20 @@ {-# INLINE (>*<) #-}  infixr 4 >*+{-| Perform a constant log action after another.++>>> logHello = LogAction (const (putStrLn "Hello!"))+>>> "Greetings!" &> (logStringStdout >* logHello)+Greetings!+Hello!+-} (>*) :: Applicative m => LogAction m a -> LogAction m () -> LogAction m a (LogAction actionA) >* (LogAction actionB) = LogAction $ \a ->     actionA a *> actionB () {-# INLINE (>*) #-}  infixr 4 *<+-- | A flipped version of '>*' (*<) :: Applicative m => LogAction m () -> LogAction m a -> LogAction m a (LogAction actionA) *< (LogAction actionB) = LogAction $ \a ->     actionA () *> actionB a@@ -263,11 +365,26 @@ lose :: (a -> Void) -> LogAction m a lose f = LogAction (absurd . f) --- | @choose@ combinator from @Decidable@ type class.+{- | @choose@ combinator from @Decidable@ type class.++>>> logInt = LogAction print+>>> f = choose (\a -> if a < 0 then Left "Negative" else Right a)+>>> f logStringStdout logInt <& 1+1+>>> f logStringStdout logInt <& (-1)+Negative+-} choose :: (a -> Either b c) -> LogAction m b -> LogAction m c -> LogAction m a choose f (LogAction actionB) (LogAction actionC) = LogAction (either actionB actionC . f) --- | Operator version of @'choose' 'id'@.+{- | Operator version of @'choose' 'id'@.++>>> dontPrintInt = LogAction (const (putStrLn "Not printing Int"))+>>> Left 1 &> (dontPrintInt >|< logStringStdout)+Not printing Int+>>> (dontPrintInt >|< logStringStdout) <& Right ":)"+:)+-} infixr 3 >|< (>|<) :: LogAction m a -> LogAction m b -> LogAction m (Either a b) (LogAction actionA) >|< (LogAction actionB) = LogAction (either actionA actionB)@@ -275,6 +392,10 @@  {- | If @msg@ is 'Monoid' then 'extract' performs given log action by passing 'mempty' to it.++>>> logPrint :: LogAction IO [Int]; logPrint = LogAction print+>>> extract logPrint+[] -} extract :: Monoid msg => LogAction m msg -> m () extract action = unLogAction action mempty@@ -282,21 +403,19 @@ -- TODO: write better motivation for comonads {- | This is a /comonadic extend/. It allows you to chain different transformations on messages. ->>> logToStdout = LogAction putStrLn >>> f (LogAction l) = l ".f1" *> l ".f2" >>> g (LogAction l) = l ".g"->>> unLogAction logToStdout "foo"+>>> unLogAction logStringStdout "foo" foo->>> unLogAction (extend f logToStdout) "foo"+>>> unLogAction (extend f logStringStdout) "foo" foo.f1 foo.f2->>> unLogAction (extend g $ extend f logToStdout) "foo"+>>> unLogAction (extend g $ extend f logStringStdout) "foo" foo.g.f1 foo.g.f2->>> unLogAction (logToStdout =>> f =>> g) "foo"+>>> unLogAction (logStringStdout =>> f =>> g) "foo" foo.g.f1 foo.g.f2- -} extend :: Semigroup msg => (LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg extend f (LogAction action) = LogAction $ \m -> f $ LogAction $ \m' -> action (m <> m')

@@ -0,0 +1,108 @@+module Colog.Core.IO+       ( -- * 'String' actions+         logStringStdout+       , logStringStderr+       , logStringHandle+       , withLogStringFile++         -- * 'Show' actions+       , logPrint+       , logPrintStderr+       , logPrintHandle+       , withLogPrintFile++         -- * Various combinators+       , liftLogIO+       ) where++import Colog.Core.Action (LogAction (..))+import Control.Monad.IO.Class (MonadIO, liftIO)+import System.IO (Handle, IOMode (AppendMode), hPrint, hPutStrLn, stderr, withFile)++----------------------------------------------------------------------------+-- String+----------------------------------------------------------------------------++{- | Action that prints 'String' to stdout.++>>> unLogAction logStringStdout "foo"+foo+-}+logStringStdout :: MonadIO m => LogAction m String+logStringStdout = LogAction (liftIO . putStrLn)++{- | Action that prints 'String' to stderr.++>>> unLogAction logStringStderr "foo"+foo+-}+logStringStderr :: MonadIO m => LogAction m String+logStringStderr = logStringHandle stderr++{- | Action that prints 'String' to 'Handle'.++>>> unLogAction (logStringHandle stderr) "foo"+foo+-}+logStringHandle :: MonadIO m => Handle -> LogAction m String+logStringHandle handle = LogAction $ liftIO . hPutStrLn handle++{- | Action that prints 'String' to file. Instead of returning 'LogAction' it's+implemented in continuation-passing style because it's more efficient to open+file only once at the start of the application and write to 'Handle' instead of+opening file each time we need to write to it.++Opens file in 'AppendMode'.++>>> logger action = unLogAction action "foo"+>>> withLogStringFile "/dev/stdout" logger+foo+-}+withLogStringFile :: MonadIO m => FilePath -> (LogAction m String -> IO r) -> IO r+withLogStringFile path action = withFile path AppendMode $ action . logStringHandle++----------------------------------------------------------------------------+-- Show+----------------------------------------------------------------------------++{- | Action that prints to stdout using 'Show'.++>>> unLogAction logPrint 5+5+-}+logPrint :: forall a m . (Show a, MonadIO m) => LogAction m a+logPrint = LogAction $ liftIO . print++{- | Action that prints to stderr using 'Show'.++>>> unLogAction logPrintStderr 5+5+-}+logPrintStderr :: forall a m . (Show a, MonadIO m) => LogAction m a+logPrintStderr = logPrintHandle stderr++{- | Action that prints to a 'Handle' using 'Show'.++>>> unLogAction (logPrintHandle stderr) 5+5+-}+logPrintHandle :: forall a m . (Show a, MonadIO m) => Handle -> LogAction m a+logPrintHandle handle = LogAction $ liftIO . hPrint handle++{- | Action that prints to a file using 'Show'. See 'withLogStringFile' for details.+-}+withLogPrintFile :: forall a m r . (Show a, MonadIO m) => FilePath -> (LogAction m a -> IO r) -> IO r+withLogPrintFile path action = withFile path AppendMode $ action . logPrintHandle++----------------------------------------------------------------------------+-- Misc+----------------------------------------------------------------------------++{- | Lifts a LogAction over IO into a more general Monad.++>>> logToStdout = LogAction putStrLn+>>> unLogAction (liftLogIO logToStdout) "foo"+foo+-}+liftLogIO :: MonadIO m => LogAction IO msg -> LogAction m msg+liftLogIO (LogAction action) = LogAction (liftIO . action)

@@ -0,0 +1,13 @@+module Main+       ( main+       ) where++import Test.DocTest (doctest)++main :: IO ()+main = doctest+    [ "-XInstanceSigs"+    , "-XScopedTypeVariables"+    , "-XViewPatterns"+    , "src"+    ]