diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,65 @@ +# ChangeLog for yesod + +## 1.6.2.3 + +* Support `yesod-core` 1.7 + +## 1.6.2.2 + +* Set `base >= 4.11` for less CPP and imports [#1876](https://github.com/yesodweb/yesod/pull/1876) + +## 1.6.2.1 + +* Support `template-haskell-2.19.0.0` [#1769](https://github.com/yesodweb/yesod/pull/1769) + +## 1.6.2 + +* aeson 2 + +## 1.6.1.2 + +* Fix compatibility with template-haskell 2.17 [#1730](https://github.com/yesodweb/yesod/pull/1730) + +## 1.6.1.1 + +* Allow yesod-form 1.7 + +## 1.6.1.0 + +* `widgetFileReload` and `widgetFileNoReload` now use absolute paths via the new `globFilePackage` Q Exp which can provide absolute templates paths within the project [#1691](https://github.com/yesodweb/yesod/pull/1691) + +## 1.6.0.2 + +* Replace deprecated decodeFile with decodeFileEither. This should have no semantic impact, but silences a deprecation warning. [#1658](https://github.com/yesodweb/yesod/pull/1658) + +## 1.6.0.1 + +* Remove unnecessary deriving of Typeable + +## 1.6.0 + +* Upgrade to yesod-core 1.6 + +## 1.4.5 + +* Fix warnings + +## 1.4.4 + +* Reduce dependencies + +## 1.4.3.1 + +* Handle exceptions while writing a file in `addStaticContentExternal` + +## 1.4.3 + +* Switch to `Data.Yaml.Config` + +## 1.4.2 + +* Do not parse string environment variables into numbers/booleans [#1061](https://github.com/yesodweb/yesod/issues/1061) + +## 1.4.1 + +Provide the `Yesod.Default.Config2` module, for use by newer scaffoldings. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,45 @@ +## yesod + +The yesod package groups together the various Yesod related packages into one +cohesive whole. This is the "battery loaded" version of Yesod, whereas most of +the core code lives in +[yesod-core](http://www.stackage.org/package/yesod-core/). + +For the yesod executable, see [yesod-bin](http://www.stackage.org/package/yesod-bin/). + +Yesod is [fully documented on its website](http://www.yesodweb.com/). + +## Getting Started + +Learn more about Yesod on [its main website](http://www.yesodweb.com/). If you +want to get started using Yesod, we strongly recommend the [quick start +guide](http://www.yesodweb.com/page/quickstart), based on [the Haskell build +tool stack](https://github.com/commercialhaskell/stack#readme). + +Here's a minimal example! + +```haskell +{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell, TypeFamilies #-} + +import Yesod + +data App = App -- Put your config, database connection pool, etc. in here. + +-- Derive routes and instances for App. +mkYesod "App" [parseRoutes| +/ HomeR GET +|] + +instance Yesod App -- Methods in here can be overridden as needed. + +-- The handler for the GET request at /, corresponds to HomeR. +getHomeR :: Handler Html +getHomeR = defaultLayout [whamlet|Hello World!|] + +main :: IO () +main = warp 3000 App +``` + +To read about each of the concepts in use above (routing, handlers, +linking, JSON), in detail, visit +[Basics in the Yesod book](https://www.yesodweb.com/book/basics#basics_routing). diff --git a/Yesod.hs b/Yesod.hs --- a/Yesod.hs +++ b/Yesod.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} -- | This module simply re-exports from other modules for your convenience. module Yesod ( -- * Re-exports from yesod-core diff --git a/Yesod/Default/Config.hs b/Yesod/Default/Config.hs --- a/Yesod/Default/Config.hs +++ b/Yesod/Default/Config.hs @@ -1,6 +1,8 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Yesod.Default.Config ( DefaultEnv (..) , fromArgs @@ -15,17 +17,30 @@ , withYamlEnvironment ) where -import Data.Char (toUpper, toLower) +import Data.Char (toUpper) import Data.Text (Text) import qualified Data.Text as T -import Data.Yaml +import Data.Yaml ( + Object, + Parser, + Value (..), + decodeFileEither, + parseEither, + prettyPrintParseException, + (.:) + ) import Data.Maybe (fromMaybe) -import qualified Data.HashMap.Strict as M import System.Environment (getArgs, getProgName, getEnvironment) import System.Exit (exitFailure) -import Data.Conduit.Network (HostPreference) +import Data.Streaming.Network (HostPreference) import Data.String (fromString) +#if MIN_VERSION_aeson(2, 0, 0) +import qualified Data.Aeson.KeyMap as M +#else +import qualified Data.HashMap.Strict as M +#endif + -- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and -- Production environments data DefaultEnv = Development @@ -39,9 +54,9 @@ , port :: Int } deriving Show -parseArgConfig :: (Show env, Read env, Enum env, Bounded env) => IO (ArgConfig env) +parseArgConfig :: forall env. (Show env, Read env, Enum env, Bounded env) => IO (ArgConfig env) parseArgConfig = do - let envs = [minBound..maxBound] + let envs = [minBound..maxBound] :: [env] args <- getArgs (portS, args') <- getPort id args portI <- @@ -52,10 +67,7 @@ [e] -> do case reads $ capitalize e of (e', _):_ -> return $ ArgConfig e' portI - [] -> do - () <- error $ "Invalid environment, valid entries are: " ++ show envs - -- next line just provided to force the type of envs - return $ ArgConfig (head envs) 0 + [] -> error $ "Invalid environment, valid entries are: " ++ show envs _ -> do pn <- getProgName putStrLn $ "Usage: " ++ pn ++ " [--port ]" @@ -144,7 +156,7 @@ Object obj -> return obj _ -> fail "Expected Object" let senv = show env - tenv = T.pack senv + tenv = fromString senv maybe (error $ "Could not find environment: " ++ senv) return @@ -180,8 +192,8 @@ -> IO (AppConfig environment extra) loadConfig (ConfigSettings env parseExtra getFile getObject) = do fp <- getFile env - mtopObj <- decodeFile fp - topObj <- maybe (fail "Invalid YAML file") return mtopObj + etopObj <- decodeFileEither fp + topObj <- either (const $ fail "Invalid YAML file") return etopObj obj <- getObject env topObj m <- case obj of @@ -189,7 +201,7 @@ _ -> fail "Expected map" let host = fromString $ T.unpack $ fromMaybe "*" $ lookupScalar "host" m - mport <- parseMonad (\x -> x .: "port") m + mport <- parseEitherM (\x -> x .: "port") m let approot' = fromMaybe "" $ lookupScalar "approot" m -- Handle the DISPLAY_PORT environment variable for yesod devel @@ -202,7 +214,7 @@ Nothing -> return approot' Just p -> return $ prefix `T.append` T.pack (':' : p) - extra <- parseMonad (parseExtra env) m + extra <- parseEitherM (parseExtra env) m -- set some default arguments let port' = fromMaybe 80 mport @@ -233,9 +245,14 @@ -> (Value -> Parser a) -- ^ what to do with the mapping -> IO a withYamlEnvironment fp env f = do - mval <- decodeFile fp + mval <- decodeFileEither fp case mval of - Nothing -> fail $ "Invalid YAML file: " ++ show fp - Just (Object obj) - | Just v <- M.lookup (T.pack $ show env) obj -> parseMonad f v + Left err -> + fail $ "Invalid YAML file: " ++ show fp ++ " " ++ prettyPrintParseException err + Right (Object obj) + | Just v <- M.lookup (fromString $ show env) obj -> parseEitherM f v _ -> fail $ "Could not find environment: " ++ show env + +-- | Replacement for `parseMonad` +parseEitherM :: (a -> Parser b) -> a -> IO b +parseEitherM p = either fail pure . parseEither p diff --git a/Yesod/Default/Config2.hs b/Yesod/Default/Config2.hs new file mode 100644 --- /dev/null +++ b/Yesod/Default/Config2.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Some next-gen helper functions for the scaffolding's configuration system. +module Yesod.Default.Config2 + ( -- * Locally defined + configSettingsYml + , getDevSettings + , develMainHelper + , makeYesodLogger + -- * Re-exports from Data.Yaml.Config + , applyCurrentEnv + , getCurrentEnv + , applyEnvValue + , loadYamlSettings + , loadYamlSettingsArgs + , EnvUsage + , ignoreEnv + , useEnv + , requireEnv + , useCustomEnv + , requireCustomEnv + -- * For backwards compatibility + , MergedValue (..) + , loadAppSettings + , loadAppSettingsArgs + ) where + + +import Data.Yaml.Config + +import Data.Aeson +import System.Environment (getEnvironment) +import Network.Wai (Application) +import Network.Wai.Handler.Warp +import Text.Read (readMaybe) +import Data.Maybe (fromMaybe) +import Control.Concurrent (forkIO, threadDelay) +import System.Exit (exitSuccess) +import System.Directory (doesFileExist) +import Network.Wai.Logger (clockDateCacher) +import Yesod.Core.Types (Logger (Logger)) +import System.Log.FastLogger (LoggerSet) + +#if MIN_VERSION_aeson(2, 0, 0) +import qualified Data.Aeson.KeyMap as H +#else +import qualified Data.HashMap.Strict as H +#endif + +#ifndef mingw32_HOST_OS +import System.Posix.Signals (installHandler, sigINT, Handler(Catch)) +#endif + +newtype MergedValue = MergedValue { getMergedValue :: Value } + +instance Semigroup MergedValue where + MergedValue x <> MergedValue y = MergedValue $ mergeValues x y + +-- | Left biased +mergeValues :: Value -> Value -> Value +mergeValues (Object x) (Object y) = Object $ H.unionWith mergeValues x y +mergeValues x _ = x + +-- | Load the settings from the following three sources: +-- +-- * Run time config files +-- +-- * Run time environment variables +-- +-- * The default compile time config file +loadAppSettings + :: FromJSON settings + => [FilePath] -- ^ run time config files to use, earlier files have precedence + -> [Value] -- ^ any other values to use, usually from compile time config. overridden by files + -> EnvUsage + -> IO settings +loadAppSettings = loadYamlSettings +{-# DEPRECATED loadAppSettings "Use loadYamlSettings" #-} + +-- | Same as @loadAppSettings@, but get the list of runtime config files from +-- the command line arguments. +loadAppSettingsArgs + :: FromJSON settings + => [Value] -- ^ any other values to use, usually from compile time config. overridden by files + -> EnvUsage -- ^ use environment variables + -> IO settings +loadAppSettingsArgs = loadYamlSettingsArgs +{-# DEPRECATED loadAppSettingsArgs "Use loadYamlSettingsArgs" #-} + +-- | Location of the default config file. +configSettingsYml :: FilePath +configSettingsYml = "config/settings.yml" + +-- | Helper for getApplicationDev in the scaffolding. Looks up PORT and +-- DISPLAY_PORT and prints appropriate messages. +getDevSettings :: Settings -> IO Settings +getDevSettings settings = do + env <- getEnvironment + let p = fromMaybe (getPort settings) $ lookup "PORT" env >>= readMaybe + pdisplay = fromMaybe p $ lookup "DISPLAY_PORT" env >>= readMaybe + putStrLn $ "Devel application launched: http://localhost:" ++ show pdisplay + return $ setPort p settings + +-- | Helper for develMain in the scaffolding. +develMainHelper :: IO (Settings, Application) -> IO () +develMainHelper getSettingsApp = do +#ifndef mingw32_HOST_OS + _ <- installHandler sigINT (Catch $ return ()) Nothing +#endif + + putStrLn "Starting devel application" + (settings, app) <- getSettingsApp + _ <- forkIO $ runSettings settings app + loop + where + loop :: IO () + loop = do + threadDelay 100000 + e <- doesFileExist "yesod-devel/devel-terminate" + if e then terminateDevel else loop + + terminateDevel :: IO () + terminateDevel = exitSuccess + +-- | Create a 'Logger' value (from yesod-core) out of a 'LoggerSet' (from +-- fast-logger). +makeYesodLogger :: LoggerSet -> IO Logger +makeYesodLogger loggerSet' = do + (getter, _) <- clockDateCacher + return $! Yesod.Core.Types.Logger loggerSet' getter diff --git a/Yesod/Default/Handlers.hs b/Yesod/Default/Handlers.hs --- a/Yesod/Default/Handlers.hs +++ b/Yesod/Default/Handlers.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + module Yesod.Default.Handlers ( getFaviconR , getRobotsR diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -1,15 +1,20 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + module Yesod.Default.Main ( defaultMain + , defaultMainLog , defaultRunner , defaultDevelApp + , LogFunc ) where import Yesod.Default.Config import Network.Wai (Application) import Network.Wai.Handler.Warp - (runSettings, defaultSettings, settingsPort, settingsHost) + (runSettings, defaultSettings, setPort, setHost, setOnException) +import qualified Network.Wai.Handler.Warp as Warp import System.Directory (doesDirectoryExist, removeDirectoryRecursive) import Network.Wai.Middleware.Gzip (gzip, GzipFiles (GzipCacheFolder), gzipFiles, def) import Network.Wai.Middleware.Autohead (autohead) @@ -17,7 +22,10 @@ import Control.Monad (when) import System.Environment (getEnvironment) import Data.Maybe (fromMaybe) -import Safe (readMay) +import Text.Read (readMaybe) +import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc) +import System.Log.FastLogger (LogStr, toLogStr) +import Language.Haskell.TH.Syntax (qLocation) #ifndef WINDOWS import qualified System.Posix.Signals as Signal @@ -33,19 +41,44 @@ -- > main :: IO () -- > main = defaultMain (fromArgs parseExtra) makeApplication -- -defaultMain :: (Show env, Read env) - => IO (AppConfig env extra) +defaultMain :: IO (AppConfig env extra) -> (AppConfig env extra -> IO Application) -> IO () defaultMain load getApp = do config <- load app <- getApp config - runSettings defaultSettings - { settingsPort = appPort config - , settingsHost = appHost config - } app + runSettings + ( setPort (appPort config) + $ setHost (appHost config) + $ defaultSettings + ) app --- | Run your application continously, listening for SIGINT and exiting +type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () + +-- | Same as @defaultMain@, but gets a logging function back as well as an +-- @Application@ to install Warp exception handlers. +-- +-- Since 1.2.5 +defaultMainLog :: IO (AppConfig env extra) + -> (AppConfig env extra -> IO (Application, LogFunc)) + -> IO () +defaultMainLog load getApp = do + config <- load + (app, logFunc) <- getApp config + runSettings + ( setPort (appPort config) + $ setHost (appHost config) + $ setOnException (const $ \e -> when (shouldLog' e) $ logFunc + $(qLocation >>= liftLoc) + "yesod" + LevelError + (toLogStr $ "Exception from Warp: " ++ show e)) + $ defaultSettings + ) app + where + shouldLog' = Warp.defaultShouldDisplayException + +-- | Run your application continuously, listening for SIGINT and exiting -- when received -- -- > withYourSite :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO () @@ -78,15 +111,14 @@ -- | Run your development app using a custom environment type and loader -- function defaultDevelApp - :: (Show env, Read env) - => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ + :: IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ -> (AppConfig env extra -> IO Application) -- ^ Get your @Application@ -> IO (Int, Application) defaultDevelApp load getApp = do conf <- load env <- getEnvironment - let p = fromMaybe (appPort conf) $ lookup "PORT" env >>= readMay - pdisplay = fromMaybe p $ lookup "DISPLAY_PORT" env >>= readMay + let p = fromMaybe (appPort conf) $ lookup "PORT" env >>= readMaybe + pdisplay = fromMaybe p $ lookup "DISPLAY_PORT" env >>= readMaybe putStrLn $ "Devel application launched: http://localhost:" ++ show pdisplay app <- getApp conf return (p, app) diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs --- a/Yesod/Default/Util.hs +++ b/Yesod/Default/Util.hs @@ -1,10 +1,12 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE CPP #-} + -- | Various utilities used in the scaffolded site. module Yesod.Default.Util ( addStaticContentExternal , globFile + , globFilePackage , widgetFileNoReload , widgetFileReload , TemplateLanguage (..) @@ -15,17 +17,22 @@ ) where import qualified Data.ByteString.Lazy as L +import Data.FileEmbed (makeRelativeToProject) import Data.Text (Text, pack, unpack) import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent import Control.Monad (when, unless) +import Conduit import System.Directory (doesFileExist, createDirectoryIfMissing) import Language.Haskell.TH.Syntax +#if MIN_VERSION_template_haskell(2,19,0) + hiding (makeRelativeToProject) +#endif import Text.Lucius (luciusFile, luciusFileReload) import Text.Julius (juliusFile, juliusFileReload) import Text.Cassius (cassiusFile, cassiusFileReload) import Text.Hamlet (HamletSettings, defaultHamletSettings) import Data.Maybe (catMaybes) -import Data.Default (Default (def)) +import Data.Default.Class (Default (def)) -- | An implementation of 'addStaticContent' which stores the contents in an -- external file. Files are created in the given static folder with names based @@ -39,11 +46,12 @@ -> Text -- ^ filename extension -> Text -- ^ mime type -> L.ByteString -- ^ file contents - -> HandlerT master IO (Maybe (Either Text (Route master, [(Text, Text)]))) + -> HandlerFor master (Maybe (Either Text (Route master, [(Text, Text)]))) addStaticContentExternal minify hash staticDir toRoute ext' _ content = do liftIO $ createDirectoryIfMissing True statictmp exists <- liftIO $ doesFileExist fn' - unless exists $ liftIO $ L.writeFile fn' content' + unless exists $ withSinkFileCautious fn' $ \sink -> + runConduit $ sourceLazy content' .| sink return $ Just $ Right (toRoute ["tmp", pack fn], []) where fn, statictmp, fn' :: FilePath @@ -62,6 +70,11 @@ globFile :: String -> String -> FilePath globFile kind x = "templates/" ++ x ++ "." ++ kind +-- | `globFile` but returned path is absolute and within the package the Q Exp is evaluated +-- @since 1.6.1.0 +globFilePackage :: String -> String -> Q FilePath +globFilePackage = (makeRelativeToProject <$>) . globFile + data TemplateLanguage = TemplateLanguage { tlRequiresToWidget :: Bool , tlExtension :: String @@ -102,9 +115,13 @@ , func , " on " , show file - , ", but no template were found." + , ", but no templates were found." ] +#if MIN_VERSION_template_haskell(2,17,0) + exps -> return $ DoE Nothing $ map NoBindS exps +#else exps -> return $ DoE $ map NoBindS exps +#endif where qmexps :: Q [Maybe Exp] qmexps = mapM go tls @@ -122,7 +139,7 @@ -> Bool -- ^ requires toWidget wrap -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp) warnUnlessExists shouldWarn x wrap glob f = do - let fn = globFile glob x + fn <- globFilePackage glob x e <- qRunIO $ doesFileExist fn when (shouldWarn && not e) $ qRunIO $ putStrLn $ "widget file not found: " ++ fn if e diff --git a/yesod.cabal b/yesod.cabal --- a/yesod.cabal +++ b/yesod.cabal @@ -1,54 +1,49 @@ name: yesod -version: 1.2.4 +version: 1.6.2.3 license: MIT license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: Creation of type-safe, RESTful web applications. -description: - A RESTful web framework with strong compile-time guarantees of correctness. It also affords space efficient code, highly concurrent loads, and portability to many deployment backends (via the wai package), from CGI to stand-alone serving. - . - Yesod also focuses on developer productivity. Yesod integrates well with tools for all your basic web development (wai, persistent, and shakespeare/hamlet) - . - The Yesod documentation site has much more information, including on the supporting packages mentioned above. +description: API docs and the README are available at category: Web, Yesod stability: Stable -cabal-version: >= 1.6 +cabal-version: >= 1.10 build-type: Simple homepage: http://www.yesodweb.com/ +extra-source-files: README.md ChangeLog.md library + default-language: Haskell2010 if os(windows) cpp-options: -DWINDOWS - build-depends: base >= 4.3 && < 5 - , yesod-core >= 1.2.2 && < 1.3 - , yesod-auth >= 1.2 && < 1.3 - , yesod-persistent >= 1.2 && < 1.3 - , yesod-form >= 1.3 && < 1.4 - , monad-control >= 0.3 && < 0.4 - , transformers >= 0.2.2 && < 0.4 - , wai >= 1.3 - , wai-extra >= 1.3 - , hamlet >= 1.1 && < 1.2 - , shakespeare-js >= 1.0.2 && < 1.3 - , shakespeare-css >= 1.0 && < 1.1 - , warp >= 1.3 - , blaze-html >= 0.5 - , blaze-markup >= 0.5.1 + build-depends: base >= 4.11 && < 5 , aeson - , safe - , data-default - , network-conduit - , unordered-containers - , yaml - , text + , bytestring + , conduit >= 1.3 + , data-default-class , directory + , fast-logger + , file-embed >= 0.0.10 + , monad-logger + , shakespeare + , streaming-commons , template-haskell - , bytestring + , text + , unordered-containers + , wai >= 1.3 + , wai-extra >= 1.3 + , wai-logger + , warp >= 1.3 + , yaml >= 0.8.17 + , yesod-core >= 1.6 && < 1.8 + , yesod-form >= 1.6 && < 1.8 + , yesod-persistent >= 1.6 && < 1.7 exposed-modules: Yesod , Yesod.Default.Config + , Yesod.Default.Config2 , Yesod.Default.Main , Yesod.Default.Util , Yesod.Default.Handlers