Fix widgetFile, slightly more efficient too

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

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

View File

@ -20,7 +20,7 @@ import Language.Haskell.TH.Syntax
import Text.Lucius (luciusFile, luciusFileReload) import Text.Lucius (luciusFile, luciusFileReload)
import Text.Julius (juliusFile, juliusFileReload) import Text.Julius (juliusFile, juliusFileReload)
import Text.Cassius (cassiusFile, cassiusFileReload) import Text.Cassius (cassiusFile, cassiusFileReload)
import Data.Monoid (mempty) import Data.Maybe (catMaybes)
-- | An implementation of 'addStaticContent' which stores the contents in an -- | An implementation of 'addStaticContent' which stores the contents in an
-- external file. Files are created in the given static folder with names based -- 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 globFile kind x = "templates/" ++ x ++ "." ++ kind
widgetFileNoReload :: FilePath -> Q Exp widgetFileNoReload :: FilePath -> Q Exp
widgetFileNoReload x = do widgetFileNoReload x = combine
let h = whenExists x "hamlet" whamletFile [ whenExists x "hamlet" whamletFile
let c = whenExists x "cassius" cassiusFile , whenExists x "cassius" cassiusFile
let j = whenExists x "julius" juliusFile , whenExists x "julius" juliusFile
let l = whenExists x "lucius" luciusFile , whenExists x "lucius" luciusFile
[|$h >> toWidget $c >> toWidget $j >> toWidget $l|] ]
widgetFileReload :: FilePath -> Q Exp widgetFileReload :: FilePath -> Q Exp
widgetFileReload x = do widgetFileReload x = combine
let h = whenExists x "hamlet" whamletFile [ whenExists x "hamlet" whamletFile
let c = whenExists x "cassius" cassiusFileReload , whenExists x "cassius" cassiusFileReload
let j = whenExists x "julius" juliusFileReload , whenExists x "julius" juliusFileReload
let l = whenExists x "lucius" luciusFileReload , whenExists x "lucius" luciusFileReload
[|$h >> toWidget $c >> toWidget $j >> toWidget $l|] ]
widgetFileJsCss :: (String, FilePath -> Q Exp) -- ^ Css file extenstion and loading function. example: ("cassius", cassiusFileReload) 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) -> (String, FilePath -> Q Exp) -- ^ Css file extenstion and loading function. example: ("julius", juliusFileReload)
-> FilePath -> Q Exp -> FilePath -> Q Exp
widgetFileJsCss (jsExt, jsLoad) (csExt, csLoad) x = do widgetFileJsCss (jsExt, jsLoad) (csExt, csLoad) x = combine
let h = whenExists x "hamlet" whamletFile [ whenExists x "hamlet" whamletFile
let c = whenExists x csExt csLoad , whenExists x csExt csLoad
let j = whenExists x jsExt jsLoad , whenExists x jsExt jsLoad
[|$h >> toWidget $c >> toWidget $j|] ]
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 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 warnUnlessExists shouldWarn x glob f = do
let fn = globFile glob x let fn = globFile glob x
e <- qRunIO $ doesFileExist fn e <- qRunIO $ doesFileExist fn
unless (shouldWarn && e) $ qRunIO $ putStrLn $ "widget file not found: " ++ 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