From c3976efea9b74d10eda502b78a54757380f1c870 Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Thu, 2 Jan 2014 11:46:18 -0800 Subject: [PATCH 1/7] make relative css urls absolute --- .../Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs | 70 +++++++ yesod-static/Yesod/EmbeddedStatic/Css/Util.hs | 191 ++++++++++++++++++ yesod-static/yesod-static.cabal | 9 +- 3 files changed, 269 insertions(+), 1 deletion(-) create mode 100644 yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs create mode 100644 yesod-static/Yesod/EmbeddedStatic/Css/Util.hs diff --git a/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs b/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs new file mode 100644 index 00000000..f9403482 --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Manipulate CSS urls. +-- +-- * Make relative urls absolute (useful when combining assets) +module Yesod.EmbeddedStatic.Css.AbsoluteUrl ( + -- * Absolute urls + absoluteUrls + , absoluteUrlsAt + , absoluteUrlsWith +) where + +import Prelude hiding (FilePath) +import Yesod.EmbeddedStatic.Generators +import Yesod.EmbeddedStatic.Types + +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Data.Text.Lazy.Encoding as TL +import Control.Monad ((>=>)) +import Data.Maybe (fromMaybe) +import Filesystem.Path.CurrentOS ((), collapse, FilePath, fromText, toText, encodeString, decodeString) + +import Yesod.EmbeddedStatic.Css.Util + +------------------------------------------------------------------------------- +-- Generator +------------------------------------------------------------------------------- + +-- | Anchors relative CSS image urls +createAbsCssUrlsProd :: 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 + where + toAbsoluteUrl (UrlReference rel) = T.concat + [ "url('/" + , (either id id $ toText $ collapse $ dir fromText rel) + , "')" + ] + + +-- | Equivalent to passing the same string twice to 'absoluteUrlsAt'. +absoluteUrls :: FilePath -> Generator +absoluteUrls f = absoluteUrlsAt (encodeString f) f + +-- | Equivalent to passing @return@ to 'absoluteUrlsWith'. +absoluteUrlsAt :: Location -> FilePath -> Generator +absoluteUrlsAt loc f = absoluteUrlsWith loc f Nothing + +-- | Automatically make relative urls absolute +-- +-- During development, leave CSS as is. +-- +-- When CSS is organized into a directory structure, it will work properly for individual requests for each file. +-- During production, we want to combine and minify CSS as much as possible. +-- The combination process combines files from different directories, messing up relative urls. +-- This pre-processor makes relative urls absolute +absoluteUrlsWith :: + Location -- ^ The location the CSS file should appear in the static subsite + -> FilePath -- ^ Path to the CSS file. + -> 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 + ] + where + postFilter = fromMaybe (return . cssContent) mpostFilter diff --git a/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs new file mode 100644 index 00000000..70819a54 --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs @@ -0,0 +1,191 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell, TupleSections, GeneralizedNewtypeDeriving #-} +module Yesod.EmbeddedStatic.Css.Util where + +import Prelude hiding (FilePath) +import Control.Applicative +import Control.Monad (void, foldM) +import Data.Hashable (Hashable) +import Data.Monoid +import Network.Mime (MimeType, defaultMimeLookup) +import Filesystem.Path.CurrentOS (FilePath, directory, (), dropExtension, filename, toText, decodeString, encodeString, fromText) +import Text.CSS.Parse (parseBlocks) +import Language.Haskell.TH (litE, stringL) +import Text.CSS.Render (renderBlocks) +import Yesod.EmbeddedStatic.Types +import Yesod.EmbeddedStatic (pathToName) +import Data.Default (def) + +import qualified Blaze.ByteString.Builder as B +import qualified Blaze.ByteString.Builder.Char.Utf8 as B +import qualified Data.Attoparsec.Text as P +import qualified Data.Attoparsec.ByteString.Lazy as PBL +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Base64 as B64 +import qualified Data.HashMap.Lazy as M +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TL + +------------------------------------------------------------------------------- +-- Loading CSS +------------------------------------------------------------------------------- + +-- | In the parsed CSS, this will be an image reference that we want to replace. +-- the contents will be the filepath. +newtype UrlReference = UrlReference T.Text + deriving (Show, Eq, Hashable, Ord) + +type EithUrl = (T.Text, Either T.Text UrlReference) + +-- | The parsed CSS +type Css = [(T.Text, [EithUrl])] + +-- | Parse the filename out of url('filename') +parseUrl :: P.Parser T.Text +parseUrl = do + P.skipSpace + void $ P.string "url('" + P.takeTill (== '\'') + +checkForUrl :: T.Text -> T.Text -> EithUrl +checkForUrl n@("background-image") v = parseBackgroundImage n v +checkForUrl n@("src") v = parseBackgroundImage n v +checkForUrl n v = (n, Left v) + +-- | Check if a given CSS attribute is a background image referencing a local file +checkForImage :: T.Text -> T.Text -> EithUrl +checkForImage n@("background-image") v = parseBackgroundImage n v +checkForImage n v = (n, Left v) + +parseBackgroundImage :: T.Text -> T.Text -> EithUrl +parseBackgroundImage n v = case P.parseOnly parseUrl v of + Left _ -> (n, Left v) -- Can't parse url + Right url + | "http" `T.isPrefixOf` url -> (n, Left v) + | "/" `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) + case mparsed of + Left err -> fail $ "Unable to parse " ++ encodeString fp ++ ": " ++ err + Right blocks -> + return [ (t, map (uncurry urlParser) b) | (t,b) <- blocks ] + +parseCssUrls :: FilePath -> IO 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 + +renderCssWith :: (UrlReference -> T.Text) -> Css -> TL.Text +renderCssWith urlRenderer css = + TL.toLazyText $ renderBlocks [(n, map render block) | (n,block) <- css] + where + render (n, Left b) = (n, b) + render (n, Right f) = (n, urlRenderer f) + +-- | Load an image map from the images in the CSS +loadImages :: FilePath -> Css -> (FilePath -> IO (Maybe a)) -> IO (M.HashMap UrlReference a) +loadImages dir css loadImage = foldM load M.empty $ concat [map snd block | (_,block) <- css] + where + load imap (Left _) = return imap + load imap (Right f) | f `M.member` imap = return imap + load imap (Right f@(UrlReference path)) = do + img <- loadImage (dir fromText path) + return $ maybe imap (\i -> M.insert f i imap) img + + +-- | If you tack on additional CSS post-processing filters, they use this as an argument. +data CssGeneration = CssGeneration { + cssContent :: BL.ByteString + , cssStaticLocation :: Location + , cssFileLocation :: FilePath + } + +mkCssGeneration :: Location -> FilePath -> BL.ByteString -> CssGeneration +mkCssGeneration loc file content = + CssGeneration { cssContent = content + , cssStaticLocation = loc + , cssFileLocation = file + } + +cssProductionFilter :: + (FilePath -> IO BL.ByteString) -- ^ a filter to be run on production + -> Location -- ^ The location the CSS file should appear in the static subsite + -> FilePath -- ^ Path to the CSS file. + -> Entry +cssProductionFilter prodFilter loc file = + def { ebHaskellName = Just $ pathToName loc + , ebLocation = loc + , ebMimeType = "text/css" + , ebProductionContent = prodFilter file + , ebDevelReload = [| develPassThrough $(litE (stringL loc)) $(litE (stringL $ encodeString file)) |] + , ebDevelExtraFiles = Nothing + } + +cssProductionImageFilter :: (FilePath -> IO BL.ByteString) -> Location -> FilePath -> Entry +cssProductionImageFilter prodFilter loc file = + (cssProductionFilter prodFilter loc file) + { ebDevelReload = [| develBgImgB64 $(litE (stringL loc)) $(litE (stringL $ encodeString file)) |] + , ebDevelExtraFiles = Just [| develExtraFiles $(litE (stringL loc)) |] + } + +------------------------------------------------------------------------------- +-- Helpers for the generators +------------------------------------------------------------------------------- + +-- For development, all we need to do is update the background-image url to base64 encode it. +-- We want to preserve the formatting (whitespace+newlines) during development so we do not parse +-- using css-parse. Instead we write a simple custom parser. + +parseBackground :: Location -> FilePath -> PBL.Parser B.Builder +parseBackground loc file = do + void $ PBL.string "background-image" + s1 <- PBL.takeWhile (\x -> x == 32 || x == 9) -- space or tab + void $ PBL.word8 58 -- colon + s2 <- PBL.takeWhile (\x -> x == 32 || x == 9) -- space or tab + void $ PBL.string "url('" + url <- PBL.takeWhile (/= 39) -- single quote + void $ PBL.string "')" + + let b64 = B64.encode $ T.encodeUtf8 (either id id $ toText (directory file)) <> url + newUrl = B.fromString (encodeString $ filename $ decodeString loc) <> B.fromString "/" <> B.fromByteString b64 + + return $ B.fromByteString "background-image" + <> B.fromByteString s1 + <> B.fromByteString ":" + <> B.fromByteString s2 + <> B.fromByteString "url('" + <> newUrl + <> B.fromByteString "')" + +parseDev :: Location -> FilePath -> B.Builder -> PBL.Parser B.Builder +parseDev loc file b = do + b' <- parseBackground loc file <|> (B.fromWord8 <$> PBL.anyWord8) + (PBL.endOfInput *> (pure $! b <> b')) <|> (parseDev loc file $! b <> b') + +develPassThrough :: Location -> FilePath -> IO BL.ByteString +develPassThrough _ = BL.readFile . encodeString + +-- | Create the CSS during development +develBgImgB64 :: Location -> FilePath -> IO BL.ByteString +develBgImgB64 loc file = do + ct <- BL.readFile $ encodeString file + case PBL.eitherResult $ PBL.parse (parseDev loc file mempty) ct of + Left err -> error err + Right b -> return $ B.toLazyByteString b + +-- | Serve the extra image files during development +develExtraFiles :: Location -> [T.Text] -> IO (Maybe (MimeType, BL.ByteString)) +develExtraFiles loc parts = + case reverse parts of + (file:dir) | T.pack loc == T.intercalate "/" (reverse dir) -> do + let file' = T.decodeUtf8 $ B64.decodeLenient $ T.encodeUtf8 $ either id id $ toText $ dropExtension $ fromText file + ct <- BL.readFile $ T.unpack file' + return $ Just (defaultMimeLookup file', ct) + _ -> return Nothing diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index 9e1ad67b..85996318 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 1.2.2.5 +version: 1.2.3 license: MIT license-file: LICENSE author: Michael Snoyman @@ -56,12 +56,19 @@ library , process , async + , attoparsec >= 0.10 + , blaze-builder >= 0.3 + , css-text >= 0.1 + , hashable >= 1.1 + exposed-modules: Yesod.Static Yesod.EmbeddedStatic Yesod.EmbeddedStatic.Generators Yesod.EmbeddedStatic.Types + Yesod.EmbeddedStatic.Css.AbsoluteUrl other-modules: Yesod.EmbeddedStatic.Internal + Yesod.EmbeddedStatic.Css.Util ghc-options: -Wall extensions: TemplateHaskell From a2e979ccda75e817002a5314e0317f0eb5136ace Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Thu, 2 Jan 2014 14:33:53 -0800 Subject: [PATCH 2/7] expose url re-writing function --- .../Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs | 22 +++++++++++----- yesod-static/Yesod/EmbeddedStatic/Css/Util.hs | 25 +++++++++++-------- 2 files changed, 31 insertions(+), 16 deletions(-) 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 = From 22caf035ef839e9cae2fbeff63df84c08f56167d Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Thu, 2 Jan 2014 14:42:17 -0800 Subject: [PATCH 3/7] absolute url function returns lazy text --- yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs b/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs index 14b9e9d6..19a9a1fb 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs @@ -17,6 +17,7 @@ import Yesod.EmbeddedStatic.Types import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import qualified Data.Text.IO as T import qualified Data.Text.Lazy.Encoding as TL import Control.Monad ((>=>)) @@ -35,15 +36,14 @@ absCssUrlsFileProd :: FilePath -- ^ Anchor relative urls to here -> IO BL.ByteString absCssUrlsFileProd dir file = do contents <- T.readFile (encodeString file) - return $ absCssUrlsProd dir contents + return $ TL.encodeUtf8 $ absCssUrlsProd dir contents absCssUrlsProd :: FilePath -- ^ Anchor relative urls to here -> T.Text - -> BL.ByteString + -> TL.Text absCssUrlsProd dir contents = let css = either error id $ parseCssUrls contents - r = renderCssWith toAbsoluteUrl css - in TL.encodeUtf8 r + in renderCssWith toAbsoluteUrl css where toAbsoluteUrl (UrlReference rel) = T.concat [ "url('/" From 2ea07ed398bd8c8fab81d3e81911a4213451e477 Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Tue, 7 Jan 2014 15:50:37 -0800 Subject: [PATCH 4/7] use latest css-text version --- yesod-static/yesod-static.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index 85996318..2582a958 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -58,7 +58,7 @@ library , attoparsec >= 0.10 , blaze-builder >= 0.3 - , css-text >= 0.1 + , css-text >= 0.1.2 , hashable >= 1.1 exposed-modules: Yesod.Static From c5df0b0bf4f6d7211247d2bba2fc412881b954a3 Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Fri, 25 Apr 2014 07:54:04 -0700 Subject: [PATCH 6/7] check for a colon and slashes after http --- yesod-static/Yesod/EmbeddedStatic/Css/Util.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs index 9219cba6..6287eb1e 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs @@ -60,12 +60,12 @@ checkForImage n@("background-image") v = parseBackgroundImage n v checkForImage n v = (n, Left v) parseBackgroundImage :: T.Text -> T.Text -> EithUrl -parseBackgroundImage n v = case P.parseOnly parseUrl v of - Left _ -> (n, Left v) -- Can't parse url - Right url - | "http" `T.isPrefixOf` url -> (n, Left v) - | "/" `T.isPrefixOf` url -> (n, Left v) - | otherwise -> (n, Right $ UrlReference url) +parseBackgroundImage n v = (n, case P.parseOnly parseUrl v of + Left _ -> Left v -- Can't parse url + Right url -> + if any (`T.isPrefixOf` url) ["http://", "https://", "/"] + then Left v + else Right $ UrlReference url) parseCssWith :: (T.Text -> T.Text -> EithUrl) -> T.Text -> Either String Css parseCssWith urlParser contents = From c498c77cc33a40aec436a0a2211df13e25f8c35e Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Sun, 27 Apr 2014 08:23:09 -0700 Subject: [PATCH 7/7] test absolute file paths in a cross-platform way --- yesod-static/Yesod/EmbeddedStatic/Css/Util.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs index 6287eb1e..2b0bd504 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs @@ -7,7 +7,7 @@ import Control.Monad (void, foldM) import Data.Hashable (Hashable) import Data.Monoid import Network.Mime (MimeType, defaultMimeLookup) -import Filesystem.Path.CurrentOS (FilePath, directory, (), dropExtension, filename, toText, decodeString, encodeString, fromText) +import Filesystem.Path.CurrentOS (FilePath, directory, (), dropExtension, filename, toText, decodeString, encodeString, fromText, absolute) import Text.CSS.Parse (parseBlocks) import Language.Haskell.TH (litE, stringL) import Text.CSS.Render (renderBlocks) @@ -62,8 +62,8 @@ checkForImage n v = (n, Left v) parseBackgroundImage :: T.Text -> T.Text -> EithUrl parseBackgroundImage n v = (n, case P.parseOnly parseUrl v of Left _ -> Left v -- Can't parse url - Right url -> - if any (`T.isPrefixOf` url) ["http://", "https://", "/"] + Right url -> -- maybe we should find a uri parser + if any (`T.isPrefixOf` url) ["http://", "https://", "//"] || absolute (fromText url) then Left v else Right $ UrlReference url)