diff options
author | Joey Hess <joey@kitenet.net> | 2013-03-01 01:15:53 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-03-01 01:15:53 -0400 |
commit | 34268a205f8a384fed788da65cee7258095c8424 (patch) | |
tree | ed106c8e2ffcb4177a6f9cd1cf540fa956d25997 /standalone | |
parent | dd9cca4acc6c2686ab2d73a856393af018d32ea2 (diff) |
expanded some TH
Diffstat (limited to 'standalone')
-rw-r--r-- | standalone/android/haskell-patches/yesod-core-1.1.8_0001-remove-TH.patch | 2 | ||||
-rw-r--r-- | standalone/android/haskell-patches/yesod-core-1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch | 264 |
2 files changed, 265 insertions, 1 deletions
diff --git a/standalone/android/haskell-patches/yesod-core-1.1.8_0001-remove-TH.patch b/standalone/android/haskell-patches/yesod-core-1.1.8_0001-remove-TH.patch index bfb294233..fd641a1aa 100644 --- a/standalone/android/haskell-patches/yesod-core-1.1.8_0001-remove-TH.patch +++ b/standalone/android/haskell-patches/yesod-core-1.1.8_0001-remove-TH.patch @@ -1,7 +1,7 @@ From 801f6dea3be43113400e41aabb443456fffcd227 Mon Sep 17 00:00:00 2001 From: Joey Hess <joey@kitenet.net> Date: Thu, 28 Feb 2013 23:39:40 -0400 -Subject: [PATCH] remove TH +Subject: [PATCH 1/2] remove TH --- Yesod/Core.hs | 10 ---- diff --git a/standalone/android/haskell-patches/yesod-core-1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch b/standalone/android/haskell-patches/yesod-core-1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch new file mode 100644 index 000000000..e0a3f9b5f --- /dev/null +++ b/standalone/android/haskell-patches/yesod-core-1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch @@ -0,0 +1,264 @@ +From 9ae3db0b3292b53715232fecec3c5e2bf03b89cd Mon Sep 17 00:00:00 2001 +From: Joey Hess <joey@kitenet.net> +Date: Fri, 1 Mar 2013 01:02:53 -0400 +Subject: [PATCH 2/2] replaced TH in Yesod.Internal.Core + +Done by running a build with -ddump-splices and manually pasting in the +spliced code, and then modifying it until it compiles. +--- + Yesod/Internal/Core.hs | 211 +++++++++++++++++++++++++++++++++++++++++++++--- + 1 file changed, 201 insertions(+), 10 deletions(-) + +diff --git a/Yesod/Internal/Core.hs b/Yesod/Internal/Core.hs +index 90c05fc..b9a0ae8 100644 +--- a/Yesod/Internal/Core.hs ++++ b/Yesod/Internal/Core.hs +@@ -96,6 +96,9 @@ import System.Log.FastLogger (Logger, mkLogger, loggerDate, LogStr (..), loggerP + import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), LogSource) + import System.Log.FastLogger.Date (ZonedDate) + import System.IO (stdout) ++import qualified Data.Foldable ++import qualified Text.Blaze.Internal ++import qualified Text.Hamlet + + yesodVersion :: String + yesodVersion = showVersion Paths_yesod_core.version +@@ -164,7 +167,28 @@ class RenderRoute a => Yesod a where + + -- | Applies some form of layout to the contents of a page. + defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml +- defaultLayout w = error "defaultLayout not implemented" ++ defaultLayout w = do ++ p <- widgetToPageContent w ++ mmsg <- getMessage ++ hamletToRepHtml $ \ _render_ay88 -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<!DOCTYPE html>\n<html><head><title>"); ++ id (TBH.toHtml (pageTitle p)); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</title>"); ++ id (pageHead p) _render_ay88; ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</head><body>"); ++ Text.Hamlet.maybeH ++ mmsg ++ (\ msg_ay89 ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<p class=\"message\">"); ++ id (TBH.toHtml msg_ay89); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") }) ++ Nothing; ++ id (pageBody p) _render_ay88; ++ 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 +@@ -505,11 +529,45 @@ applyLayout' title body = fmap chooseRep $ defaultLayout $ do + + -- | The default error handler for 'errorHandler'. + defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep +-defaultErrorHandler NotFound = error "Not Found" +-defaultErrorHandler (PermissionDenied msg) = error "Permission Denied" +-defaultErrorHandler (InvalidArgs ia) = error "Invalid Arguments" +-defaultErrorHandler (InternalError e) = error "Internal Server Error" +-defaultErrorHandler (BadMethod m) = error "Bad Method" ++defaultErrorHandler NotFound = do ++ r <- waiRequest ++ let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r ++ applyLayout' "Not Found" $ \ _render_ayac -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Not Found</h1><p>"); ++ id (TBH.toHtml path'); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") } ++defaultErrorHandler (PermissionDenied msg) = ++ applyLayout' "Permission Denied" $ \ _render_ayah -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Permission denied</h1><p>"); ++ id (TBH.toHtml msg); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") } ++defaultErrorHandler (InvalidArgs ia) = ++ applyLayout' "Invalid Arguments" $ \ _render_ayam -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Invalid Arguments</h1><ul>"); ++ Data.Foldable.mapM_ ++ (\ msg_ayan ++ -> do { id ((Text.Blaze.Internal.preEscapedText . T.pack) "<li>"); ++ id (TBH.toHtml msg_ayan); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</li>") }) ++ ia; ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</ul>") } ++defaultErrorHandler (InternalError e) = do ++ applyLayout' "Internal Server Error" $ \ _render_ayau -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Internal Server Error</h1><pre>"); ++ id (TBH.toHtml e); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</pre>") } ++defaultErrorHandler (BadMethod m) = ++ applyLayout' "Bad Method" $ \ _render_ayaz -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Method Not Supported</h1><p>Method <code>"); ++ id (TBH.toHtml (S8.unpack m)); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "</code> not supported</p>") } + + -- | Return the same URL if the user is authorized to see it. + -- +@@ -565,10 +623,99 @@ 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 +- regularScriptLoad = error "TODO" +- +- headAll = error "TODO" +- let bodyScript = error "TODO" ++ regularScriptLoad = \ _render_aybs -> do { Data.Foldable.mapM_ ++ (\ s_aybt ++ -> id (mkScriptTag s_aybt) _render_aybs) ++ scripts; ++ Text.Hamlet.maybeH ++ jscript ++ (\ j_aybu ++ -> Text.Hamlet.maybeH ++ jsLoc ++ (\ s_aybv ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<script src=\""); ++ id (TBH.toHtml s_aybv); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\"></script>") }) ++ (Just ++ (do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script>"); ++ id (jelper j_aybu) _render_aybs; ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</script>") }))) ++ Nothing } ++ ++ headAll = \ _render_aybz -> do ++ { id head' _render_aybz; ++ Data.Foldable.mapM_ ++ (\ s_aybA -> id (mkLinkTag s_aybA) _render_aybz) ++ stylesheets; ++ Data.Foldable.mapM_ ++ (\ s_aybB ++ -> do { Text.Hamlet.maybeH ++ (right (snd s_aybB)) ++ (\ t_aybC ++ -> Text.Hamlet.maybeH ++ (fst s_aybB) ++ (\ media_aybD ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<link rel=\"stylesheet\" media=\""); ++ id (TBH.toHtml media_aybD); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\" href=\""); ++ id (TBH.toHtml t_aybC); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\">") }) ++ (Just ++ (do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<link rel=\"stylesheet\" href=\""); ++ id (TBH.toHtml t_aybC); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\">") }))) ++ Nothing; ++ Text.Hamlet.maybeH ++ (left (snd s_aybB)) ++ (\ content_aybE ++ -> Text.Hamlet.maybeH ++ (fst s_aybB) ++ (\ media_aybF ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<style media=\""); ++ id (TBH.toHtml media_aybF); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\">"); ++ id (TBH.toHtml content_aybE); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "</style>") }) ++ (Just ++ (do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<style>"); ++ id (TBH.toHtml content_aybE); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "</style>") }))) ++ Nothing }) ++ css; ++ case jsLoader master of ++ BottomOfBody -> return () ++ BottomOfHeadAsync asyncJsLoader -> id (asyncJsLoader asyncScripts mcomplete) _render_aybz ++ BottomOfHeadBlocking -> id regularScriptLoad _render_aybz ++ } ++ ++ let bodyScript = \ _render_aybL -> do { ++ id body _render_aybL; ++ id regularScriptLoad _render_aybL } + + return $ PageContent title headAll (case jsLoader master of + BottomOfBody -> bodyScript +@@ -611,6 +758,50 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String + -- | For use with setting 'jsLoader' to 'BottomOfHeadAsync' + loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master)) + loadJsYepnope eyn scripts mcomplete = error "TODO" ++{- ++ \ _render_aybU ++ -> do { Text.Hamlet.maybeH ++ (left eyn) ++ (\ yn_aybV ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script src=\""); ++ id (TBH.toHtml yn_aybV); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) "\"></script>") }) ++ Nothing; ++ Text.Hamlet.maybeH ++ (right eyn) ++ (\ yn_aybW ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script src=\""); ++ id ++ (TBH.toHtml ++ (\ u_aybX -> _render_aybU u_aybX [] yn_aybW)); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) "\"></script>") }) ++ Nothing; ++ Text.Hamlet.maybeH ++ mcomplete ++ (\ complete_aybY ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<script>yepnope({load:"); ++ id (TBH.toHtml (jsonArray scripts)); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ ",complete:function(){"); ++ id complete_aybY _render_aybU; ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) "}});</script>") }) ++ (Just ++ (do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<script>yepnope({load:"); ++ id (TBH.toHtml (jsonArray scripts)); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "});</script>") })) } ++-} + + asyncHelper :: (url -> [x] -> Text) + -> [Script (url)] +-- +1.7.10.4 + |