Widgets use Builder for CSS
This commit is contained in:
parent
03c2db7152
commit
965884d675
@ -29,7 +29,6 @@ module Yesod.Internal
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Text.Hamlet (HtmlUrl, hamlet, Html)
|
import Text.Hamlet (HtmlUrl, hamlet, Html)
|
||||||
import Text.Cassius (CssUrl)
|
|
||||||
import Text.Julius (JavascriptUrl)
|
import Text.Julius (JavascriptUrl)
|
||||||
import Data.Monoid (Monoid (..), Last)
|
import Data.Monoid (Monoid (..), Last)
|
||||||
import Data.List (nub)
|
import Data.List (nub)
|
||||||
@ -44,6 +43,7 @@ import qualified Network.HTTP.Types as A
|
|||||||
import Data.CaseInsensitive (CI)
|
import Data.CaseInsensitive (CI)
|
||||||
import Data.String (IsString)
|
import Data.String (IsString)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
import Data.Text.Lazy.Builder (Builder)
|
||||||
|
|
||||||
#if GHC7
|
#if GHC7
|
||||||
#define HAMLET hamlet
|
#define HAMLET hamlet
|
||||||
@ -107,12 +107,14 @@ nonceKey = "_NONCE"
|
|||||||
sessionName :: IsString a => a
|
sessionName :: IsString a => a
|
||||||
sessionName = "_SESSION"
|
sessionName = "_SESSION"
|
||||||
|
|
||||||
|
type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> Builder
|
||||||
|
|
||||||
data GWData a = GWData
|
data GWData a = GWData
|
||||||
!(Body a)
|
!(Body a)
|
||||||
!(Last Title)
|
!(Last Title)
|
||||||
!(UniqueList (Script a))
|
!(UniqueList (Script a))
|
||||||
!(UniqueList (Stylesheet a))
|
!(UniqueList (Stylesheet a))
|
||||||
!(Map.Map (Maybe Text) (CssUrl a)) -- media type
|
!(Map.Map (Maybe Text) (CssBuilderUrl a)) -- media type
|
||||||
!(Maybe (JavascriptUrl a))
|
!(Maybe (JavascriptUrl a))
|
||||||
!(Head a)
|
!(Head a)
|
||||||
instance Monoid (GWData a) where
|
instance Monoid (GWData a) where
|
||||||
|
|||||||
@ -50,7 +50,6 @@ import qualified Data.ByteString.Lazy as L
|
|||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Control.Monad.Trans.RWS
|
import Control.Monad.Trans.RWS
|
||||||
import Text.Hamlet
|
import Text.Hamlet
|
||||||
import Text.Cassius
|
|
||||||
import Text.Julius
|
import Text.Julius
|
||||||
import Text.Blaze ((!), customAttribute, textTag, toValue, unsafeLazyByteString)
|
import Text.Blaze ((!), customAttribute, textTag, toValue, unsafeLazyByteString)
|
||||||
import qualified Text.Blaze.Html5 as TBH
|
import qualified Text.Blaze.Html5 as TBH
|
||||||
@ -504,7 +503,7 @@ widgetToPageContent (GWidget w) = do
|
|||||||
Just (Left s) -> Just s
|
Just (Left s) -> Just s
|
||||||
Just (Right (u, p)) -> Just $ render u p
|
Just (Right (u, p)) -> Just $ render u p
|
||||||
css <- forM (Map.toList style) $ \(mmedia, content) -> do
|
css <- forM (Map.toList style) $ \(mmedia, content) -> do
|
||||||
let rendered = renderCssUrl render content
|
let rendered = toLazyText $ content render
|
||||||
x <- addStaticContent "css" "text/css; charset=utf-8"
|
x <- addStaticContent "css" "text/css; charset=utf-8"
|
||||||
$ encodeUtf8 rendered
|
$ encodeUtf8 rendered
|
||||||
return (mmedia,
|
return (mmedia,
|
||||||
|
|||||||
@ -192,7 +192,7 @@ addWidget = id
|
|||||||
|
|
||||||
-- | Add some raw CSS to the style tag. Applies to all media types.
|
-- | Add some raw CSS to the style tag. Applies to all media types.
|
||||||
addCassius :: Monad m => CssUrl (Route master) -> GGWidget master m ()
|
addCassius :: Monad m => CssUrl (Route master) -> GGWidget master m ()
|
||||||
addCassius x = GWidget $ tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing x) mempty mempty
|
addCassius x = GWidget $ tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ \r -> fromLazyText $ renderCss $ x r) mempty mempty
|
||||||
|
|
||||||
-- | Identical to 'addCassius'.
|
-- | Identical to 'addCassius'.
|
||||||
addLucius :: Monad m => CssUrl (Route master) -> GGWidget master m ()
|
addLucius :: Monad m => CssUrl (Route master) -> GGWidget master m ()
|
||||||
@ -200,7 +200,7 @@ addLucius = addCassius
|
|||||||
|
|
||||||
-- | Add some raw CSS to the style tag, for a specific media type.
|
-- | Add some raw CSS to the style tag, for a specific media type.
|
||||||
addCassiusMedia :: Monad m => Text -> CssUrl (Route master) -> GGWidget master m ()
|
addCassiusMedia :: Monad m => Text -> CssUrl (Route master) -> GGWidget master m ()
|
||||||
addCassiusMedia m x = GWidget $ tell $ GWData mempty mempty mempty mempty (Map.singleton (Just m) x) mempty mempty
|
addCassiusMedia m x = GWidget $ tell $ GWData mempty mempty mempty mempty (Map.singleton (Just m) $ \r -> fromLazyText $ renderCss $ x r) mempty mempty
|
||||||
|
|
||||||
-- | Identical to 'addCassiusMedia'.
|
-- | Identical to 'addCassiusMedia'.
|
||||||
addLuciusMedia :: Monad m => Text -> CssUrl (Route master) -> GGWidget master m ()
|
addLuciusMedia :: Monad m => Text -> CssUrl (Route master) -> GGWidget master m ()
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user