diff options
Diffstat (limited to 'standalone/no-th/haskell-patches/yesod-core_expand_TH.patch')
| -rw-r--r-- | standalone/no-th/haskell-patches/yesod-core_expand_TH.patch | 108 |
1 files changed, 53 insertions, 55 deletions
diff --git a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch index 07663ac80..378043410 100644 --- a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch +++ b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch @@ -1,18 +1,18 @@ -From 9feb37d13dc8449dc4445db83485780caee4b7ff Mon Sep 17 00:00:00 2001 +From e163ab104cf2f8d2bac07ab389caec49dfc39665 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Tue, 10 Jun 2014 17:44:52 +0000 +Date: Tue, 14 Oct 2014 02:49:19 +0000 Subject: [PATCH] expand and remove TH --- - Yesod/Core.hs | 30 +++--- - Yesod/Core/Class/Yesod.hs | 257 ++++++++++++++++++++++++++++++--------------- - Yesod/Core/Dispatch.hs | 38 ++----- - Yesod/Core/Handler.hs | 25 ++--- - Yesod/Core/Internal/Run.hs | 8 +- - Yesod/Core/Internal/TH.hs | 111 -------------------- - Yesod/Core/Types.hs | 3 +- - Yesod/Core/Widget.hs | 32 +----- - 8 files changed, 215 insertions(+), 289 deletions(-) + Yesod/Core.hs | 30 +++--- + Yesod/Core/Class/Yesod.hs | 256 +++++++++++++++++++++++++++++--------------- + Yesod/Core/Dispatch.hs | 38 ++----- + Yesod/Core/Handler.hs | 25 ++--- + Yesod/Core/Internal/Run.hs | 6 +- + Yesod/Core/Internal/TH.hs | 111 ------------------- + Yesod/Core/Types.hs | 3 +- + Yesod/Core/Widget.hs | 32 +----- + 8 files changed, 213 insertions(+), 288 deletions(-) diff --git a/Yesod/Core.hs b/Yesod/Core.hs index 9b29317..7c0792d 100644 @@ -68,10 +68,10 @@ index 9b29317..7c0792d 100644 , renderCssUrl ) where diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs -index 140600b..75daabc 100644 +index 5dbaff2..edd98a5 100644 --- a/Yesod/Core/Class/Yesod.hs +++ b/Yesod/Core/Class/Yesod.hs -@@ -5,18 +5,22 @@ +@@ -5,11 +5,15 @@ {-# LANGUAGE CPP #-} module Yesod.Core.Class.Yesod where @@ -88,15 +88,16 @@ index 140600b..75daabc 100644 import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder.Char.Utf8 (fromText) - import Control.Arrow ((***), second) +@@ -17,7 +21,7 @@ import Control.Arrow ((***), second) + import Control.Exception (bracket) import Control.Monad (forM, when, void) import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), +import Control.Monad.Logger (Loc, LogLevel (LevelInfo, LevelOther), LogSource) + import Control.Monad.Trans.Resource (InternalState, createInternalState, closeInternalState) import qualified Data.ByteString.Char8 as S8 - import qualified Data.ByteString.Lazy as L -@@ -33,7 +37,6 @@ import qualified Data.Text.Encoding.Error as TEE +@@ -35,7 +39,6 @@ import qualified Data.Text.Encoding.Error as TEE import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Encoding (encodeUtf8) import Data.Word (Word64) @@ -104,11 +105,11 @@ index 140600b..75daabc 100644 import Network.HTTP.Types (encodePath) import qualified Network.Wai as W import Data.Default (def) -@@ -94,18 +97,27 @@ class RenderRoute site => Yesod site where +@@ -87,18 +90,26 @@ class RenderRoute site => Yesod site where defaultLayout w = do p <- widgetToPageContent w mmsg <- getMessage -- giveUrlRenderer [hamlet| +- withUrlRenderer [hamlet| - $newline never - $doctype 5 - <html> @@ -120,7 +121,7 @@ index 140600b..75daabc 100644 - <p .message>#{msg} - ^{pageBody p} - |] -+ giveUrlRenderer $ \ _render_aHra ++ withUrlRenderer $ \ _render_aHra + -> do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<!DOCTYPE html>\n<html><head><title>"); @@ -140,11 +141,10 @@ index 140600b..75daabc 100644 + Text.Hamlet.asHtmlUrl (pageBody p) _render_aHra; + id + ((Text.Blaze.Internal.preEscapedText . T.pack) "</body></html>") } -+ -- | Override the rendering function for a particular URL. One use case for -- this is to offload static hosting to a different domain name to avoid -@@ -374,45 +386,103 @@ widgetToPageContent w = do +@@ -373,45 +384,103 @@ widgetToPageContent w = do -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing -- the asynchronous loader means your page doesn't have to wait for all the js to load let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc @@ -287,7 +287,7 @@ index 140600b..75daabc 100644 return $ PageContent title headAll $ case jsLoader master of -@@ -442,10 +512,13 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -441,10 +510,13 @@ defaultErrorHandler NotFound = selectRep $ do r <- waiRequest let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r setTitle "Not Found" @@ -305,7 +305,7 @@ index 140600b..75daabc 100644 provideRep $ return $ object ["message" .= ("Not Found" :: Text)] -- For API requests. -@@ -455,10 +528,11 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -454,10 +526,11 @@ defaultErrorHandler NotFound = selectRep $ do defaultErrorHandler NotAuthenticated = selectRep $ do provideRep $ defaultLayout $ do setTitle "Not logged in" @@ -321,7 +321,7 @@ index 140600b..75daabc 100644 provideRep $ do -- 401 *MUST* include a WWW-Authenticate header -@@ -480,10 +554,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do +@@ -479,10 +552,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do defaultErrorHandler (PermissionDenied msg) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Permission Denied" @@ -339,7 +339,7 @@ index 140600b..75daabc 100644 provideRep $ return $ object $ [ "message" .= ("Permission Denied. " <> msg) -@@ -492,30 +569,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do +@@ -491,30 +567,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do defaultErrorHandler (InvalidArgs ia) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Invalid Arguments" @@ -397,7 +397,7 @@ index 140600b..75daabc 100644 provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m] asyncHelper :: (url -> [x] -> Text) -@@ -682,8 +771,4 @@ loadClientSession key getCachedDate sessionName req = load +@@ -653,8 +741,4 @@ loadClientSession key getCachedDate sessionName req = load -- turn the TH Loc loaction information into a human readable string -- leaving out the loc_end parameter fileLocationToString :: Loc -> String @@ -408,7 +408,7 @@ index 140600b..75daabc 100644 - char = show . snd . loc_start +fileLocationToString loc = "unknown" diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs -index e0d1f0e..cc23fdd 100644 +index ad56452..d3d58ee 100644 --- a/Yesod/Core/Dispatch.hs +++ b/Yesod/Core/Dispatch.hs @@ -1,4 +1,3 @@ @@ -445,7 +445,7 @@ index e0d1f0e..cc23fdd 100644 , PathMultiPiece (..) , Texts -- * Convert to WAI -@@ -135,13 +134,6 @@ toWaiAppLogger logger site = do +@@ -130,13 +129,6 @@ toWaiAppLogger logger site = do , yreSite = site , yreSessionBackend = sb } @@ -459,10 +459,10 @@ index e0d1f0e..cc23fdd 100644 middleware <- mkDefaultMiddlewares logger return $ middleware $ toWaiAppYre yre -@@ -170,14 +162,7 @@ warp port site = do - ] - -} - , Network.Wai.Handler.Warp.settingsOnException = const $ \e -> +@@ -156,14 +148,7 @@ warp port site = do + Network.Wai.Handler.Warp.setPort port $ + Network.Wai.Handler.Warp.setServerName serverValue $ + Network.Wai.Handler.Warp.setOnException (\_ e -> - when (shouldLog' e) $ - messageLoggerSource - site @@ -470,12 +470,12 @@ index e0d1f0e..cc23fdd 100644 - $(qLocation >>= liftLoc) - "yesod-core" - LevelError -- (toLogStr $ "Exception from Warp: " ++ show e) -+ when (shouldLog' e) $ error (show e) - } +- (toLogStr $ "Exception from Warp: " ++ show e)) $ ++ when (shouldLog' e) $ error (show e)) $ + Network.Wai.Handler.Warp.defaultSettings) where - shouldLog' = -@@ -211,7 +196,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr + shouldLog' = Network.Wai.Handler.Warp.defaultShouldDisplayException +@@ -197,7 +182,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr -- | Deprecated synonym for 'warp'. warpDebug :: YesodDispatch site => Int -> site -> IO () warpDebug = warp @@ -484,10 +484,10 @@ index e0d1f0e..cc23fdd 100644 -- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It -- reads port information from the PORT environment variable, as used by tools diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs -index 2e5d7cb..83f93bf 100644 +index 36f8f5c..948de5f 100644 --- a/Yesod/Core/Handler.hs +++ b/Yesod/Core/Handler.hs -@@ -172,7 +172,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8) +@@ -171,7 +171,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as TL import qualified Text.Blaze.Html.Renderer.Text as RenderText @@ -496,7 +496,7 @@ index 2e5d7cb..83f93bf 100644 import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -@@ -201,6 +201,7 @@ import Control.Exception (throwIO) +@@ -199,6 +199,7 @@ import Control.Exception (throwIO) import Blaze.ByteString.Builder (Builder) import Safe (headMay) import Data.CaseInsensitive (CI) @@ -504,11 +504,11 @@ index 2e5d7cb..83f93bf 100644 import qualified Data.Conduit.List as CL import Control.Monad (unless) import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO -@@ -847,19 +848,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) +@@ -803,19 +804,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) -> m a redirectToPost url = do urlText <- toTextUrl url -- giveUrlRenderer [hamlet| +- withUrlRenderer [hamlet| -$newline never -$doctype 5 - @@ -521,7 +521,7 @@ index 2e5d7cb..83f93bf 100644 - <p>Javascript has been disabled; please click on the button below to be redirected. - <input type="submit" value="Continue"> -|] >>= sendResponse -+ giveUrlRenderer $ \ _render_awps ++ withUrlRenderer $ \ _render_awps + -> do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<!DOCTYPE html>\n<html><head><title>Redirecting...</title></head><body onload=\"document.getElementById('form').submit()\"><form id=\"form\" method=\"post\" action=\""); @@ -534,20 +534,18 @@ index 2e5d7cb..83f93bf 100644 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs -index 09b4609..e1ef568 100644 +index fdb2261..12ed4fc 100644 --- a/Yesod/Core/Internal/Run.hs +++ b/Yesod/Core/Internal/Run.hs -@@ -16,8 +16,8 @@ import Control.Exception.Lifted (catch) +@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch) import Control.Monad (mplus) import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger (LogLevel (LevelError), LogSource, -- liftLoc) +import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource, -+ ) - import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState) + liftLoc) + import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState) import qualified Data.ByteString as S - import qualified Data.ByteString.Char8 as S8 @@ -31,7 +31,7 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (decodeUtf8With) @@ -556,7 +554,7 @@ index 09b4609..e1ef568 100644 +import Language.Haskell.TH.Syntax (qLocation) import qualified Network.HTTP.Types as H import Network.Wai - #if MIN_VERSION_wai(2, 0, 0) + import Network.Wai.Internal @@ -157,8 +157,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> ErrorResponse -> YesodApp @@ -686,18 +684,18 @@ index 7e84c1c..a273c29 100644 - ] - return $ LetE [fun] (VarE helper) diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs -index 7e3fd0d..994d322 100644 +index 4d4474b..61ddb20 100644 --- a/Yesod/Core/Types.hs +++ b/Yesod/Core/Types.hs -@@ -21,6 +21,7 @@ import Control.Monad.Catch (MonadCatch (..)) +@@ -19,6 +19,7 @@ import Control.Monad.Base (MonadBase (liftBase)) + import Control.Monad.Catch (MonadCatch (..)) import Control.Monad.Catch (MonadMask (..)) - #endif import Control.Monad.IO.Class (MonadIO (liftIO)) +import qualified Control.Monad.Logger import Control.Monad.Logger (LogLevel, LogSource, MonadLogger (..)) import Control.Monad.Trans.Control (MonadBaseControl (..)) -@@ -187,7 +188,7 @@ data RunHandlerEnv site = RunHandlerEnv +@@ -174,7 +175,7 @@ data RunHandlerEnv site = RunHandlerEnv , rheRoute :: !(Maybe (Route site)) , rheSite :: !site , rheUpload :: !(RequestBodyLength -> FileUpload) @@ -767,5 +765,5 @@ index 481199e..8489fbe 100644 ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message) => HtmlUrlI18n message (Route (HandlerSite m)) -- -2.0.0 +1.7.10.4 |