diff --git a/Yesod/Default/Config.hs b/Yesod/Default/Config.hs --- a/Yesod/Default/Config.hs +++ b/Yesod/Default/Config.hs @@ -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. diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -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) diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs --- a/Yesod/Default/Util.hs +++ b/Yesod/Default/Util.hs @@ -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 diff --git a/yesod-default.cabal b/yesod-default.cabal --- a/yesod-default.cabal +++ b/yesod-default.cabal @@ -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 @@ -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)