haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix widgetFile, slightly more efficient too

Browse Source
This commit is contained in:
Michael Snoyman 2012-03-15 18:35:09 +02:00
parent 2c823943af
commit 83b719f534
2 changed files with 32 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
http-conduit

@ -1 +1 @@
Subproject commit 29ef71550cc22a6689c6acde6995768f38caa339
Subproject commit ace1edd4db91f793b6d3db6df21202ceb3947af8

52
yesod-default/Yesod/Default/Util.hs
View File

@ -20,7 +20,7 @@ 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
@ -58,36 +58,46 @@ globFile :: String -> String -> FilePath
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 >> toWidget $c >> toWidget $j >> toWidget $l|]
widgetFileNoReload x = combine
[ whenExists x "hamlet" whamletFile
, whenExists x "cassius" cassiusFile
, whenExists x "julius" juliusFile
, whenExists x "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 >> toWidget $c >> toWidget $j >> toWidget $l|]
widgetFileReload x = combine
[ whenExists x "hamlet" whamletFile
, whenExists x "cassius" cassiusFileReload
, whenExists x "julius" juliusFileReload
, whenExists x "lucius" luciusFileReload
]
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 = do
let h = whenExists x "hamlet" whamletFile
let c = whenExists x csExt csLoad
let j = whenExists x jsExt jsLoad
[|$h >> toWidget $c >> toWidget $j|]
widgetFileJsCss (jsExt, jsLoad) (csExt, csLoad) x = combine
[ whenExists x "hamlet" whamletFile
, whenExists x csExt csLoad
, whenExists x jsExt jsLoad
]
whenExists :: String -> String -> (FilePath -> Q Exp) -> Q Exp
combine :: [Q (Maybe Exp)] -> Q Exp
combine qmexps = do
mexps <- sequence qmexps
case catMaybes mexps of
[] -> [|return ()|]
exps -> do
tw <- [|toWidget|]
let exps' = map (AppE tw) exps
return $ DoE $ map NoBindS exps'
whenExists :: String -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
whenExists = warnUnlessExists False
warnUnlessExists :: Bool -> String -> String -> (FilePath -> Q Exp) -> Q Exp
warnUnlessExists :: Bool -> String -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
warnUnlessExists shouldWarn x glob f = do
let fn = globFile glob x
e <- qRunIO $ doesFileExist fn
unless (shouldWarn && e) $ qRunIO $ putStrLn $ "widget file not found: " ++ fn
if e then f fn else [|mempty|]
if e then fmap Just $ f fn else return Nothing