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 | 104 |
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 |