diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index 67ed22e0..9f137991 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -17,6 +17,7 @@ module Yesod.Core -- * Logging , LogLevel (..) , formatLogMessage + , fileLocationToString , logDebug , logInfo , logWarn diff --git a/yesod-core/Yesod/Internal/Core.hs b/yesod-core/Yesod/Internal/Core.hs index 67de5592..c7d26c60 100644 --- a/yesod-core/Yesod/Internal/Core.hs +++ b/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 diff --git a/yesod-core/Yesod/Logger.hs b/yesod-core/Yesod/Logger.hs index f69c9b12..3ec47f69 100644 --- a/yesod-core/Yesod/Logger.hs +++ b/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 diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 34508a8f..b94c75b8 100644 --- a/yesod-core/yesod-core.cabal +++ b/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 diff --git a/yesod/scaffold/Controller.hs.cg b/yesod/scaffold/Controller.hs.cg index d5387e4f..1fadbfd0 100644 --- a/yesod/scaffold/Controller.hs.cg +++ b/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 diff --git a/yesod/scaffold/mini/Controller.hs.cg b/yesod/scaffold/mini/Controller.hs.cg index c11477fa..111676e7 100644 --- a/yesod/scaffold/mini/Controller.hs.cg +++ b/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 diff --git a/yesod/scaffold/mini/sitearg.hs.cg b/yesod/scaffold/mini/sitearg.hs.cg index 606f867c..fb2845f0 100644 --- a/yesod/scaffold/mini/sitearg.hs.cg +++ b/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 diff --git a/yesod/scaffold/project.cabal.cg b/yesod/scaffold/project.cabal.cg index f2132953..d170bbcc 100644 --- a/yesod/scaffold/project.cabal.cg +++ b/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 diff --git a/yesod/scaffold/project.hs.cg b/yesod/scaffold/project.hs.cg index dbaae5d5..178c61de 100644 --- a/yesod/scaffold/project.hs.cg +++ b/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) diff --git a/yesod/scaffold/sitearg.hs.cg b/yesod/scaffold/sitearg.hs.cg index d0b2a221..207884f0 100644 --- a/yesod/scaffold/sitearg.hs.cg +++ b/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 diff --git a/yesod/tests/run.sh b/yesod/tests/run.sh index 93536b6d..3ae9eed9 100755 --- a/yesod/tests/run.sh +++ b/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