add Logger to scaffolding

yesod-core/Yesod/Core.hs

@@ -17,6 +17,7 @@ module Yesod.Core
       -- * Logging
     , LogLevel (..)
     , formatLogMessage
+    , fileLocationToString
     , logDebug
     , logInfo
     , logWarn

yesod-core/Yesod/Internal/Core.hs

@@ -23,6 +23,7 @@ module Yesod.Internal.Core
       -- * Logging
     , LogLevel (..)
     , formatLogMessage
+    , fileLocationToString
     , messageLoggerHandler
       -- * Misc
     , yesodVersion
@@ -71,7 +72,6 @@ import Data.List (foldl')
 import qualified Network.HTTP.Types as H
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.IO
-import qualified System.IO
 import qualified Data.Text.Lazy.Builder as TB
 import Language.Haskell.TH.Syntax (Loc (..), Lift (..))
 import Text.Blaze (preEscapedLazyText)
@@ -257,7 +257,7 @@ class RenderRoute (Route a) => Yesod a where
                   -> IO ()
     messageLogger _ loc level msg =
         formatLogMessage loc level msg >>=
-        Data.Text.Lazy.IO.hPutStrLn System.IO.stderr
+        Data.Text.Lazy.IO.putStrLn
 
 messageLoggerHandler :: (Yesod m, MonadIO mo)
                      => Loc -> LogLevel -> Text -> GGHandler s m mo ()
@@ -283,14 +283,23 @@ formatLogMessage loc level msg = do
     now <- getCurrentTime
     return $ TB.toLazyText $
         TB.fromText (TS.pack $ show now)
-        `mappend` TB.fromText ": "
-        `mappend` TB.fromText (TS.pack $ show level)
-        `mappend` TB.fromText "@("
-        `mappend` TB.fromText (TS.pack $ loc_filename loc)
-        `mappend` TB.fromText ":"
-        `mappend` TB.fromText (TS.pack $ show $ fst $ loc_start loc)
-        `mappend` TB.fromText ") "
+        `mappend` TB.fromText " ["
+        `mappend` TB.fromText (TS.pack $ drop 5 $ show level)
+        `mappend` TB.fromText "] "
         `mappend` TB.fromText msg
+        `mappend` TB.fromText " @("
+        `mappend` TB.fromText (TS.pack $ fileLocationToString loc)
+        `mappend` TB.fromText ") "
+
+-- taken from file-location package
+-- turn the TH Loc loaction information into a human readable string
+-- leaving out the loc_end parameter
+fileLocationToString :: Loc -> String
+fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++  
+  ' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc)
+  where
+    line = show . fst . loc_start
+    char = show . snd . loc_start
 
 defaultYesodRunner :: Yesod master
                    => a

yesod-core/Yesod/Logger.hs

@@ -9,21 +9,26 @@ module Yesod.Logger
     , makeLogger
     , flushLogger
     , timed
+    , logText
+    , logLazyText
+    , logString
     ) where
 
 import Control.Monad (forever)
-import Control.Monad.Trans (MonadIO, liftIO)
+import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Applicative ((<$>), (<*>))
 import Control.Concurrent (forkIO)
 import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan)
 import Control.Concurrent.MVar.Strict (MVar, newEmptyMVar, takeMVar, putMVar)
 import Text.Printf (printf)
-
+import Data.Text
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO
 import Data.Time (getCurrentTime, diffUTCTime)
 
 data Logger = Logger
