From 59091cd37958fee79b9e346fe3118d5ed7d0104b Mon Sep 17 00:00:00 2001 From: dummy Date: Thu, 16 Oct 2014 02:36:37 +0000 Subject: [PATCH] hack TH --- Yesod.hs | 19 ++++++++++++-- Yesod/Default/Main.hs | 31 +---------------------- Yesod/Default/Util.hs | 69 ++------------------------------------------------- 3 files changed, 20 insertions(+), 99 deletions(-) diff --git a/Yesod.hs b/Yesod.hs index b367144..fbe309c 100644 --- a/Yesod.hs +++ b/Yesod.hs @@ -5,9 +5,24 @@ module Yesod ( -- * Re-exports from yesod-core module Yesod.Core , module Yesod.Form - , module Yesod.Persist + , insertBy + , replace + , deleteBy + , delete + , insert + , Key ) where import Yesod.Core import Yesod.Form -import Yesod.Persist + +-- These symbols are usually imported from persistent, +-- But it is not built on Android. Still export them +-- just so that hiding them will work. +data Key = DummyKey +insertBy = undefined +replace = undefined +deleteBy = undefined +delete = undefined +insert = undefined + diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs index 565ed35..bf46642 100644 --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module Yesod.Default.Main ( defaultMain - , defaultMainLog , defaultRunner , defaultDevelApp , LogFunc @@ -23,7 +21,7 @@ import Control.Monad (when) import System.Environment (getEnvironment) import Data.Maybe (fromMaybe) import Safe (readMay) -import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc) +import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError)) import System.Log.FastLogger (LogStr, toLogStr) import Language.Haskell.TH.Syntax (qLocation) @@ -55,33 +53,6 @@ defaultMain load getApp = do type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () --- | Same as @defaultMain@, but gets a logging function back as well as an --- @Application@ to install Warp exception handlers. --- --- Since 1.2.5 -defaultMainLog :: (Show env, Read env) - => IO (AppConfig env extra) - -> (AppConfig env extra -> IO (Application, LogFunc)) - -> IO () -defaultMainLog load getApp = do - config <- load - (app, logFunc) <- getApp config - runSettings defaultSettings - { settingsPort = appPort config - , settingsHost = appHost config - , settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc - $(qLocation >>= liftLoc) - "yesod" - LevelError - (toLogStr $ "Exception from Warp: " ++ show e) - } app - where - shouldLog' = -#if MIN_VERSION_warp(2,1,3) - Warp.defaultShouldDisplayException -#else - const True -#endif -- | Run your application continously, listening for SIGINT and exiting -- when received diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs index a10358e..0547424 100644 --- a/Yesod/Default/Util.hs +++ b/Yesod/Default/Util.hs @@ -5,10 +5,9 @@ module Yesod.Default.Util ( addStaticContentExternal , globFile - , widgetFileNoReload - , widgetFileReload + --, widgetFileNoReload + --, widgetFileReload , TemplateLanguage (..) - , defaultTemplateLanguages , WidgetFileSettings , wfsLanguages , wfsHamletSettings @@ -20,9 +19,6 @@ import Yesod.Core -- purposely using complete import so that Haddock will see ad 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 Text.Hamlet (HamletSettings, defaultHamletSettings) import Data.Maybe (catMaybes) import Data.Default (Default (def)) @@ -69,68 +65,7 @@ data TemplateLanguage = TemplateLanguage , tlReload :: FilePath -> Q Exp } -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 - data WidgetFileSettings = WidgetFileSettings { wfsLanguages :: HamletSettings -> [TemplateLanguage] , wfsHamletSettings :: HamletSettings } - -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 " - , func - , " on " - , show file - , ", 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 - -> 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 - 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 -- 2.1.1