Merge pull request #22 from MatrixAI/monad-logging

Add Library example of using Monad Logger (type class capability pattern)

Author: CMCDragonkai

app/library/Main.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main where
+
+import           Control.Monad.IO.Class         ( MonadIO
+                                                , liftIO
+                                                )
+import           Control.Monad.Logger          as L
+import qualified Data.Text                     as T
+
+import           Library                       as Lib
+
+main :: IO ()
+main = do
+  putStrLn "Please enter some texts: "
+  msg <- getLine
+  foo msg
+  foo' msg
+  bar msg
+  bar' msg
+  foobar msg
+  foobar' msg
+
+-- call preFoo and supply a file based logging capability
+foo :: String -> IO ()
+foo msg = L.runFileLoggingT "/tmp/demo.log" $ do
+  liftIO $ putStrLn ""
+  $(L.logInfo) $ T.pack $ "[foo] Got user input: " ++ msg
+  out <- preFoo msg
+  liftIO $ putStrLn out
+
+-- call preFooIO and the inner logging will be library default stderr based logging
+foo' :: String -> IO ()
+foo' msg = L.runFileLoggingT "/tmp/demo.log" $ do
+  liftIO $ putStrLn ""
+  $(L.logInfo) $ T.pack $ "[foo'] Got user input: " ++ msg
+  out <- liftIO $ preFooIO msg
+  liftIO $ putStrLn out
+
+-- call runBarWith and supply file based logging action of caller
+bar :: String -> IO ()
+bar msg = L.runFileLoggingT "/tmp/demo.log" $ do
+  liftIO $ putStrLn ""
+  $(L.logInfo) $ T.pack $ "[bar] Got user input: " ++ msg
+  out <- liftIO $ runBar $ preBar msg
+  liftIO $ putStrLn out
+
+-- call runBarWithLogger and the inner logging is fixed to stderr logging again
+bar' :: String -> IO ()
+bar' msg = L.runFileLoggingT "/tmp/demo.log" $ do
+  liftIO $ putStrLn ""
+  $(L.logInfo) $ T.pack $ "[bar'] Got user input: " ++ msg
+  -- get the logging action from caller's logging context
+  logAction <- L.askLoggerIO
+  out <- liftIO $ runBarWithLogger (flip runLoggingT $ logAction) $ preBar msg
+  liftIO $ putStrLn out
+
+-- run runFooBarT and supply a file based logging capability
+foobar :: String -> IO ()
+foobar msg = L.runFileLoggingT "/tmp/demo.log" $ do
+  liftIO $ putStrLn ""
+  $(L.logInfo) $ T.pack $ "[foobar] Got user input: " ++ msg
+  out <- runFooBarT $ preFooBar msg
+  liftIO $ putStrLn out
+
+-- run runFooBarIO and the inner logging will be library default stderr based logging
+foobar' :: String -> IO ()
+foobar' msg = L.runFileLoggingT "/tmp/demo.log" $ do
+  liftIO $ putStrLn ""
+  $(L.logInfo) $ T.pack $ "[foobar'] Got user input: " ++ msg
+  out <- liftIO $ runFooBarIO $ preFooBar msg
+  liftIO $ putStrLn out

default.nix