-    { loggerChan :: Chan (Maybe String)  -- Nothing marks the end
-    , loggerSync :: MVar ()              -- Used for sync on quit
+    { loggerChan :: Chan (Maybe TL.Text)  -- Nothing marks the end
+    , loggerSync :: MVar ()               -- Used for sync on quit
     }
 
 makeLogger :: IO Logger
@@ -38,7 +43,7 @@ makeLogger = do
             -- Stop: sync
             Nothing -> putMVar (loggerSync logger) ()
             -- Print and continue
-            Just m  -> putStrLn m
+            Just m  -> Data.Text.Lazy.IO.putStrLn m
 
 -- | Flush the logger (blocks until flushed)
 --
@@ -49,15 +54,21 @@ flushLogger logger = do
     return ()
 
 -- | Send a raw message to the logger
---
-message :: Logger -> String -> IO ()
-message logger = writeChan (loggerChan logger) . Just
+--   Native format is lazy text
+logLazyText :: Logger -> TL.Text -> IO ()
+logLazyText logger = writeChan (loggerChan logger) . Just
+
+logText :: Logger -> Text -> IO ()
+logText logger = logLazyText logger . TL.fromStrict
+
+logString :: Logger -> String -> IO ()
+logString logger = logLazyText logger . TL.pack
 
 -- | Execute a monadic action and log the duration
 --
 timed :: MonadIO m
       => Logger  -- ^ Logger
-      -> String  -- ^ Message
+      -> Text  -- ^ Message
       -> m a     -- ^ Action
       -> m a     -- ^ Timed and logged action
 timed logger msg action = do
@@ -66,6 +77,6 @@ timed logger msg action = do
     stop <- liftIO getCurrentTime
     let diff = fromEnum $ diffUTCTime stop start
         ms = diff `div` 10 ^ (9 :: Int)
-        formatted = printf "  [%4dms] %s" ms msg
-    liftIO $ message logger formatted
+        formatted = printf "  [%4dms] %s" ms (unpack msg)
+    liftIO $ logString logger formatted
     return result

yesod-core/yesod-core.cabal

@@ -51,10 +51,14 @@ library
                    , case-insensitive          >= 0.2      && < 0.4
                    , parsec                    >= 2        && < 3.2
                    , directory                 >= 1        && < 1.2
+                   -- for logger. Probably logger should be a separate package
+                   , strict-concurrency        >= 0.2.4    && < 0.2.5
+
     exposed-modules: Yesod.Content
                      Yesod.Core
                      Yesod.Dispatch
                      Yesod.Handler
+                     Yesod.Logger
                      Yesod.Request
                      Yesod.Widget
                      Yesod.Message

yesod/scaffold/Controller.hs.cg

@@ -1,6 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Controller
     ( with~sitearg~
@@ -11,6 +12,7 @@ import ~sitearg~
 import Settings
 import Yesod.Static
 import Yesod.Auth
+import Yesod.Logger (makeLogger, flushLogger, Logger)
 import Database.Persist.GenericSql
 import Data.ByteString (ByteString)
 import Data.Dynamic (Dynamic, toDyn)
@@ -35,11 +37,11 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
 -- performs initialization and creates a WAI application. This is also the
 -- place to put your migrate statements to have automatic database
 -- migrations handled by Yesod.
-with~sitearg~ :: AppConfig -> (Application -> IO a) -> IO a
-with~sitearg~ conf f = do
+with~sitearg~ :: AppConfig -> Logger -> (Application -> IO a) -> IO a
+with~sitearg~ conf logger f = do
   Settings.withConnectionPool conf $ \p -> do
     runConnectionPool (runMigration migrateAll) p
-    let h = ~sitearg~ conf s p
+    let h = ~sitearg~ conf logger s p
     toWaiApp h >>= f
   where
     s = static Settings.staticDir
@@ -47,7 +49,10 @@ with~sitearg~ conf f = do
 with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a
 with~sitearg~LoadConfig env f = do
   conf <- Settings.loadConfig env
-  with~sitearg~ conf f
+  logger <- makeLogger
+  r <- with~sitearg~ conf logger f
+  flushLogger logger
+  return r
 
 -- for yesod devel
 withDevelApp :: Dynamic

yesod/scaffold/mini/Controller.hs.cg

@@ -10,6 +10,7 @@ module Controller
 import ~sitearg~
 import Settings
 import Yesod.Static
+import Yesod.Logger (makeLogger, flushLogger, Logger)
 import Data.ByteString (ByteString)
 import Network.Wai (Application)
 import Data.Dynamic (Dynamic, toDyn)
@@ -34,9 +35,9 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
 -- performs initialization and creates a WAI application. This is also the
 -- place to put your migrate statements to have automatic database
 -- migrations handled by Yesod.
-with~sitearg~ :: AppConfig -> (Application -> IO a) -> IO a
-with~sitearg~ conf f = do
-    let h = ~sitearg~ conf s
+with~sitearg~ :: AppConfig -> Logger -> (Application -> IO a) -> IO a
+with~sitearg~ conf logger f = do
+    let h = ~sitearg~ conf logger s
     toWaiApp h >>= f
   where
     s = static Settings.staticDir
@@ -44,7 +45,11 @@ with~sitearg~ conf f = do
 with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a
 with~sitearg~LoadConfig env f = do
   conf <- Settings.loadConfig env
-  with~sitearg~ conf f
+  logger <- makeLogger
+  r <- with~sitearg~ conf logger f
+  flushLogger logger
+  return r
+
 
 withDevelApp :: Dynamic
 withDevelApp = do

yesod/scaffold/mini/sitearg.hs.cg

@@ -15,6 +15,7 @@ module ~sitearg~
 
 import Yesod.Core
 import Yesod.Static
+import Yesod.Logger (Logger, logLazyText)
 import qualified Settings
 import System.Directory
 import qualified Data.ByteString.Lazy as L
@@ -32,6 +33,7 @@ import Web.ClientSession (getKey)
 -- access to the data present here.
 data ~sitearg~ = ~sitearg~
     { settings :: Settings.AppConfig
+    , getLogger :: Logger
     , getStatic :: Static -- ^ Settings for static file serving.
     }
 
@@ -85,6 +87,9 @@ instance Yesod ~sitearg~ where
         Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s
     urlRenderOverride _ _ = Nothing
 
+    messageLogger y loc level msg =
+      formatLogMessage loc level msg >>= logLazyText (getLogger y)
+
     -- This function creates static content files in the static folder
     -- and names them based on a hash of their content. This allows
     -- expiration dates to be set far in the future without worry of

yesod/scaffold/project.cabal.cg

@@ -43,11 +43,15 @@ executable         ~project~
     else
         ghc-options:   -Wall -threaded
 
+    if os(windows)
+        cpp-options: -DWINDOWS
+
     main-is:       main.hs
     hs-source-dirs: ., config
 
     build-depends: base         >= 4       && < 5
                  , yesod        >= 0.9     && < 0.10
+                 , yesod-core
                  , yesod-auth
                  , yesod-static
                  , blaze-html

yesod/scaffold/project.hs.cg

@@ -5,15 +5,15 @@ import Controller (with~sitearg~)
 import Network.Wai.Handler.Warp (run)
 import System.Console.CmdArgs hiding (args)
 import Data.Char (toUpper, toLower)
+import Yesod.Logger (logString, logLazyText, flushLogger, makeLogger)
 
-#if PRODUCTION
-#else
-import System.IO (hPutStrLn, stderr)
-import Network.Wai.Middleware.Debug (debug)
+#ifndef PRODUCTION
+import Network.Wai.Middleware.Debug (debugHandle)
 #endif
 
 main :: IO ()
 main = do
+    logger <- makeLogger
     args <- cmdArgs argConfig
     env <- getAppEnv args
     config <- Settings.loadConfig env
@@ -21,9 +21,12 @@ main = do
 #if PRODUCTION
     with~sitearg~ c $ run (appPort c)
 #else
-    hPutStrLn stderr $ (show env) ++ " application launched, listening on port " ++ show (appPort c)
-    with~sitearg~ c $ run (appPort c) . debug
+    logString logger $ (show env) ++ " application launched, listening on port " ++ show (appPort c)
+    with~sitearg~ c logger $ run (appPort c) . debugHandle (logHandle logger)
+    flushLogger logger
 #endif
+  where
+    logHandle logger msg = logLazyText logger msg >> flushLogger logger
 
 data ArgConfig = ArgConfig {environment :: String, port :: Int}
                  deriving (Show, Data, Typeable)

yesod/scaffold/sitearg.hs.cg

@@ -20,6 +20,7 @@ import Yesod.Static
 import Yesod.Auth
 import Yesod.Auth.OpenId
 import Yesod.Auth.Email
+import Yesod.Logger (Logger, logLazyText)
 import qualified Settings
 import System.Directory
 import qualified Data.ByteString.Lazy as L
@@ -43,6 +44,7 @@ import Text.Hamlet (html)
 -- access to the data present here.
 data ~sitearg~ = ~sitearg~
     { settings :: Settings.AppConfig
+    , getLogger :: Logger
     , getStatic :: Static -- ^ Settings for static file serving.
     , connPool :: Settings.ConnectionPool -- ^ Database connection pool.
     }
@@ -100,6 +102,9 @@ instance Yesod ~sitearg~ where
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
 
+    messageLogger y loc level msg =
+      formatLogMessage loc level msg >>= logLazyText (getLogger y)
+
     -- This function creates static content files in the static folder
     -- and names them based on a hash of their content. This allows
     -- expiration dates to be set far in the future without worry of
@@ -119,6 +124,7 @@ instance Yesod ~sitearg~ where
         unless exists $ liftIO $ L.writeFile fn' content'
         return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])
 
+
 -- How to run database actions.
 instance YesodPersist ~sitearg~ where
     type YesodDB ~sitearg~ = SqlPersist

yesod/tests/run.sh

@@ -11,7 +11,7 @@ cabal clean && cabal install && cabal sdist
 for f in $(ls -1rt dist/*.tar.gz | tail -1)
 do
   tar -xzvf $f && cd `basename $f .tar.gz`
-  shelltest ../tests/scaffold.shelltest $@
+  shelltest ../tests/scaffold.shelltest -c $@
   cd ..
   rm -r `basename $f .tar.gz`
 done