yesod-1.6.2.1/Yesod/0000755000000000000000000000000014306350056012255 5ustar0000000000000000yesod-1.6.2.1/Yesod/Default/0000755000000000000000000000000014306350056013641 5ustar0000000000000000yesod-1.6.2.1/Yesod.hs0000644000000000000000000000051014306350056012605 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -- | This module simply re-exports from other modules for your convenience. module Yesod ( -- * Re-exports from yesod-core module Yesod.Core , module Yesod.Form , module Yesod.Persist ) where import Yesod.Core import Yesod.Form import Yesod.Persist yesod-1.6.2.1/Yesod/Default/Config.hs0000644000000000000000000002007114306350056015402 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} module Yesod.Default.Config ( DefaultEnv (..) , fromArgs , fromArgsSettings , loadDevelopmentConfig -- reexport , AppConfig (..) , ConfigSettings (..) , configSettings , loadConfig , withYamlEnvironment ) where import Data.Char (toUpper) import Data.Text (Text) import qualified Data.Text as T import Data.Yaml import Data.Maybe (fromMaybe) import System.Environment (getArgs, getProgName, getEnvironment) import System.Exit (exitFailure) 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 | Testing | Staging | Production deriving (Read, Show, Enum, Bounded) -- | Setup commandline arguments for environment and port data ArgConfig env = ArgConfig { environment :: env , port :: Int } deriving Show parseArgConfig :: (Show env, Read env, Enum env, Bounded env) => IO (ArgConfig env) parseArgConfig = do let envs = [minBound..maxBound] args <- getArgs (portS, args') <- getPort id args portI <- case reads portS of (i, _):_ -> return i [] -> error $ "Invalid port value: " ++ show portS case args' of [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 _ -> do pn <- getProgName putStrLn $ "Usage: " ++ pn ++ " [--port ]" putStrLn $ "Valid environments: " ++ show envs exitFailure where getPort front [] = do env <- getEnvironment return (fromMaybe "0" $ lookup "PORT" env, front []) getPort front ("--port":p:rest) = return (p, front rest) getPort front ("-p":p:rest) = return (p, front rest) getPort front (arg:rest) = getPort (front . (arg:)) rest capitalize [] = [] capitalize (x:xs) = toUpper x : xs -- | Load the app config from command line parameters, using the given -- @ConfigSettings. -- -- Since 1.2.2 fromArgsSettings :: (Read env, Show env, Enum env, Bounded env) => (env -> IO (ConfigSettings env extra)) -> IO (AppConfig env extra) fromArgsSettings cs = do args <- parseArgConfig let env = environment args config <- cs env >>= loadConfig env' <- getEnvironment let config' = case lookup "APPROOT" env' of Nothing -> config Just ar -> config { appRoot = T.pack ar } return $ if port args /= 0 then config' { appPort = port args } else config' -- | Load the app config from command line parameters fromArgs :: (Read env, Show env, Enum env, Bounded env) => (env -> Object -> Parser extra) -> IO (AppConfig env extra) fromArgs getExtra = fromArgsSettings $ \env -> return (configSettings env) { csParseExtra = getExtra } -- | Load your development config (when using @'DefaultEnv'@) loadDevelopmentConfig :: IO (AppConfig DefaultEnv ()) loadDevelopmentConfig = loadConfig $ configSettings Development -- | Dynamic per-environment configuration which can be loaded at -- run-time negating the need to recompile between environments. data AppConfig environment extra = AppConfig { appEnv :: environment , appPort :: Int , appRoot :: Text , appHost :: HostPreference , appExtra :: extra } deriving (Show) data ConfigSettings environment extra = ConfigSettings { -- | An arbitrary value, used below, to indicate the current running -- environment. Usually, you will use 'DefaultEnv' for this type. csEnv :: environment -- | Load any extra data, to be used by the application. , csParseExtra :: environment -> Object -> Parser extra -- | Return the path to the YAML config file. , csFile :: environment -> IO FilePath -- | Get the sub-object (if relevant) from the given YAML source which -- contains the specific settings for the current environment. , csGetObject :: environment -> Value -> IO Value } -- | Default config settings. configSettings :: Show env => env -> ConfigSettings env () configSettings env0 = ConfigSettings { csEnv = env0 , csParseExtra = \_ _ -> return () , csFile = \_ -> return "config/settings.yml" , csGetObject = \env v -> do envs <- case v of Object obj -> return obj _ -> fail "Expected Object" let senv = show env tenv = fromString senv maybe (error $ "Could not find environment: " ++ senv) return (M.lookup tenv envs) } -- | Load an @'AppConfig'@. -- -- Some examples: -- -- > -- typical local development -- > Development: -- > host: localhost -- > port: 3000 -- > -- > -- approot: will default to "" -- -- > -- typical outward-facing production box -- > Production: -- > host: www.example.com -- > -- > -- port: will default 80 -- > -- host: will default to "*" -- > -- approot: will default "http://www.example.com" -- -- > -- maybe you're reverse proxying connections to the running app -- > -- on some other port -- > Production: -- > port: 8080 -- > approot: "http://example.com" -- > host: "localhost" loadConfig :: ConfigSettings environment extra -> IO (AppConfig environment extra) loadConfig (ConfigSettings env parseExtra getFile getObject) = do fp <- getFile env etopObj <- decodeFileEither fp topObj <- either (const $ fail "Invalid YAML file") return etopObj obj <- getObject env topObj m <- case obj of Object m -> return m _ -> fail "Expected map" let host = fromString $ T.unpack $ fromMaybe "*" $ lookupScalar "host" m mport <- parseMonad (\x -> x .: "port") m let approot' = fromMaybe "" $ lookupScalar "approot" m -- Handle the DISPLAY_PORT environment variable for yesod devel approot <- case T.stripSuffix ":3000" approot' of Nothing -> return approot' Just prefix -> do envVars <- getEnvironment case lookup "DISPLAY_PORT" envVars of Nothing -> return approot' Just p -> return $ prefix `T.append` T.pack (':' : p) extra <- parseMonad (parseExtra env) m -- set some default arguments let port' = fromMaybe 80 mport return $ AppConfig { appEnv = env , appPort = port' , appRoot = approot , appHost = host , appExtra = extra } where lookupScalar k m = case M.lookup k m of Just (String t) -> return t Just _ -> fail $ "Invalid value for: " ++ show k Nothing -> fail $ "Not found: " ++ show k -- | Loads the configuration block in the passed file named by the -- passed environment, yields to the passed function as a mapping. -- -- Errors in the case of a bad load or if your function returns -- @Nothing@. withYamlEnvironment :: Show e => FilePath -- ^ the yaml file -> e -- ^ the environment you want to load -> (Value -> Parser a) -- ^ what to do with the mapping -> IO a withYamlEnvironment fp env f = do mval <- decodeFileEither fp case mval of Left err -> fail $ "Invalid YAML file: " ++ show fp ++ " " ++ prettyPrintParseException err Right (Object obj) | Just v <- M.lookup (fromString $ show env) obj -> parseMonad f v _ -> fail $ "Could not find environment: " ++ show env yesod-1.6.2.1/Yesod/Default/Config2.hs0000644000000000000000000000776314306350056015501 0ustar0000000000000000{-# 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.Semigroup 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 yesod-1.6.2.1/Yesod/Default/Main.hs0000644000000000000000000001033314306350056015061 0ustar0000000000000000{-# 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, 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) import Network.Wai.Middleware.Jsonp (jsonp) import Control.Monad (when) import System.Environment (getEnvironment) import Data.Maybe (fromMaybe) 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 import Control.Concurrent (forkIO, killThread) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) #endif -- | Run your app, taking environment and port settings from the -- commandline. -- -- @'fromArgs'@ helps parse a custom configuration -- -- > main :: IO () -- > main = defaultMain (fromArgs parseExtra) makeApplication -- defaultMain :: IO (AppConfig env extra) -> (AppConfig env extra -> IO Application) -> IO () defaultMain load getApp = do config <- load app <- getApp config runSettings ( setPort (appPort config) $ setHost (appHost config) $ defaultSettings ) app 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 () -- > withYourSite conf logger f = do -- > Settings.withConnectionPool conf $ \p -> do -- > runConnectionPool (runMigration yourMigration) p -- > defaultRunner f $ YourSite conf logger p defaultRunner :: (Application -> IO ()) -> Application -> IO () defaultRunner f app = do -- clear the .static-cache so we don't have stale content exists <- doesDirectoryExist staticCache when exists $ removeDirectoryRecursive staticCache #ifdef WINDOWS f (middlewares app) #else tid <- forkIO $ f (middlewares app) >> return () flag <- newEmptyMVar _ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do putStrLn "Caught an interrupt" killThread tid putMVar flag ()) Nothing takeMVar flag #endif where middlewares = gzip gset . jsonp . autohead gset = def { gzipFiles = GzipCacheFolder staticCache } staticCache = ".static-cache" -- | Run your development app using a custom environment type and loader -- function defaultDevelApp :: 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 >>= readMaybe pdisplay = fromMaybe p $ lookup "DISPLAY_PORT" env >>= readMaybe putStrLn $ "Devel application launched: http://localhost:" ++ show pdisplay app <- getApp conf return (p, app) yesod-1.6.2.1/Yesod/Default/Util.hs0000644000000000000000000001322414306350056015114 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} -- | Various utilities used in the scaffolded site. module Yesod.Default.Util ( addStaticContentExternal , globFile , globFilePackage , widgetFileNoReload , widgetFileReload , TemplateLanguage (..) , defaultTemplateLanguages , WidgetFileSettings , wfsLanguages , wfsHamletSettings ) 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 hiding (makeRelativeToProject) 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.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 -- on a hash of their content. This allows expiration dates to be set far in -- the future without worry of users receiving stale content. addStaticContentExternal :: (L.ByteString -> Either a L.ByteString) -- ^ javascript minifier -> (L.ByteString -> String) -- ^ hash function to determine file name -> FilePath -- ^ location of static directory. files will be placed within a "tmp" subfolder -> ([Text] -> Route master) -- ^ route constructor, taking a list of pieces -> Text -- ^ filename extension -> Text -- ^ mime type -> L.ByteString -- ^ file contents -> 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 $ withSinkFileCautious fn' $ \sink -> runConduit $ sourceLazy content' .| sink return $ Just $ Right (toRoute ["tmp", pack fn], []) where fn, statictmp, fn' :: FilePath -- by basing the hash off of the un-minified content, we avoid a costly -- minification if the file already exists fn = hash content ++ '.' : unpack ext' statictmp = staticDir ++ "/tmp/" fn' = statictmp ++ fn content' :: L.ByteString content' | ext' == "js" = either (const content) id $ minify content | otherwise = content -- | expects a file extension for each type, e.g: hamlet lucius julius 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 , tlNoReload :: FilePath -> Q Exp , tlReload :: FilePath -> Q Exp } defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage] defaultTemplateLanguages hset = [ TemplateLanguage False "hamlet" whamletFile' whamletFile' , TemplateLanguage True "cassius" cassiusFile cassiusFileReload , TemplateLanguage True "julius" juliusFile juliusFileReload , TemplateLanguage True "lucius" luciusFile luciusFileReload ] where whamletFile' = whamletFileWithSettings hset data WidgetFileSettings = WidgetFileSettings { wfsLanguages :: HamletSettings -> [TemplateLanguage] , wfsHamletSettings :: HamletSettings } instance Default WidgetFileSettings where def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs widgetFileReload :: WidgetFileSettings -> FilePath -> Q Exp widgetFileReload wfs x = combine "widgetFileReload" x True $ wfsLanguages wfs $ wfsHamletSettings wfs combine :: String -> String -> Bool -> [TemplateLanguage] -> Q Exp combine func file isReload tls = do mexps <- qmexps case catMaybes mexps of [] -> error $ concat [ "Called " , func , " on " , show file , ", 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 go :: TemplateLanguage -> Q (Maybe Exp) go tl = whenExists file (tlRequiresToWidget tl) (tlExtension tl) ((if isReload then tlReload else tlNoReload) tl) whenExists :: String -> Bool -- ^ requires toWidget wrap -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp) whenExists = warnUnlessExists False warnUnlessExists :: Bool -> String -> Bool -- ^ requires toWidget wrap -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp) warnUnlessExists shouldWarn x wrap glob f = do fn <- globFilePackage glob x e <- qRunIO $ doesFileExist fn when (shouldWarn && not e) $ qRunIO $ putStrLn $ "widget file not found: " ++ fn if e then do ex <- f fn if wrap then do tw <- [|toWidget|] return $ Just $ tw `AppE` ex else return $ Just ex else return Nothing yesod-1.6.2.1/Yesod/Default/Handlers.hs0000644000000000000000000000050214306350056015732 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Yesod.Default.Handlers ( getFaviconR , getRobotsR ) where import Yesod.Core getFaviconR :: MonadHandler m => m () getFaviconR = sendFile "image/x-icon" "config/favicon.ico" getRobotsR :: MonadHandler m => m () getRobotsR = sendFile "text/plain" "config/robots.txt" yesod-1.6.2.1/LICENSE0000644000000000000000000000207514306350056012203 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. yesod-1.6.2.1/Setup.lhs0000755000000000000000000000016214306350056013004 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain yesod-1.6.2.1/yesod.cabal0000644000000000000000000000375614306350056013314 0ustar0000000000000000name: yesod version: 1.6.2.1 license: MIT license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: Creation of type-safe, RESTful web applications. description: API docs and the README are available at category: Web, Yesod stability: Stable 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.10 && < 5 , aeson , bytestring , conduit >= 1.3 , data-default-class , directory , fast-logger , file-embed , monad-logger , shakespeare , streaming-commons , template-haskell , text , unordered-containers , wai >= 1.3 , wai-extra >= 1.3 , wai-logger , warp >= 1.3 , yaml >= 0.8.17 , yesod-core >= 1.6 && < 1.7 , 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 ghc-options: -Wall if !os(windows) build-depends: unix source-repository head type: git location: https://github.com/yesodweb/yesod yesod-1.6.2.1/README.md0000644000000000000000000000264214306350056012455 0ustar0000000000000000## 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). yesod-1.6.2.1/ChangeLog.md0000644000000000000000000000230514306350056013343 0ustar0000000000000000# ChangeLog for yesod ## 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.