mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

expanded some TH

Browse source
This commit is contained in:
Joey Hess 2013-03-01 01:15:53 -04:00
parent 85db342a13
commit d9459a75b0
2 changed files with 265 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
standalone/android/haskell-patches/yesod-core-1.1.8_0001-remove-TH.patch
View file

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

264
standalone/android/haskell-patches/yesod-core-1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch Normal file
View file

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