@@ -1,6 +1,6 @@
 { mkDerivation, base, data-default-class, hpack, http-types
 , iproute, monad-logger, mtl, network, safe-exceptions, stdenv
-, transformers, wai, warp
+, text, transformers, wai, warp
 }:
 mkDerivation {
   pname = "haskell-demo";
@@ -10,16 +10,16 @@ mkDerivation {
   isExecutable = true;
   libraryHaskellDepends = [
     base data-default-class http-types iproute monad-logger mtl network
-    safe-exceptions transformers wai warp
+    safe-exceptions text transformers wai warp
   ];
   libraryToolDepends = [ hpack ];
   executableHaskellDepends = [
     base data-default-class http-types iproute monad-logger mtl network
-    safe-exceptions transformers wai warp
+    safe-exceptions text transformers wai warp
   ];
   testHaskellDepends = [
     base data-default-class http-types iproute monad-logger mtl network
-    safe-exceptions transformers wai warp
+    safe-exceptions text transformers wai warp
   ];
   prePatch = "hpack";
   homepage = "https://github.com/MatrixAI/Haskell-Demo#readme";

package.yaml

@@ -24,6 +24,7 @@ dependencies:
 - warp
 - http-types
 - data-default-class
+- text
 
 library:
   source-dirs: src
@@ -39,6 +40,7 @@ library:
     - Lib
     - FFI
     - Demo
+    - Library
 
 executables:
   haskell-demo-ffi-exe:
@@ -59,6 +61,15 @@ executables:
     - -with-rtsopts=-N
     dependencies:
     - haskell-demo
+  haskell-demo-library-exe:
+    main:                Main.hs
+    source-dirs:         app/library
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - haskell-demo
 
 tests:
   haskell-demo-test:

src/Library.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Library where
+
+import           Control.Monad.IO.Class         ( MonadIO
+                                                , liftIO
+                                                )
+import           Control.Monad.Logger          as L
+import           Control.Monad.Logger           ( LoggingT
+                                                , MonadLogger
+                                                )
+import           Control.Monad.Reader           ( MonadReader
+                                                , ReaderT
+                                                , ask
+                                                , runReaderT
+                                                )
+import qualified Data.Text                     as T
+
+--------------------------------
+-- Library Style 1: mtl class --
+--------------------------------
+-- Main entry point via MonadLogger
+-- Expects caller of the library to supply logging capability via MonadLogger
+preFoo :: (MonadLogger m) => String -> m String
+preFoo s = $(L.logInfo) "Adding foo as prefix" >> return ("Foo " ++ s)
+
+-- Alternative entry point via IO with default logging capability
+preFooIO :: String -> IO String
+preFooIO = L.runStderrLoggingT . preFoo
+
+----------------------------------------------
+-- Library Style 2: monad transformer stack --
+----------------------------------------------
+-- Library has its own monadic context with a fully specified stack transformer.
+-- Logging capability is present in the stack as LoggingT
+newtype Bar a = Bar {unBar :: ReaderT String (LoggingT IO) a} deriving (Functor, Applicative, Monad, MonadReader String, MonadLogger)
+
+-- Library function returns operations wrapped in its monadic context
+preBar :: String -> Bar String
+preBar s = do
+  prefix <- ask
+  $(L.logInfo) $ T.pack $ "Adding " ++ prefix ++ " as prefix"
+  return $ prefix ++ " " ++ s
+
+-- Main entry point with configurable logging action
+runBarWithLogger :: (LoggingT IO a -> IO a) -> Bar a -> IO a
+runBarWithLogger runLog bar = runLog $ runReaderT (unBar bar) "Bar"
+
+-- Alternative entry point with default logging action
+runBar :: Bar a -> IO a
+runBar = runBarWithLogger runStderrLoggingT
+
+------------------------------------------------------------------
+-- Library Style 3: mixed monad transformer stack and mtl class --
+------------------------------------------------------------------
+-- Library has its own monadic context (ReaderT String here),
+-- and also allows caller to supply further contexts (capabilities).
+-- Non fully specified stack transformer. LoggingT and IO not present in the stack
+newtype FooBarT m a = FooBarT {unFooBarT :: ReaderT String m a} deriving (Functor, Applicative, Monad, MonadReader String, MonadLogger)
+
+-- Alternative/convenient type with fully specified transformer stack
+type FooBarIO = FooBarT (LoggingT IO)
+
+-- Library function returns operation wrapped in both its own monadic context
+-- and that suppied by caller
+preFooBar :: (MonadLogger m) => String -> FooBarT m String
+preFooBar s = do
+  prefix <- ask
+  $(L.logInfo) $ T.pack $ "Adding " ++ prefix ++ " as prefix"
+  return $ prefix ++ " " ++ s
+
+-- Main entry point mtl class
+-- Smart deconstructor expects caller to provide logging capability
+runFooBarT :: (MonadLogger m) => FooBarT m a -> m a
+runFooBarT fb = runReaderT (unFooBarT fb) "FooBar"
+
+-- Alternative entry point via IO with default logging capability
+runFooBarIO :: FooBarIO a -> IO a
+runFooBarIO = runStderrLoggingT . runFooBarT