[#101] Add logActionL lens, impove docs a bit

Resolves #101

co-log-core/src/Colog/Core.hs

@@ -1,3 +1,10 @@
+{- |
+Copyright:  (c) 2018-2019 Kowainik
+License:    MIT
+Maintainer: Kowainik <xrom.xkov@gmail.com>
+
+Exports all core functionality.
+-}
 module Colog.Core
        ( module Colog.Core.Action
        , module Colog.Core.Class

co-log-core/src/Colog/Core/Action.hs

@@ -1,6 +1,11 @@
 {-# LANGUAGE CPP #-}
 
-{- | Implements core data types and combinators for logging actions.
+{- |
+Copyright:  (c) 2018-2019 Kowainik
+License:    MIT
+Maintainer: Kowainik <xrom.xkov@gmail.com>
+
+Implements core data types and combinators for logging actions.
 -}
 
 module Colog.Core.Action

co-log-core/src/Colog/Core/Class.hs

@@ -1,33 +1,72 @@
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE Rank2Types            #-}
 
-{- | Provides type class for objects that has access to 'LogAction'.
+{- |
+Copyright:  (c) 2018-2019 Kowainik
+License:    MIT
+Maintainer: Kowainik <xrom.xkov@gmail.com>
+
+Provides type class for objects that has access to 'LogAction'.
 -}
 
 module Colog.Core.Class
        ( HasLog (..)
+
+         -- * Lens
+         -- $lens
+       , Lens'
        ) where
 
 import Colog.Core.Action (LogAction)
 
-{- | This types class contains simple pair of getter-setter.
+
+{- | This types class contains simple pair of getter-setter and related
+functions.
+It also provides the useful lens 'logActionL' with the default implementation using type
+class methods. The default one could be easily overritten under your instances.
 
 TODO: laws
 -}
 class HasLog env msg m where
     {-# MINIMAL getLogAction, (setLogAction | overLogAction) #-}
     getLogAction :: env -> LogAction m msg
+
     setLogAction :: LogAction m msg -> env -> env
     setLogAction = overLogAction . const
     {-# INLINE setLogAction #-}
+
     overLogAction :: (LogAction m msg -> LogAction m msg) -> env -> env
     overLogAction f env = setLogAction (f $ getLogAction env) env
     {-# INLINE overLogAction #-}
 
+    logActionL :: Lens' env (LogAction m msg)
+    logActionL = lens getLogAction (flip setLogAction)
+    {-# INLINE logActionL #-}
+
 instance HasLog (LogAction m msg) msg m where
     {-# INLINE getLogAction #-}
     getLogAction = id
     {-# INLINE setLogAction #-}
     setLogAction = const
     {-# INLINE overLogAction #-}
     overLogAction = id
+
+----------------------------------------------------------------------------
+-- Lens
+----------------------------------------------------------------------------
+
+{- $lens
+To keep @co-log-core@ a lightweight library it was decided to introduce local
+'Lens'' type alias as it doesn't harm.
+-}
+
+{- | The monomorphic lenses which don't change the type of the container (or of
+the value inside).
+-}
+type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s
+
+-- | Creates 'Lens'' from the getter and setter.
+lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
+lens getter setter = \f s -> setter s <$> f (getter s)
+{-# INLINE lens #-}

co-log-core/src/Colog/Core/IO.hs

@@ -1,3 +1,11 @@
+{- |
+Copyright:  (c) 2018-2019 Kowainik
+License:    MIT
+Maintainer: Kowainik <xrom.xkov@gmail.com>
+
+Introduces logging actions working in 'MonadIO'.
+-}
+
 module Colog.Core.IO
        ( -- * 'String' actions
          logStringStdout

co-log-core/src/Colog/Core/Severity.hs

@@ -1,13 +1,31 @@
 {-# LANGUAGE PatternSynonyms #-}
 
-{- | This module introduces 'Severity' data type for expressing how severe the
-message is. Also, it contains useful functions for work with 'Severity'.
+{- |
+Copyright:  (c) 2018-2019 Kowainik
+License:    MIT
+Maintainer: Kowainik <xrom.xkov@gmail.com>
 
+This module introduces 'Severity' data type for expressing how severe the
+message is. Also, it contains useful functions and patterns for work with 'Severity'.
+
+
+ +-----------+---------+-----------------------------------------+-----------------------------+
+ | Severity  | Pattern | Meaning                                 | Example                     |
+ +===========+=========+=========================================+=============================+
+ | 'Debug'   | 'D'     | Information useful for debug purposes   | Internal function call logs |
+ +-----------+---------+-----------------------------------------+-----------------------------+
+ | 'Info'    | 'I'     | Normal operational information          | Finish file uploading       |
+ +-----------+---------+-----------------------------------------+-----------------------------+
+ | 'Warning' | 'W'     | General warnings, non-critical failures | Image load error            |
+ +-----------+---------+-----------------------------------------+-----------------------------+
+ | 'Error'   | 'E'     | General errors/severe errors            | Could not connect to the DB |
+ +-----------+---------+-----------------------------------------+-----------------------------+
 -}
 
 module Colog.Core.Severity
        ( Severity (..)
-         -- Patterns
+         -- ** Patterns
+         -- $pattern
        , pattern D
        , pattern I
        , pattern W
@@ -44,6 +62,26 @@ data Severity
     | Error
     deriving (Show, Read, Eq, Ord, Enum, Bounded, Ix)
 
+{- $pattern
+Instead of using full names of the constructors you can instead use one-letter
+patterns. To do so you can import and use the pattern:
+
+@
+import Colog (pattern D)
+
+example :: WithLog env Message m => m ()
+example = log D "I'm using severity pattern"
+@
+
+Moreover, you could use patterns when pattern-matching on severity
+
+@
+errorToStderr :: 'Severity' -> IO ()
+errorToStderr E = hputStrLn stderr "Error severity"
+errorToStderr _ = putStrLn "Something else"
+@
+-}
+
 pattern D, I, W, E :: Severity
 pattern D <- Debug   where D = Debug
 pattern I <- Info    where I = Info
@@ -52,6 +90,6 @@ pattern E <- Error   where E = Error
 {-# COMPLETE D, I, W, E #-}
 
 
--- | Filters messages by given 'Severity'.
+-- | Filters messages by the given 'Severity'.
 filterBySeverity :: Applicative m => Severity -> (a -> Severity) -> LogAction m a -> LogAction m a
 filterBySeverity s fs = cfilter (\a -> fs a >= s)