yesod-default 0.6.1 → 1.0.0
raw patch · 4 files changed
+85/−66 lines, 4 filesdep +network-conduitdep ~shakespeare-cssdep ~shakespeare-jsdep ~transformers
Dependencies added: network-conduit
Dependency ranges changed: shakespeare-css, shakespeare-js, transformers, wai, wai-extra, warp, yaml, yesod-core
Files
- Yesod/Default/Config.hs +10/−28
- Yesod/Default/Main.hs +6/−10
- Yesod/Default/Util.hs +57/−17
- yesod-default.cabal +12/−11
Yesod/Default/Config.hs view
@@ -22,6 +22,8 @@ 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@@ -97,6 +99,7 @@ { appEnv :: environment , appPort :: Int , appRoot :: Text+ , appHost :: HostPreference , appExtra :: extra } deriving (Show) @@ -142,15 +145,14 @@ -- > host: localhost -- > port: 3000 -- >--- > -- ssl: will default false--- > -- approot: will default to "http://localhost:3000"+-- > -- approot: will default to "" -- -- > -- typical outward-facing production box -- > Production: -- > host: www.example.com -- >--- > -- ssl: will default false -- > -- 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@@ -158,10 +160,7 @@ -- > Production: -- > port: 8080 -- > approot: "http://example.com"--- >--- > -- approot is specified so that the non-80 port is not appended--- > -- automatically.---+-- > host: "localhost" loadConfig :: ConfigSettings environment extra -> IO (AppConfig environment extra) loadConfig (ConfigSettings env parseExtra getFile getObject) = do@@ -174,30 +173,20 @@ Object m -> return m _ -> fail "Expected map" - let mssl = lookupScalar "ssl" m- let mhost = lookupScalar "host" m+ let host = fromString $ T.unpack $ fromMaybe "*" $ lookupScalar "host" m mport <- parseMonad (\x -> x .: "port") m- let mapproot = lookupScalar "approot" m+ let approot = fromMaybe "" $ lookupScalar "approot" m extra <- parseMonad (parseExtra env) m -- set some default arguments- let ssl = maybe False toBool mssl- let port' = fromMaybe (if ssl then 443 else 80) mport-- approot <- case (mhost, mapproot) of- (_ , Just ar) -> return ar- (Just host, _ ) -> return $ T.concat- [ if ssl then "https://" else "http://"- , host- , addPort ssl port'- ]- _ -> fail "You must supply either a host or approot"+ let port' = fromMaybe 80 mport return $ AppConfig { appEnv = env , appPort = port' , appRoot = approot+ , appHost = host , appExtra = extra } @@ -207,13 +196,6 @@ Just (String t) -> return t Just _ -> fail $ "Invalid value for: " ++ show k Nothing -> fail $ "Not found: " ++ show k- toBool :: Text -> Bool- toBool = (`elem` ["true", "TRUE", "yes", "YES", "Y", "1"])-- addPort :: Bool -> Int -> Text- addPort True 443 = ""- addPort False 80 = ""- addPort _ p = T.pack $ ':' : show p -- | Loads the configuration block in the passed file named by the -- passed environment, yeilds to the passed function as a mapping.
Yesod/Default/Main.hs view
@@ -10,7 +10,7 @@ import Yesod.Logger (Logger, defaultDevelopmentLogger, logString) import Network.Wai (Application) import Network.Wai.Handler.Warp- (runSettings, defaultSettings, settingsPort)+ (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)@@ -26,16 +26,10 @@ -- | Run your app, taking environment and port settings from the -- commandline. ----- Use @'fromArgs'@ when using the provided @'DefaultEnv'@ type, or--- @'fromArgsWith'@ when using a custom type------ > main :: IO ()--- > main = defaultMain fromArgs withMySite------ or+-- @'fromArgs'@ helps parse a custom configuration -- -- > main :: IO ()--- > main = defaultMain (fromArgsWith customArgConfig) withMySite+-- > main = defaultMain (fromArgs parseExtra) makeApplication -- defaultMain :: (Show env, Read env) => IO (AppConfig env extra)@@ -45,8 +39,10 @@ config <- load logger <- defaultDevelopmentLogger app <- getApp config logger+ print $ appHost config runSettings defaultSettings { settingsPort = appPort config+ , settingsHost = appHost config } app -- | Run your application continously, listening for SIGINT and exiting@@ -90,6 +86,6 @@ conf <- load logger <- defaultDevelopmentLogger let p = appPort conf- logString logger $ "Devel application launched, listening on port " ++ show p+ logString logger $ "Devel application launched: http://localhost:" ++ show p app <- getApp conf logger return (p, app)
Yesod/Default/Util.hs view
@@ -7,19 +7,20 @@ , globFile , widgetFileNoReload , widgetFileReload+ , widgetFileJsCss ) 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 (unless)+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 Data.Monoid (mempty)+import Data.Maybe (catMaybes) -- | An implementation of 'addStaticContent' which stores the contents in an -- external file. Files are created in the given static folder with names based@@ -57,23 +58,62 @@ globFile kind x = "templates/" ++ x ++ "." ++ kind widgetFileNoReload :: FilePath -> Q Exp-widgetFileNoReload x = do- let h = whenExists x "hamlet" whamletFile- let c = whenExists x "cassius" cassiusFile- let j = whenExists x "julius" juliusFile- let l = whenExists x "lucius" luciusFile- [|$h >> addCassius $c >> addJulius $j >> addLucius $l|]+widgetFileNoReload x = combine "widgetFileNoReload" x+ [ whenExists x False "hamlet" whamletFile+ , whenExists x True "cassius" cassiusFile+ , whenExists x True "julius" juliusFile+ , whenExists x True "lucius" luciusFile+ ] widgetFileReload :: FilePath -> Q Exp-widgetFileReload x = do- let h = whenExists x "hamlet" whamletFile- let c = whenExists x "cassius" cassiusFileReload- let j = whenExists x "julius" juliusFileReload- let l = whenExists x "lucius" luciusFileReload- [|$h >> addCassius $c >> addJulius $j >> addLucius $l|]+widgetFileReload x = combine "widgetFileReload" x+ [ whenExists x False "hamlet" whamletFile+ , whenExists x True "cassius" cassiusFileReload+ , whenExists x True "julius" juliusFileReload+ , whenExists x True "lucius" luciusFileReload+ ] -whenExists :: String -> String -> (FilePath -> Q Exp) -> Q Exp-whenExists x glob f = do+widgetFileJsCss :: (String, FilePath -> Q Exp) -- ^ Css file extenstion and loading function. example: ("cassius", cassiusFileReload)+ -> (String, FilePath -> Q Exp) -- ^ Css file extenstion and loading function. example: ("julius", juliusFileReload)+ -> FilePath -> Q Exp+widgetFileJsCss (jsExt, jsLoad) (csExt, csLoad) x = combine "widgetFileJsCss" x+ [ whenExists x False "hamlet" whamletFile+ , whenExists x True csExt csLoad+ , whenExists x True jsExt jsLoad+ ]++combine :: String -> String -> [Q (Maybe Exp)] -> Q Exp+combine func file qmexps = do+ mexps <- sequence qmexps+ case catMaybes mexps of+ [] -> error $ concat+ [ "Called "+ , func+ , " on "+ , show file+ , ", but no template were found."+ ]+ exps -> return $ DoE $ map NoBindS exps++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- if e then f fn else [|mempty|]+ 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,6 +1,6 @@ name: yesod-default-version: 0.6.1-license: BSD3+version: 1.0.0+license: MIT license-file: LICENSE author: Patrick Brisbin maintainer: Patrick Brisbin <pbrisbin@gmail.com>@@ -17,19 +17,20 @@ if os(windows) cpp-options: -DWINDOWS - build-depends: base >= 4 && < 5- , yesod-core >= 0.10.1&& < 0.11- , warp >= 1.1 && < 1.2- , wai >= 1.1 && < 1.2- , wai-extra >= 1.1 && < 1.2+ build-depends: base >= 4 && < 5+ , yesod-core >= 1.0 && < 1.1+ , warp >= 1.2 && < 1.3+ , wai >= 1.2 && < 1.3+ , wai-extra >= 1.2 && < 1.3 , bytestring >= 0.9.1.4- , transformers >= 0.2.2 && < 0.3+ , transformers >= 0.2.2 && < 0.4 , text >= 0.9 , directory >= 1.0- , shakespeare-css >= 0.10.5 && < 0.11- , shakespeare-js >= 0.11 && < 0.12+ , shakespeare-css >= 1.0 && < 1.1+ , shakespeare-js >= 1.0 && < 1.1 , template-haskell- , yaml >= 0.5.1.2 && < 0.6+ , yaml >= 0.7 && < 0.8+ , network-conduit >= 0.4 && < 0.5 , unordered-containers if !os(windows)