yesod-default 1.1.3.2 → 1.2.0
raw patch · 6 files changed
+6/−507 lines, 6 filesdep −bytestringdep −data-defaultdep −directorydep ~yesod-core
Dependencies removed: bytestring, data-default, directory, hamlet, network-conduit, safe, shakespeare-css, shakespeare-js, template-haskell, text, transformers, unix, unordered-containers, wai, wai-extra, warp, yaml
Dependency ranges changed: yesod-core
Files
- Yesod/Default/Config.hs +0/−232
- Yesod/Default/Handlers.hs +0/−14
- Yesod/Default/Ignore.hs +1/−0
- Yesod/Default/Main.hs +0/−92
- Yesod/Default/Util.hs +0/−137
- yesod-default.cabal +5/−32
− Yesod/Default/Config.hs
@@ -1,232 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternGuards #-}-module Yesod.Default.Config- ( DefaultEnv (..)- , fromArgs- , loadDevelopmentConfig-- -- reexport- , AppConfig (..)- , ConfigSettings (..)- , configSettings- , loadConfig- , withYamlEnvironment- ) where--import Data.Char (toUpper, toLower)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Yaml-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.String (fromString)---- | 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 ++ " <environment> [--port <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 : map toLower xs---- | 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 = do- args <- parseArgConfig-- let env = environment args-- let cs = (configSettings env)- { csParseExtra = getExtra- }- config <- loadConfig cs-- 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 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 = T.pack 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- mtopObj <- decodeFile fp- topObj <- maybe (fail "Invalid YAML file") return mtopObj- 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, yeilds 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 <- decodeFile 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- _ -> fail $ "Could not find environment: " ++ show env
− Yesod/Default/Handlers.hs
@@ -1,14 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Yesod.Default.Handlers- ( getFaviconR- , getRobotsR- ) where--import Yesod.Handler (GHandler, sendFile)-import Yesod.Content (RepPlain(..))--getFaviconR :: GHandler s m ()-getFaviconR = sendFile "image/x-icon" "config/favicon.ico"--getRobotsR :: GHandler s m RepPlain-getRobotsR = sendFile "text/plain" "config/robots.txt"
+ Yesod/Default/Ignore.hs view
@@ -0,0 +1,1 @@+module Yesod.Default.Ignore () where
− Yesod/Default/Main.hs
@@ -1,92 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-module Yesod.Default.Main- ( defaultMain- , defaultRunner- , defaultDevelApp- ) where--import Yesod.Default.Config-import Network.Wai (Application)-import Network.Wai.Handler.Warp- (runSettings, defaultSettings, settingsPort, settingsHost)-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 Safe (readMay)--#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 :: (Show env, Read env)- => 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---- | Run your application continously, 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- :: (Show env, Read env)- => 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- putStrLn $ "Devel application launched: http://localhost:" ++ show pdisplay- app <- getApp conf- return (p, app)
− Yesod/Default/Util.hs
@@ -1,137 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE CPP #-}--- | Various utilities used in the scaffolded site.-module Yesod.Default.Util- ( addStaticContentExternal- , globFile- , widgetFileNoReload- , widgetFileReload- , TemplateLanguage (..)- , defaultTemplateLanguages- , WidgetFileSettings- , wfsLanguages- , wfsHamletSettings- ) where--import Control.Monad.IO.Class (liftIO)-import qualified Data.ByteString.Lazy as L-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 System.Directory (doesFileExist, createDirectoryIfMissing)-import Language.Haskell.TH.Syntax-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))---- | 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- -> GHandler sub 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'- 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--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 template were found."- ]- exps -> return $ DoE $ map NoBindS exps- 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- let fn = globFile 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-default.cabal view
@@ -1,50 +1,23 @@ name: yesod-default-version: 1.1.3.2+version: 1.2.0 license: MIT license-file: LICENSE author: Patrick Brisbin maintainer: Patrick Brisbin <pbrisbin@gmail.com>-synopsis: Default config and main functions for your yesod application+synopsis: Default config and main functions for your yesod application (deprecated) category: Web, Yesod stability: Stable cabal-version: >= 1.6 build-type: Simple homepage: http://www.yesodweb.com/-description: Convenient wrappers for your the configuration and+description: Since version 1.2 of Yesod, this functionality is provided by the yesod package. This package is no longer needed. execution of your yesod application library- if os(windows)- cpp-options: -DWINDOWS- build-depends: base >= 4 && < 5- , yesod-core >= 1.1 && < 1.2- , warp >= 1.3 && < 1.4- , wai >= 1.3 && < 1.5- , wai-extra >= 1.3 && < 1.4- , bytestring >= 0.9.1.4- , transformers >= 0.2.2 && < 0.4- , text >= 0.9- , directory >= 1.0- , shakespeare-css >= 1.0 && < 1.1- , shakespeare-js >= 1.0 && < 1.2- , template-haskell- , yaml >= 0.8 && < 0.9- , network-conduit >= 0.5- , unordered-containers- , hamlet >= 1.1 && < 1.2- , data-default- , safe-- if !os(windows)- build-depends: unix-- exposed-modules: Yesod.Default.Config- , Yesod.Default.Main- , Yesod.Default.Util- , Yesod.Default.Handlers+ , yesod-core >= 1.2 - ghc-options: -Wall+ exposed-modules: Yesod.Default.Ignore source-repository head type: git