diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -7,7 +7,6 @@ ) where import Yesod.Default.Config -import Yesod.Logger (Logger, defaultDevelopmentLogger, logString) import Network.Wai (Application) import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort, settingsHost) @@ -33,12 +32,11 @@ -- defaultMain :: (Show env, Read env) => IO (AppConfig env extra) - -> (AppConfig env extra -> Logger -> IO Application) + -> (AppConfig env extra -> IO Application) -> IO () defaultMain load getApp = do config <- load - logger <- defaultDevelopmentLogger - app <- getApp config logger + app <- getApp config print $ appHost config runSettings defaultSettings { settingsPort = appPort config @@ -80,12 +78,11 @@ defaultDevelApp :: (Show env, Read env) => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ - -> (AppConfig env extra -> Logger -> IO Application) -- ^ Get your @Application@ + -> (AppConfig env extra -> IO Application) -- ^ Get your @Application@ -> IO (Int, Application) defaultDevelApp load getApp = do conf <- load - logger <- defaultDevelopmentLogger let p = appPort conf - logString logger $ "Devel application launched: http://localhost:" ++ show p - app <- getApp conf logger + putStrLn $ "Devel application launched: http://localhost:" ++ show p + 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 @@ -7,7 +7,11 @@ , globFile , widgetFileNoReload , widgetFileReload - , widgetFileJsCss + , TemplateLanguage (..) + , defaultTemplateLanguages + , WidgetFileSettings + , wfsLanguages + , wfsHamletSettings ) where import Control.Monad.IO.Class (liftIO) @@ -20,7 +24,9 @@ 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 @@ -57,34 +63,40 @@ globFile :: String -> String -> FilePath globFile kind x = "templates/" ++ x ++ "." ++ kind -widgetFileNoReload :: FilePath -> Q Exp -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 - ] +data TemplateLanguage = TemplateLanguage + { tlRequiresToWidget :: Bool + , tlExtension :: String + , tlNoReload :: FilePath -> Q Exp + , tlReload :: FilePath -> Q Exp + } -widgetFileReload :: FilePath -> Q Exp -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 +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 -widgetFileJsCss :: (String, FilePath -> Q Exp) -- ^ JavaScript file extenstion and loading function. example: ("julius", juliusFileReload) - -> (String, FilePath -> Q Exp) -- ^ Css file extenstion and loading function. example: ("cassius", cassiusFileReload) - -> 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 - ] +data WidgetFileSettings = WidgetFileSettings + { wfsLanguages :: HamletSettings -> [TemplateLanguage] + , wfsHamletSettings :: HamletSettings + } -combine :: String -> String -> [Q (Maybe Exp)] -> Q Exp -combine func file qmexps = do - mexps <- sequence qmexps +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 " @@ -94,6 +106,12 @@ , ", 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 diff --git a/yesod-default.cabal b/yesod-default.cabal --- a/yesod-default.cabal +++ b/yesod-default.cabal @@ -1,5 +1,5 @@ name: yesod-default -version: 1.0.1.1 +version: 1.1.0 license: MIT license-file: LICENSE author: Patrick Brisbin @@ -18,10 +18,10 @@ cpp-options: -DWINDOWS 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 + , yesod-core >= 1.1 && < 1.2 + , warp >= 1.3 && < 1.4 + , wai >= 1.3 && < 1.4 + , wai-extra >= 1.3 && < 1.4 , bytestring >= 0.9.1.4 , transformers >= 0.2.2 && < 0.4 , text >= 0.9 @@ -29,9 +29,11 @@ , shakespeare-css >= 1.0 && < 1.1 , shakespeare-js >= 1.0 && < 1.1 , template-haskell - , yaml >= 0.7 && < 0.8 - , network-conduit >= 0.4 && < 0.5 + , yaml >= 0.8 && < 0.9 + , network-conduit >= 0.5 && < 0.6 , unordered-containers + , hamlet >= 1.1 && < 1.2 + , data-default if !os(windows) build-depends: unix