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/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/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 6c10493..84e2e92 100644 --- a/src/Import/NoFoundation.hs +++ b/src/Import/NoFoundation.hs @@ -1,10 +1,35 @@ -{-# 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 + , 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 +import Yesod.Static as X diff --git a/src/RIO/Yesod.hs b/src/RIO/Yesod.hs new file mode 100644 index 0000000..215e5d0 --- /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)