summaryrefslogtreecommitdiff
path: root/standalone
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-03-01 01:15:53 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-03-01 01:15:53 -0400
commit34268a205f8a384fed788da65cee7258095c8424 (patch)
treeed106c8e2ffcb4177a6f9cd1cf540fa956d25997 /standalone
parentdd9cca4acc6c2686ab2d73a856393af018d32ea2 (diff)
expanded some TH
Diffstat (limited to 'standalone')
-rw-r--r--standalone/android/haskell-patches/yesod-core-1.1.8_0001-remove-TH.patch2
-rw-r--r--standalone/android/haskell-patches/yesod-core-1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch264
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
+