From 1b45afad5585950ee866b3209fd0eba33087edef Mon Sep 17 00:00:00 2001 From: Chris Dornan Date: Sun, 16 Jun 2019 17:14:11 +0100 Subject: [PATCH 1/2] replace ClassyPrelude with RIO in simple --- package.yaml | 10 +++++++--- src/Import/NoFoundation.hs | 24 +++++++++++++++++------- src/RIO/Yesod.hs | 20 ++++++++++++++++++++ src/Settings.hs | 11 ++++++++--- test/TestImport.hs | 2 +- 5 files changed, 53 insertions(+), 14 deletions(-) create mode 100644 src/RIO/Yesod.hs diff --git a/package.yaml b/package.yaml index 48a26a9..5e3ae04 100644 --- a/package.yaml +++ b/package.yaml @@ -4,13 +4,17 @@ version: "0.0.0" dependencies: - base >=4.9.1.0 && <5 + - yesod >=1.6 && <1.7 - yesod-core >=1.6 && <1.7 - yesod-static >=1.6 && <1.7 - yesod-form >=1.6 && <1.7 -- classy-prelude >=1.5 && <1.6 -- classy-prelude-conduit >=1.5 && <1.6 -- classy-prelude-yesod >=1.5 && <1.6 + +- rio >= 0.1.8.0 +- http-types +- persistent +- yesod-newsfeed + - bytestring >=0.10 && <0.11 - text >=0.11 && <2.0 - template-haskell diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs index 6c10493..c1a22ac 100644 --- a/src/Import/NoFoundation.hs +++ b/src/Import/NoFoundation.hs @@ -1,10 +1,20 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} + module Import.NoFoundation - ( module Import + ( module X ) where -import ClassyPrelude.Yesod as Import -import Settings as Import -import Settings.StaticFiles as Import -import Yesod.Core.Types as Import (loggerSet) -import Yesod.Default.Config2 as Import +import RIO.Yesod as X +import Data.Default as X (Default (..)) +import Database.Persist.Sql as X (runMigration) +import Database.Persist.Sql as X (SqlBackend, SqlPersistT) +import Network.HTTP.Client.Conduit as X hiding (Proxy(..)) +import Network.HTTP.Types as X +import Settings as X +import Settings.StaticFiles as X +import Yesod as X hiding (Header, parseTime) +import Yesod.Core.Types as X (loggerSet) +import Yesod.Default.Config2 as X +import Yesod.Feed as X +import Yesod.Static as X diff --git a/src/RIO/Yesod.hs b/src/RIO/Yesod.hs new file mode 100644 index 0000000..2026466 --- /dev/null +++ b/src/RIO/Yesod.hs @@ -0,0 +1,20 @@ +module RIO.Yesod + ( module RIO + ) where + +import RIO + hiding + ( Handler(..) + , LogLevel(..) + , LogSource + , logDebug + , logDebugS + , logError + , logErrorS + , logInfo + , logInfoS + , logOther + , logOtherS + , logWarn + , logWarnS + ) diff --git a/src/Settings.hs b/src/Settings.hs index 43e3253..80c9d9e 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -10,10 +10,11 @@ -- declared in the Foundation.hs file. module Settings where -import ClassyPrelude.Yesod +import RIO.Yesod import qualified Control.Exception as Exception -import Data.Aeson (Result (..), fromJSON, withObject, (.!=), - (.:?)) +import Data.Aeson (Result (..), FromJSON(..), fromJSON, + withObject,(.:),(.!=),(.:?),Value(..)) +import Data.Default (def) import Data.FileEmbed (embedFile) import Data.Yaml (decodeEither') import Language.Haskell.TH.Syntax (Exp, Name, Q) @@ -21,6 +22,10 @@ import Network.Wai.Handler.Warp (HostPreference) import Yesod.Default.Config2 (applyEnvValue, configSettingsYml) import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload, widgetFileReload) +import Yesod.Core.Types (Route) +import Yesod.Static (CombineSettings,combineScripts', + combineStylesheets', Static) + -- | Runtime settings to configure this application. These settings can be -- loaded from various sources: defaults, environment variables, config files, diff --git a/test/TestImport.hs b/test/TestImport.hs index 91dd7db..d862120 100644 --- a/test/TestImport.hs +++ b/test/TestImport.hs @@ -7,7 +7,7 @@ module TestImport ) where import Application (makeFoundation, makeLogWare) -import ClassyPrelude as X hiding (Handler) +import RIO as X hiding (Handler) import Foundation as X import Test.Hspec as X import Yesod.Default.Config2 (useEnv, loadYamlSettings) From eba19dcf7ac3e8ea529d0c47813ae9e8bf8eb038 Mon Sep 17 00:00:00 2001 From: Chris Dornan Date: Fri, 28 Jun 2019 20:40:19 +0100 Subject: [PATCH 2/2] Add RIO logging to Foundation and runRIOinHandler It looks to me as if this template will have to be strictly for early adopters until the deeper conversion of Yesod to RIO has been completed. All the differences are superficial but it looks like there are more than enough of them to confuse without a special guide for the unwary. The major issue is that the handler is just not a RIO so application developers are going to have to apply converters to their RIO based handlers to insert them into Yesod 1.6. The converter I have constructed here is based on the one I have written for my own application is based merely on the `App` foundation, but it should probably be based on `HandlerData`, to give us the (projected) Yesod 1.7 handlers. (I am happy to do this in the next patch if @snoyberg agrees -- I would expect it to be a straightforward generalisation.) The other immediate issue is that, AFAICS, the RIO loggers and monad-logger loggers are incompatible, so the Yesod porcelain will continue to use the latter while RIO handlers would use the former. (Which works for me, but might come across as clunky for others.) --- .gitignore | 1 + src/Application.hs | 62 +++++++++++++++++++++++++++----------- src/Foundation.hs | 11 ++++++- src/Import/NoFoundation.hs | 17 ++++++++++- src/RIO/Yesod.hs | 24 +++++++-------- 5 files changed, 83 insertions(+), 32 deletions(-) diff --git a/.gitignore b/.gitignore index 7e244c0..521e581 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +/stack.yaml dist* static/tmp/ static/combined/ diff --git a/src/Application.hs b/src/Application.hs index 86d719a..9dd3fc0 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -20,7 +20,7 @@ module Application ) where import Control.Monad.Logger (liftLoc) -import Import +import Import hiding (LevelError) import Language.Haskell.TH.Syntax (qLocation) import Network.HTTP.Client.TLS (getGlobalManager) import Network.Wai (Middleware) @@ -34,6 +34,7 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger), mkRequestLogger, outputFormat) import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr) +import Yesod (LogLevel(LevelError)) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -50,8 +51,8 @@ mkYesodDispatch "App" resourcesApp -- performs initialization and returns a foundation datatype value. This is also -- the place to put your migrate statements to have automatic database -- migrations handled by Yesod. -makeFoundation :: AppSettings -> IO App -makeFoundation appSettings = do +makeFoundation :: AppSettings -> LogFunc -> IO App +makeFoundation appSettings appLogFunc = do -- Some basic initializations: HTTP connection manager, logger, and static -- subsite. appHttpManager <- getGlobalManager @@ -105,10 +106,11 @@ warpSettings foundation = getApplicationDev :: IO (Settings, Application) getApplicationDev = do settings <- getAppSettings - foundation <- makeFoundation settings - wsettings <- getDevSettings $ warpSettings foundation - app <- makeApplication foundation - return (wsettings, app) + crLogFunc settings $ \logFunc -> do + foundation <- makeFoundation settings logFunc + wsettings <- getDevSettings $ warpSettings foundation + app <- makeApplication foundation + return (wsettings, app) getAppSettings :: IO AppSettings getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv @@ -128,26 +130,29 @@ appMain = do -- allow environment variables to override useEnv - -- Generate the foundation from the settings - foundation <- makeFoundation settings + crLogFunc settings $ \logFunc -> do + -- Generate the foundation from the settings + foundation <- makeFoundation settings logFunc - -- Generate a WAI Application from the foundation - app <- makeApplication foundation + -- Generate a WAI Application from the foundation + app <- makeApplication foundation - -- Run the application with Warp - runSettings (warpSettings foundation) app + -- Run the application with Warp + runSettings (warpSettings foundation) app -------------------------------------------------------------- -- Functions for DevelMain.hs (a way to run the app from GHCi) -------------------------------------------------------------- + getApplicationRepl :: IO (Int, App, Application) getApplicationRepl = do settings <- getAppSettings - foundation <- makeFoundation settings - wsettings <- getDevSettings $ warpSettings foundation - app1 <- makeApplication foundation - return (getPort wsettings, foundation, app1) + crLogFunc settings $ \logFunc -> do + foundation <- makeFoundation settings logFunc + wsettings <- getDevSettings $ warpSettings foundation + app1 <- makeApplication foundation + return (getPort wsettings, foundation, app1) shutdownApp :: App -> IO () shutdownApp _ = return () @@ -159,4 +164,25 @@ shutdownApp _ = return () -- | Run a handler handler :: Handler a -> IO a -handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h +handler h = do + settings <- getAppSettings + crLogFunc settings $ \logFunc -> do + makeFoundation settings logFunc >>= flip unsafeHandler h + + +--------------------------------------------- +-- RIO logFunc wrapper +--------------------------------------------- + +crLogFunc :: AppSettings -> (LogFunc -> IO a) -> IO a +crLogFunc appSettings cb = do + lo <- opts <$> logOptionsHandle stdout is_logging + withLogFunc lo cb + where + opts = + setLogVerboseFormat is_detailed + . setLogUseTime is_detailed + . setLogUseLoc is_detailed + + is_logging = True + is_detailed = appDetailedRequestLogging appSettings diff --git a/src/Foundation.hs b/src/Foundation.hs index 61ac2ed..51c0268 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -8,16 +8,24 @@ module Foundation where -import Import.NoFoundation +import Import.NoFoundation hiding (LogSource,LogLevel(..)) import Control.Monad.Logger (LogSource) import Text.Hamlet (hamletFile) import Text.Jasmine (minifym) +import Yesod (LogLevel(..)) import Yesod.Core.Types (Logger) import Yesod.Default.Util (addStaticContentExternal) import qualified Yesod.Core.Unsafe as Unsafe import qualified Data.CaseInsensitive as CI import qualified Data.Text.Encoding as TE + +-- | run a 'RIO' function from a 'MondHandler' context +runRIOinHandler :: (MonadHandler m, HandlerSite m ~ App) => RIO App a -> m a +runRIOinHandler rio = do + a <- getYesod + liftIO $ runRIO a rio + -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application -- starts running, such as database connections. Every handler will have @@ -27,6 +35,7 @@ data App = App , appStatic :: Static -- ^ Settings for static file serving. , appHttpManager :: Manager , appLogger :: Logger + , appLogFunc :: LogFunc } data MenuItem = MenuItem diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs index c1a22ac..84e2e92 100644 --- a/src/Import/NoFoundation.hs +++ b/src/Import/NoFoundation.hs @@ -13,7 +13,22 @@ import Network.HTTP.Client.Conduit as X hiding (Proxy(..)) import Network.HTTP.Types as X import Settings as X import Settings.StaticFiles as X -import Yesod as X hiding (Header, parseTime) +import Yesod as X + hiding + ( Header + , parseTime + , LogLevel(..) + , logDebug + , logDebugS + , logError + , logErrorS + , logInfo + , logInfoS + , logOther + , logOtherS + , logWarn + , logWarnS + ) import Yesod.Core.Types as X (loggerSet) import Yesod.Default.Config2 as X import Yesod.Feed as X diff --git a/src/RIO/Yesod.hs b/src/RIO/Yesod.hs index 2026466..215e5d0 100644 --- a/src/RIO/Yesod.hs +++ b/src/RIO/Yesod.hs @@ -5,16 +5,16 @@ module RIO.Yesod import RIO hiding ( Handler(..) - , LogLevel(..) - , LogSource - , logDebug - , logDebugS - , logError - , logErrorS - , logInfo - , logInfoS - , logOther - , logOtherS - , logWarn - , logWarnS + -- , LogLevel(..) + -- , LogSource + -- , logDebug + -- , logDebugS + -- , logError + -- , logErrorS + -- , logInfo + -- , logInfoS + -- , logOther + -- , logOtherS + -- , logWarn + -- , logWarnS )