aboutsummaryrefslogtreecommitdiff
path: root/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
diff options
context:
space:
mode:
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.patch104
1 files changed, 82 insertions, 22 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 adf0679ea..5609fb459 100644
--- a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
+++ b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
@@ -1,17 +1,19 @@
-From 5f30a68faaa379ac3fe9f0b016dd1a20969d548f Mon Sep 17 00:00:00 2001
+From be8d5895522da0397fd594d5553ed7d3641eb399 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Fri, 7 Feb 2014 23:04:06 +0000
+Date: Fri, 7 Mar 2014 01:40:29 +0000
Subject: [PATCH] remove and expand TH
+fix Loc from MonadLogger
---
- Yesod/Core.hs | 30 +++---
- Yesod/Core/Class/Yesod.hs | 248 ++++++++++++++++++++++++++++++--------------
- Yesod/Core/Dispatch.hs | 37 ++-----
- Yesod/Core/Handler.hs | 25 ++---
- Yesod/Core/Internal/Run.hs | 4 +-
- Yesod/Core/Internal/TH.hs | 111 --------------------
- Yesod/Core/Widget.hs | 32 +-----
- 7 files changed, 209 insertions(+), 278 deletions(-)
+ Yesod/Core.hs | 30 +++---
+ Yesod/Core/Class/Yesod.hs | 257 ++++++++++++++++++++++++++++++---------------
+ Yesod/Core/Dispatch.hs | 37 ++-----
+ 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(+), 288 deletions(-)
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
index 12e59d5..2817a69 100644
@@ -67,10 +69,10 @@ index 12e59d5..2817a69 100644
, renderCssUrl
) where
diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
-index 140600b..6c718e2 100644
+index 140600b..75daabc 100644
--- a/Yesod/Core/Class/Yesod.hs
+++ b/Yesod/Core/Class/Yesod.hs
-@@ -5,11 +5,15 @@
+@@ -5,18 +5,22 @@
{-# LANGUAGE CPP #-}
module Yesod.Core.Class.Yesod where
@@ -87,7 +89,23 @@ index 140600b..6c718e2 100644
import Blaze.ByteString.Builder (Builder)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
-@@ -94,18 +98,27 @@ class RenderRoute site => Yesod site where
+ import Control.Arrow ((***), second)
+ 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 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
+ import Data.Text.Lazy.Builder (toLazyText)
+ import Data.Text.Lazy.Encoding (encodeUtf8)
+ import Data.Word (Word64)
+-import Language.Haskell.TH.Syntax (Loc (..))
+ 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
defaultLayout w = do
p <- widgetToPageContent w
mmsg <- getMessage
@@ -127,7 +145,7 @@ index 140600b..6c718e2 100644
-- | 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 +387,103 @@ widgetToPageContent w = do
+@@ -374,45 +386,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
@@ -270,7 +288,7 @@ index 140600b..6c718e2 100644
return $ PageContent title headAll $
case jsLoader master of
-@@ -442,10 +513,13 @@ defaultErrorHandler NotFound = selectRep $ do
+@@ -442,10 +512,13 @@ defaultErrorHandler NotFound = selectRep $ do
r <- waiRequest
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
setTitle "Not Found"
@@ -288,7 +306,7 @@ index 140600b..6c718e2 100644
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
-- For API requests.
-@@ -455,10 +529,11 @@ defaultErrorHandler NotFound = selectRep $ do
+@@ -455,10 +528,11 @@ defaultErrorHandler NotFound = selectRep $ do
defaultErrorHandler NotAuthenticated = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Not logged in"
@@ -304,7 +322,7 @@ index 140600b..6c718e2 100644
provideRep $ do
-- 401 *MUST* include a WWW-Authenticate header
-@@ -480,10 +555,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
+@@ -480,10 +554,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
defaultErrorHandler (PermissionDenied msg) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Permission Denied"
@@ -322,7 +340,7 @@ index 140600b..6c718e2 100644
provideRep $
return $ object $ [
"message" .= ("Permission Denied. " <> msg)
-@@ -492,30 +570,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
+@@ -492,30 +569,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
defaultErrorHandler (InvalidArgs ia) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Invalid Arguments"
@@ -380,6 +398,16 @@ index 140600b..6c718e2 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
+ -- turn the TH Loc loaction information into a human readable string
+ -- leaving out the loc_end parameter
+ fileLocationToString :: Loc -> String
+-fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++
+- ' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc)
+- where
+- line = show . fst . loc_start
+- char = show . snd . loc_start
++fileLocationToString loc = "unknown"
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
index e6f489d..3ff37c1 100644
--- a/Yesod/Core/Dispatch.hs
@@ -506,18 +534,29 @@ index 7c561c5..847d475 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 10871a2..6ed631e 100644
+index 10871a2..e8d1907 100644
--- a/Yesod/Core/Internal/Run.hs
+++ b/Yesod/Core/Internal/Run.hs
-@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch)
+@@ -15,8 +15,8 @@ import qualified Control.Exception as E
+ import Control.Exception.Lifted (catch)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Class (liftIO)
- import Control.Monad.Logger (LogLevel (LevelError), LogSource,
+-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)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
+@@ -30,7 +30,7 @@ import qualified Data.Text as T
+ import Data.Text.Encoding (encodeUtf8)
+ import Data.Text.Encoding (decodeUtf8With)
+ import Data.Text.Encoding.Error (lenientDecode)
+-import Language.Haskell.TH.Syntax (Loc, qLocation)
++import Language.Haskell.TH.Syntax (qLocation)
+ import qualified Network.HTTP.Types as H
+ import Network.Wai
+ #if MIN_VERSION_wai(2, 0, 0)
@@ -131,8 +131,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> ErrorResponse
-> YesodApp
@@ -646,6 +685,27 @@ index 7e84c1c..a273c29 100644
- [innerFun]
- ]
- return $ LetE [fun] (VarE helper)
+diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs
+index de09f78..9183a64 100644
+--- a/Yesod/Core/Types.hs
++++ b/Yesod/Core/Types.hs
+@@ -17,6 +17,7 @@ import Control.Exception (Exception)
+ import Control.Monad (liftM, ap)
+ import Control.Monad.Base (MonadBase (liftBase))
+ 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 (..))
+@@ -179,7 +180,7 @@ data RunHandlerEnv site = RunHandlerEnv
+ , rheRoute :: !(Maybe (Route site))
+ , rheSite :: !site
+ , rheUpload :: !(RequestBodyLength -> FileUpload)
+- , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
++ , rheLog :: !(Control.Monad.Logger.Loc -> LogSource -> LogLevel -> LogStr -> IO ())
+ , rheOnError :: !(ErrorResponse -> YesodApp)
+ -- ^ How to respond when an error is thrown internally.
+ --
diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs
index a972efa..156cd45 100644
--- a/Yesod/Core/Widget.hs
@@ -707,5 +767,5 @@ index a972efa..156cd45 100644
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
=> HtmlUrlI18n message (Route (HandlerSite m))
--
-1.7.10.4
+1.9.0