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

Remove problematic toWidget wrapper

Browse Source
This commit is contained in:
Michael Snoyman 2012-03-15 18:41:14 +02:00
parent 21c9e84d4e
commit 757af0e32f
1 changed files with 29 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -59,27 +59,27 @@ globFile kind x = "templates/" ++ x ++ "." ++ kind
widgetFileNoReload :: FilePath -> Q Exp widgetFileNoReload :: FilePath -> Q Exp
widgetFileNoReload x = combine widgetFileNoReload x = combine
[ whenExists x "hamlet" whamletFile [ whenExists x False "hamlet" whamletFile
, whenExists x "cassius" cassiusFile , whenExists x True "cassius" cassiusFile
, whenExists x "julius" juliusFile , whenExists x True "julius" juliusFile
, whenExists x "lucius" luciusFile , whenExists x True "lucius" luciusFile
] ]
widgetFileReload :: FilePath -> Q Exp widgetFileReload :: FilePath -> Q Exp
widgetFileReload x = combine widgetFileReload x = combine
[ whenExists x "hamlet" whamletFile [ whenExists x False "hamlet" whamletFile
, whenExists x "cassius" cassiusFileReload , whenExists x True "cassius" cassiusFileReload
, whenExists x "julius" juliusFileReload , whenExists x True "julius" juliusFileReload
, whenExists x "lucius" luciusFileReload , whenExists x True "lucius" luciusFileReload
] ]
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 = combine widgetFileJsCss (jsExt, jsLoad) (csExt, csLoad) x = combine
[ whenExists x "hamlet" whamletFile [ whenExists x False "hamlet" whamletFile
, whenExists x csExt csLoad , whenExists x True csExt csLoad
, whenExists x jsExt jsLoad , whenExists x True jsExt jsLoad
] ]
combine :: [Q (Maybe Exp)] -> Q Exp combine :: [Q (Maybe Exp)] -> Q Exp
@ -87,17 +87,27 @@ combine qmexps = do
mexps <- sequence qmexps mexps <- sequence qmexps
case catMaybes mexps of case catMaybes mexps of
[] -> [|return ()|] [] -> [|return ()|]
exps -> do exps -> return $ DoE $ map NoBindS exps
tw <- [|toWidget|]
let exps' = map (AppE tw) exps
return $ DoE $ map NoBindS exps'
whenExists :: String -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp) whenExists :: String
-> Bool -- ^ requires toWidget wrap
-> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
whenExists = warnUnlessExists False whenExists = warnUnlessExists False
warnUnlessExists :: Bool -> String -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp) warnUnlessExists :: Bool
warnUnlessExists shouldWarn x glob f = do -> String
-> Bool -- ^ requires toWidget wrap
-> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
warnUnlessExists shouldWarn x wrap glob f = do
let fn = globFile glob x let fn = globFile glob x
e <- qRunIO $ doesFileExist fn e <- qRunIO $ doesFileExist fn
when (shouldWarn && not e) $ qRunIO $ putStrLn $ "widget file not found: " ++ fn when (shouldWarn && not e) $ qRunIO $ putStrLn $ "widget file not found: " ++ fn
if e then fmap Just $ f fn else return Nothing 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