From 458f1abcd2a22ec969cfb6c6282716d620aabc35 Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Mon, 18 May 2015 19:36:18 -0700 Subject: [PATCH] remove shakespeare dependency from Yesod.Core --- yesod-core/Yesod/Core.hs | 52 +- yesod-core/Yesod/Core/Class/Handler.hs | 29 -- yesod-core/Yesod/Core/Class/Yesod.hs | 155 +----- yesod-core/Yesod/Core/Content.hs | 29 -- yesod-core/Yesod/Core/Handler.hs | 101 ---- yesod-core/Yesod/Core/Internal/LiteApp.hs | 2 +- yesod-core/Yesod/Core/Internal/TH.hs | 5 +- yesod-core/Yesod/Core/Json.hs | 19 +- yesod-core/Yesod/Core/Types.hs | 136 +----- yesod-core/Yesod/Core/Widget.hs | 557 +++++++++++++++++++++- 10 files changed, 592 insertions(+), 493 deletions(-) diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index f7436e66..652575fb 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -21,14 +21,15 @@ module Yesod.Core , ErrorResponse (..) -- * Utitlities , maybeAuthorized - , widgetToPageContent + -- FIXME: API breakage + -- , widgetToPageContent -- * Defaults - , defaultErrorHandler + -- FIXME: API breakage + -- , defaultErrorHandler , defaultYesodMiddleware , authorizationCheck -- * Data types , AuthResult (..) - , unauthorizedI -- * Logging , LogLevel (..) , logDebug @@ -53,13 +54,11 @@ module Yesod.Core , loadClientSession , Header(..) -- * JS loaders - , ScriptLoadPosition (..) - , BottomOfHeadAsync -- * Subsites , MonadHandler (..) - , MonadWidget (..) , getRouteToParent - , defaultLayoutSub + -- FIXME + -- , defaultLayoutSub -- * Misc , yesodVersion , yesodRender @@ -72,9 +71,7 @@ module Yesod.Core , module Yesod.Core.Content , module Yesod.Core.Dispatch , module Yesod.Core.Handler - , module Yesod.Core.Widget , module Yesod.Core.Json - , module Text.Shakespeare.I18N , module Yesod.Core.Internal.Util , module Text.Blaze.Html , MonadTrans (..) @@ -88,31 +85,30 @@ module Yesod.Core -- * Utilities , showIntegral , readIntegral + -- FIXME: API breakage -- * Shakespeare -- ** Hamlet - , hamlet - , shamlet - , xhamlet - , HtmlUrl + -- , hamlet + -- , shamlet + -- , xhamlet + -- , HtmlUrl -- ** Julius - , julius - , JavascriptUrl - , renderJavascriptUrl + -- , julius + -- , JavascriptUrl + -- , renderJavascriptUrl -- ** Cassius/Lucius - , cassius - , lucius - , CssUrl - , renderCssUrl + -- , cassius + -- , lucius + -- , CssUrl + -- , renderCssUrl ) where import Yesod.Core.Content import Yesod.Core.Dispatch import Yesod.Core.Handler import Yesod.Core.Class.Handler -import Yesod.Core.Widget import Yesod.Core.Json import Yesod.Core.Types -import Text.Shakespeare.I18N import Yesod.Core.Internal.Util (formatW3 , formatRFC1123 , formatRFC822) import Text.Blaze.Html (Html, toHtml, preEscapedToMarkup) @@ -134,10 +130,6 @@ import Control.Monad.Trans.Control (MonadBaseControl (..)) import Control.Monad.Trans.Resource (MonadResource (..)) import Yesod.Core.Internal.LiteApp -import Text.Hamlet -import Text.Cassius -import Text.Lucius -import Text.Julius import Network.Wai (Application) runFakeHandler :: (Yesod site, MonadIO m) => @@ -149,12 +141,6 @@ runFakeHandler :: (Yesod site, MonadIO m) => runFakeHandler = Yesod.Core.Internal.Run.runFakeHandler {-# DEPRECATED runFakeHandler "import runFakeHandler from Yesod.Core.Unsafe" #-} --- | Return an 'Unauthorized' value, with the given i18n message. -unauthorizedI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => msg -> m AuthResult -unauthorizedI msg = do - mr <- getMessageRender - return $ Unauthorized $ mr msg - yesodVersion :: String yesodVersion = showVersion Paths_yesod_core.version @@ -173,10 +159,12 @@ maybeAuthorized r isWrite = do getRouteToParent :: Monad m => HandlerT child (HandlerT parent m) (Route child -> Route parent) getRouteToParent = HandlerT $ return . handlerToParent +{- defaultLayoutSub :: Yesod parent => WidgetT child IO () -> HandlerT child (HandlerT parent IO) Html defaultLayoutSub cwidget = widgetToParentWidget cwidget >>= lift . defaultLayout +-} showIntegral :: Integral a => a -> String showIntegral x = show (fromIntegral x :: Integer) diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs index a8b4504d..d6e66f61 100644 --- a/yesod-core/Yesod/Core/Class/Handler.hs +++ b/yesod-core/Yesod/Core/Class/Handler.hs @@ -7,7 +7,6 @@ {-# LANGUAGE UndecidableInstances #-} module Yesod.Core.Class.Handler ( MonadHandler (..) - , MonadWidget (..) ) where import Yesod.Core.Types @@ -43,11 +42,6 @@ instance MonadResourceBase m => MonadHandler (HandlerT site m) where liftHandlerT (HandlerT f) = HandlerT $ liftIO . f . replaceToParent {-# RULES "liftHandlerT (HandlerT site IO)" liftHandlerT = id #-} -instance MonadResourceBase m => MonadHandler (WidgetT site m) where - type HandlerSite (WidgetT site m) = site - liftHandlerT (HandlerT f) = WidgetT $ liftIO . liftM (, mempty) . f . replaceToParent -{-# RULES "liftHandlerT (WidgetT site IO)" forall f. liftHandlerT (HandlerT f) = WidgetT $ liftM (, mempty) . f #-} - #define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT #define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT GO(IdentityT) @@ -65,26 +59,3 @@ GO(Pipe l i o u) GO(ConduitM i o) #undef GO #undef GOX - -class MonadHandler m => MonadWidget m where - liftWidgetT :: WidgetT (HandlerSite m) IO a -> m a -instance MonadResourceBase m => MonadWidget (WidgetT site m) where - liftWidgetT (WidgetT f) = WidgetT $ liftIO . f . replaceToParent - -#define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT -#define GOX(X, T) instance (X, MonadWidget m) => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT -GO(IdentityT) -GO(ListT) -GO(MaybeT) -GOX(Error e, ErrorT e) -GO(ReaderT r) -GO(StateT s) -GOX(Monoid w, WriterT w) -GOX(Monoid w, RWST r w s) -GOX(Monoid w, Strict.RWST r w s) -GO(Strict.StateT s) -GOX(Monoid w, Strict.WriterT w) -GO(Pipe l i o u) -GO(ConduitM i o) -#undef GO -#undef GOX diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index c2e707a1..0f5d0473 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -23,8 +23,6 @@ import Control.Monad.Trans.Resource (InternalState, createIntern import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Data.Aeson (object, (.=)) -import Data.List (foldl') -import Data.List (nub) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Monoid @@ -46,17 +44,16 @@ import System.Log.FastLogger import Text.Blaze (customAttribute, textTag, toValue, (!)) import Text.Blaze (preEscapedToMarkup) +import Text.Blaze.Html (Html) import qualified Text.Blaze.Html5 as TBH -import Text.Hamlet -import Text.Julius import qualified Web.ClientSession as CS import Web.Cookie (parseCookies) import Web.Cookie (SetCookie (..)) import Yesod.Core.Types import Yesod.Core.Internal.Session -import Yesod.Core.Widget import Control.Monad.Trans.Class (lift) + -- | Define settings for a Yesod applications. All methods have intelligent -- defaults, and therefore no implementation is required. class RenderRoute site => Yesod site where @@ -80,10 +77,12 @@ class RenderRoute site => Yesod site where -- -- Default value: 'defaultErrorHandler'. errorHandler :: ErrorResponse -> HandlerT site IO TypedContent - errorHandler = defaultErrorHandler + -- errorHandler = defaultErrorHandler -- | Applies some form of layout to the contents of a page. + {- FIXME defaultLayout :: WidgetT site IO () -> HandlerT site IO Html + widgetToPageContent = widgetToPageContentUnbound addStaticContent jsLoader defaultLayout w = do p <- widgetToPageContent w mmsg <- getMessage @@ -99,6 +98,7 @@ class RenderRoute site => Yesod site where

#{msg} ^{pageBody p} |] + -} -- | 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 @@ -236,8 +236,9 @@ class RenderRoute site => Yesod site where -- > BottomOfHeadAsync $ loadJsYepnope $ Right $ StaticR js_modernizr_js -- -- Or write your own async js loader. - jsLoader :: site -> ScriptLoadPosition site - jsLoader _ = BottomOfBody + -- FIXME: the type + -- jsLoader :: site -> ScriptLoadPosition site + -- jsLoader _ = BottomOfBody -- | Create a session backend. Returning 'Nothing' disables -- sessions. If you'd like to change the way that the session @@ -300,6 +301,7 @@ class RenderRoute site => Yesod site where yesodWithInternalState _ _ = bracket createInternalState closeInternalState {-# INLINE yesodWithInternalState #-} + -- | Default implementation of 'yesodMiddleware'. Adds the response header -- \"Vary: Accept, Accept-Language\" and performs authorization checks. -- @@ -373,104 +375,7 @@ authorizationCheck = do void $ notAuthenticated Unauthorized s' -> permissionDenied s' --- | Convert a widget to a 'PageContent'. -widgetToPageContent :: (Eq (Route site), Yesod site) - => WidgetT site IO () - -> HandlerT site IO (PageContent (Route site)) -widgetToPageContent w = do - master <- getYesod - hd <- HandlerT return - ((), GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- lift $ unWidgetT w hd - let title = maybe mempty unTitle mTitle - scripts = runUniqueList scripts' - stylesheets = runUniqueList stylesheets' - - render <- getUrlRenderParams - let renderLoc x = - case x of - Nothing -> Nothing - Just (Left s) -> Just s - Just (Right (u, p)) -> Just $ render u p - css <- forM (Map.toList style) $ \(mmedia, content) -> do - let rendered = toLazyText $ content render - x <- addStaticContent "css" "text/css; charset=utf-8" - $ encodeUtf8 rendered - return (mmedia, - case x of - Nothing -> Left $ preEscapedToMarkup rendered - Just y -> Right $ either id (uncurry render) y) - jsLoc <- - case jscript of - Nothing -> return Nothing - Just s -> do - x <- addStaticContent "js" "text/javascript; charset=utf-8" - $ encodeUtf8 $ renderJavascriptUrl render s - return $ renderLoc x - - -- modernizr should be at the end of the 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 = [hamlet| - $newline never - $forall s <- scripts - ^{mkScriptTag s} - $maybe j <- jscript - $maybe s <- jsLoc -