diff --git a/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs b/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs index f9403482..14b9e9d6 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs @@ -7,6 +7,8 @@ module Yesod.EmbeddedStatic.Css.AbsoluteUrl ( absoluteUrls , absoluteUrlsAt , absoluteUrlsWith + , absCssUrlsFileProd + , absCssUrlsProd ) where import Prelude hiding (FilePath) @@ -15,6 +17,7 @@ import Yesod.EmbeddedStatic.Types import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T +import qualified Data.Text.IO as T import qualified Data.Text.Lazy.Encoding as TL import Control.Monad ((>=>)) import Data.Maybe (fromMaybe) @@ -27,13 +30,20 @@ import Yesod.EmbeddedStatic.Css.Util ------------------------------------------------------------------------------- -- | Anchors relative CSS image urls -createAbsCssUrlsProd :: FilePath -- ^ Anchor relative urls to here +absCssUrlsFileProd :: FilePath -- ^ Anchor relative urls to here -> FilePath -> IO BL.ByteString -createAbsCssUrlsProd dir file = do - css <- parseCssUrls file - let r = renderCssWith toAbsoluteUrl css - return $ TL.encodeUtf8 r +absCssUrlsFileProd dir file = do + contents <- T.readFile (encodeString file) + return $ absCssUrlsProd dir contents + +absCssUrlsProd :: FilePath -- ^ Anchor relative urls to here + -> T.Text + -> BL.ByteString +absCssUrlsProd dir contents = + let css = either error id $ parseCssUrls contents + r = renderCssWith toAbsoluteUrl css + in TL.encodeUtf8 r where toAbsoluteUrl (UrlReference rel) = T.concat [ "url('/" @@ -64,7 +74,7 @@ absoluteUrlsWith :: -> Maybe (CssGeneration -> IO BL.ByteString) -- ^ Another filter function run after this one (for example @return . yuiCSS . cssContent@) or other CSS filter that runs after this filter. -> Generator absoluteUrlsWith loc file mpostFilter = - return [ cssProductionFilter (createAbsCssUrlsProd (decodeString loc) >=> postFilter . mkCssGeneration loc file) loc file + return [ cssProductionFilter (absCssUrlsFileProd (decodeString loc) >=> postFilter . mkCssGeneration loc file) loc file ] where postFilter = fromMaybe (return . cssContent) mpostFilter diff --git a/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs index 70819a54..9219cba6 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs @@ -67,20 +67,25 @@ parseBackgroundImage n v = case P.parseOnly parseUrl v of | "/" `T.isPrefixOf` url -> (n, Left v) | otherwise -> (n, Right $ UrlReference url) -parseCssWith :: (T.Text -> T.Text -> EithUrl) -> FilePath -> IO Css -parseCssWith urlParser fp = do - mparsed <- parseBlocks <$> T.readFile (encodeString fp) +parseCssWith :: (T.Text -> T.Text -> EithUrl) -> T.Text -> Either String Css +parseCssWith urlParser contents = + let mparsed = parseBlocks contents in case mparsed of - Left err -> fail $ "Unable to parse " ++ encodeString fp ++ ": " ++ err - Right blocks -> - return [ (t, map (uncurry urlParser) b) | (t,b) <- blocks ] + Left err -> Left err + Right blocks -> Right [ (t, map (uncurry urlParser) b) | (t,b) <- blocks ] -parseCssUrls :: FilePath -> IO Css +parseCssUrls :: T.Text -> Either String Css parseCssUrls = parseCssWith checkForUrl --- | Parse the CSS from the file. If a parse error occurs, a failure is raised (exception) -parseCss :: FilePath -> IO Css -parseCss = parseCssWith checkForImage +parseCssFileWith :: (T.Text -> T.Text -> EithUrl) -> FilePath -> IO Css +parseCssFileWith urlParser fp = do + mparsed <- parseCssWith urlParser <$> T.readFile (encodeString fp) + case mparsed of + Left err -> fail $ "Unable to parse " ++ encodeString fp ++ ": " ++ err + Right css -> return css + +parseCssFileUrls :: FilePath -> IO Css +parseCssFileUrls = parseCssFileWith checkForUrl renderCssWith :: (UrlReference -> T.Text) -> Css -> TL.Text renderCssWith urlRenderer css =