    {-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell, TupleSections, GeneralizedNewtypeDeriving #-}
    module Yesod.EmbeddedStatic.Css.Util where

    import Control.Applicative
    import Control.Monad (void, foldM)
    import Data.Hashable (Hashable)
    import Data.Monoid
    import Network.Mime (MimeType, defaultMimeLookup)
    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 System.FilePath ((</>), takeFileName, takeDirectory, dropExtension)

    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 (Int -> UrlReference -> ShowS
    [UrlReference] -> ShowS
    UrlReference -> [Char]
    (Int -> UrlReference -> ShowS)
    -> (UrlReference -> [Char])
    -> ([UrlReference] -> ShowS)
    -> Show UrlReference
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UrlReference -> ShowS
    showsPrec :: Int -> UrlReference -> ShowS
    $cshow :: UrlReference -> [Char]
    show :: UrlReference -> [Char]
    $cshowList :: [UrlReference] -> ShowS
    showList :: [UrlReference] -> ShowS
    Show, UrlReference -> UrlReference -> Bool
    (UrlReference -> UrlReference -> Bool)
    -> (UrlReference -> UrlReference -> Bool) -> Eq UrlReference
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UrlReference -> UrlReference -> Bool
    == :: UrlReference -> UrlReference -> Bool
    $c/= :: UrlReference -> UrlReference -> Bool
    /= :: UrlReference -> UrlReference -> Bool
    Eq, Eq UrlReference
    Eq UrlReference
    -> (Int -> UrlReference -> Int)
    -> (UrlReference -> Int)
    -> Hashable UrlReference
    Int -> UrlReference -> Int
    UrlReference -> Int
    forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
    $chashWithSalt :: Int -> UrlReference -> Int
    hashWithSalt :: Int -> UrlReference -> Int
    $chash :: UrlReference -> Int
    hash :: UrlReference -> Int
    Hashable, Eq UrlReference
    Eq UrlReference
    -> (UrlReference -> UrlReference -> Ordering)
    -> (UrlReference -> UrlReference -> Bool)
    -> (UrlReference -> UrlReference -> Bool)
    -> (UrlReference -> UrlReference -> Bool)
    -> (UrlReference -> UrlReference -> Bool)
    -> (UrlReference -> UrlReference -> UrlReference)
    -> (UrlReference -> UrlReference -> UrlReference)
    -> Ord UrlReference
    UrlReference -> UrlReference -> Bool
    UrlReference -> UrlReference -> Ordering
    UrlReference -> UrlReference -> UrlReference
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: UrlReference -> UrlReference -> Ordering
    compare :: UrlReference -> UrlReference -> Ordering
    $c< :: UrlReference -> UrlReference -> Bool
    < :: UrlReference -> UrlReference -> Bool
    $c<= :: UrlReference -> UrlReference -> Bool
    <= :: UrlReference -> UrlReference -> Bool
    $c> :: UrlReference -> UrlReference -> Bool
    > :: UrlReference -> UrlReference -> Bool
    $c>= :: UrlReference -> UrlReference -> Bool
    >= :: UrlReference -> UrlReference -> Bool
    $cmax :: UrlReference -> UrlReference -> UrlReference
    max :: UrlReference -> UrlReference -> UrlReference
    $cmin :: UrlReference -> UrlReference -> UrlReference
    min :: UrlReference -> UrlReference -> UrlReference
    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 :: Parser Text
    parseUrl = do
        Parser ()
    P.skipSpace
        Parser Text -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser Text
    P.string Text
    "url('"
        (Char -> Bool) -> Parser Text
    P.takeTill (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\'')

    checkForUrl :: T.Text -> T.Text -> EithUrl
    checkForUrl :: Text -> Text -> EithUrl
    checkForUrl n :: Text
    n@(Text
    "background-image") Text
    v = Text -> Text -> EithUrl
    parseBackgroundImage Text
    n Text
    v
    checkForUrl n :: Text
    n@(Text
    "src") Text
    v = Text -> Text -> EithUrl
    parseBackgroundImage Text
    n Text
    v
    checkForUrl Text
    n Text
    v = (Text
    n, Text -> Either Text UrlReference
    forall a b. a -> Either a b
    Left Text
    v)

    -- | Check if a given CSS attribute is a background image referencing a local file
    checkForImage :: T.Text -> T.Text -> EithUrl
    checkForImage :: Text -> Text -> EithUrl
    checkForImage n :: Text
    n@(Text
    "background-image") Text
    v = Text -> Text -> EithUrl
    parseBackgroundImage Text
    n Text
    v
    checkForImage Text
    n Text
    v = (Text
    n, Text -> Either Text UrlReference
    forall a b. a -> Either a b
    Left Text
    v)

    parseBackgroundImage :: T.Text -> T.Text -> EithUrl
    parseBackgroundImage :: Text -> Text -> EithUrl
    parseBackgroundImage Text
    n Text
    v = (Text
    n, case Parser Text -> Text -> Either [Char] Text
    forall a. Parser a -> Text -> Either [Char] a
    P.parseOnly Parser Text
    parseUrl Text
    v of
        Left [Char]
    _ -> Text -> Either Text UrlReference
    forall a b. a -> Either a b
    Left Text
    v -- Can't parse url
        Right Text
    url -> -- maybe we should find a uri parser
            if (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Text -> Text -> Bool
    `T.isPrefixOf` Text
    url) [Text
    "http://", Text
    "https://", Text
    "/"]
                then Text -> Either Text UrlReference
    forall a b. a -> Either a b
    Left Text
    v
                else UrlReference -> Either Text UrlReference
    forall a b. b -> Either a b
    Right (UrlReference -> Either Text UrlReference)
    -> UrlReference -> Either Text UrlReference
    forall a b. (a -> b) -> a -> b
    $ Text -> UrlReference
    UrlReference Text
    url)

    parseCssWith :: (T.Text -> T.Text -> EithUrl) -> T.Text -> Either String Css
    parseCssWith :: (Text -> Text -> EithUrl) -> Text -> Either [Char] Css
    parseCssWith Text -> Text -> EithUrl
    urlParser Text
    contents =
        let mparsed :: Either [Char] [CssBlock]
    mparsed = Text -> Either [Char] [CssBlock]
    parseBlocks Text
    contents in
        case Either [Char] [CssBlock]
    mparsed of
            Left [Char]
    err -> [Char] -> Either [Char] Css
    forall a b. a -> Either a b
    Left [Char]
    err
            Right [CssBlock]
    blocks -> Css -> Either [Char] Css
    forall a b. b -> Either a b
    Right [ (Text
    t, ((Text, Text) -> EithUrl) -> [(Text, Text)] -> [EithUrl]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text -> Text -> EithUrl) -> (Text, Text) -> EithUrl
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Text -> Text -> EithUrl
    urlParser) [(Text, Text)]
    b) | (Text
    t,[(Text, Text)]
    b) <- [CssBlock]
    blocks ]

    parseCssUrls :: T.Text -> Either String Css
    parseCssUrls :: Text -> Either [Char] Css
    parseCssUrls = (Text -> Text -> EithUrl) -> Text -> Either [Char] Css
    parseCssWith Text -> Text -> EithUrl
    checkForUrl

    parseCssFileWith :: (T.Text -> T.Text -> EithUrl) -> FilePath -> IO Css
    parseCssFileWith :: (Text -> Text -> EithUrl) -> [Char] -> IO Css
    parseCssFileWith Text -> Text -> EithUrl
    urlParser [Char]
    fp = do
        Either [Char] Css
    mparsed <- (Text -> Text -> EithUrl) -> Text -> Either [Char] Css
    parseCssWith Text -> Text -> EithUrl
    urlParser (Text -> Either [Char] Css) -> IO Text -> IO (Either [Char] Css)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO Text
    T.readFile [Char]
    fp
        case Either [Char] Css
    mparsed of
            Left [Char]
    err -> [Char] -> IO Css
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> IO Css) -> [Char] -> IO Css
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unable to parse " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    fp [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err
            Right Css
    css -> Css -> IO Css
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Css
    css

    parseCssFileUrls :: FilePath -> IO Css
    parseCssFileUrls :: [Char] -> IO Css
    parseCssFileUrls = (Text -> Text -> EithUrl) -> [Char] -> IO Css
    parseCssFileWith Text -> Text -> EithUrl
    checkForUrl

    renderCssWith :: (UrlReference -> T.Text) -> Css -> TL.Text
    renderCssWith :: (UrlReference -> Text) -> Css -> Text
    renderCssWith UrlReference -> Text
    urlRenderer Css
    css =
        Builder -> Text
    TL.toLazyText (Builder -> Text) -> Builder -> Text
    forall a b. (a -> b) -> a -> b
    $ [CssBlock] -> Builder
    renderBlocks [(Text
    n, (EithUrl -> (Text, Text)) -> [EithUrl] -> [(Text, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map EithUrl -> (Text, Text)
    forall {a}. (a, Either Text UrlReference) -> (a, Text)
    render [EithUrl]
    block) | (Text
    n,[EithUrl]
    block) <- Css
    css]
      where
        render :: (a, Either Text UrlReference) -> (a, Text)
    render (a
    n, Left Text
    b) = (a
    n, Text
    b)
        render (a
    n, Right UrlReference
    f) = (a
    n, UrlReference -> Text
    urlRenderer UrlReference
    f)

    -- | Load an image map from the images in the CSS
    loadImages :: FilePath -> Css -> (FilePath -> IO (Maybe a)) -> IO (M.HashMap UrlReference a)
    loadImages :: forall a.
    [Char]
    -> Css -> ([Char] -> IO (Maybe a)) -> IO (HashMap UrlReference a)
    loadImages [Char]
    dir Css
    css [Char] -> IO (Maybe a)
    loadImage = (HashMap UrlReference a
     -> Either Text UrlReference -> IO (HashMap UrlReference a))
    -> HashMap UrlReference a
    -> [Either Text UrlReference]
    -> IO (HashMap UrlReference a)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM HashMap UrlReference a
    -> Either Text UrlReference -> IO (HashMap UrlReference a)
    forall {a}.
    HashMap UrlReference a
    -> Either a UrlReference -> IO (HashMap UrlReference a)
    load HashMap UrlReference a
    forall k v. HashMap k v
    M.empty ([Either Text UrlReference] -> IO (HashMap UrlReference a))
    -> [Either Text UrlReference] -> IO (HashMap UrlReference a)
    forall a b. (a -> b) -> a -> b
    $ [[Either Text UrlReference]] -> [Either Text UrlReference]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [(EithUrl -> Either Text UrlReference)
    -> [EithUrl] -> [Either Text UrlReference]
    forall a b. (a -> b) -> [a] -> [b]
    map EithUrl -> Either Text UrlReference
    forall a b. (a, b) -> b
    snd [EithUrl]
    block | (Text
    _,[EithUrl]
    block) <- Css
    css]
        where
            load :: HashMap UrlReference a
    -> Either a UrlReference -> IO (HashMap UrlReference a)
    load HashMap UrlReference a
    imap (Left a
    _) = HashMap UrlReference a -> IO (HashMap UrlReference a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HashMap UrlReference a
    imap
            load HashMap UrlReference a
    imap (Right UrlReference
    f) | UrlReference
    f UrlReference -> HashMap UrlReference a -> Bool
    forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
    `M.member` HashMap UrlReference a
    imap = HashMap UrlReference a -> IO (HashMap UrlReference a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HashMap UrlReference a
    imap
            load HashMap UrlReference a
    imap (Right f :: UrlReference
    f@(UrlReference Text
    path)) = do
                Maybe a
    img <- [Char] -> IO (Maybe a)
    loadImage ([Char]
    dir [Char] -> ShowS
    </> Text -> [Char]
    T.unpack Text
    path)
                HashMap UrlReference a -> IO (HashMap UrlReference a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HashMap UrlReference a -> IO (HashMap UrlReference a))
    -> HashMap UrlReference a -> IO (HashMap UrlReference a)
    forall a b. (a -> b) -> a -> b
    $ HashMap UrlReference a
    -> (a -> HashMap UrlReference a)
    -> Maybe a
    -> HashMap UrlReference a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe HashMap UrlReference a
    imap (\a
    i -> UrlReference
    -> a -> HashMap UrlReference a -> HashMap UrlReference a
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    M.insert UrlReference
    f a
    i HashMap UrlReference a
    imap) Maybe a
    img

    -- | If you tack on additional CSS post-processing filters, they use this as an argument.
    data CssGeneration = CssGeneration {
                           CssGeneration -> ByteString
    cssContent :: BL.ByteString
                         , CssGeneration -> [Char]
    cssStaticLocation :: Location
                         , CssGeneration -> [Char]
    cssFileLocation :: FilePath
                         }

    mkCssGeneration :: Location -> FilePath -> BL.ByteString -> CssGeneration
    mkCssGeneration :: [Char] -> [Char] -> ByteString -> CssGeneration
    mkCssGeneration [Char]
    loc [Char]
    file ByteString
    content =
        CssGeneration { cssContent :: ByteString
    cssContent = ByteString
    content
                      , cssStaticLocation :: [Char]
    cssStaticLocation = [Char]
    loc
                      , cssFileLocation :: [Char]
    cssFileLocation = [Char]
    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 :: ([Char] -> IO ByteString) -> [Char] -> [Char] -> Entry
    cssProductionFilter [Char] -> IO ByteString
    prodFilter [Char]
    loc [Char]
    file =
        Entry
    forall a. Default a => a
    def { ebHaskellName :: Maybe Name
    ebHaskellName = Name -> Maybe Name
    forall a. a -> Maybe a
    Just (Name -> Maybe Name) -> Name -> Maybe Name
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Name
    pathToName [Char]
    loc
            , ebLocation :: [Char]
    ebLocation = [Char]
    loc
            , ebMimeType :: ByteString
    ebMimeType = ByteString
    "text/css"
            , ebProductionContent :: IO ByteString
    ebProductionContent = [Char] -> IO ByteString
    prodFilter [Char]
    file
            , ebDevelReload :: ExpQ
    ebDevelReload = [| develPassThrough $(Lit -> ExpQ
    forall (m :: * -> *). Quote m => Lit -> m Exp
    litE ([Char] -> Lit
    stringL [Char]
    loc)) $(Lit -> ExpQ
    forall (m :: * -> *). Quote m => Lit -> m Exp
    litE ([Char] -> Lit
    stringL [Char]
    file)) |]
            , ebDevelExtraFiles :: Maybe ExpQ
    ebDevelExtraFiles = Maybe ExpQ
    forall a. Maybe a
    Nothing
            }

    cssProductionImageFilter :: (FilePath -> IO BL.ByteString) -> Location -> FilePath -> Entry
    cssProductionImageFilter :: ([Char] -> IO ByteString) -> [Char] -> [Char] -> Entry
    cssProductionImageFilter [Char] -> IO ByteString
    prodFilter [Char]
    loc [Char]
    file =
      (([Char] -> IO ByteString) -> [Char] -> [Char] -> Entry
    cssProductionFilter [Char] -> IO ByteString
    prodFilter [Char]
    loc [Char]
    file)
        { ebDevelReload :: ExpQ
    ebDevelReload = [| develBgImgB64 $(Lit -> ExpQ
    forall (m :: * -> *). Quote m => Lit -> m Exp
    litE ([Char] -> Lit
    stringL [Char]
    loc)) $(Lit -> ExpQ
    forall (m :: * -> *). Quote m => Lit -> m Exp
    litE ([Char] -> Lit
    stringL [Char]
    file)) |]
        , ebDevelExtraFiles :: Maybe ExpQ
    ebDevelExtraFiles = ExpQ -> Maybe ExpQ
    forall a. a -> Maybe a
    Just [| develExtraFiles $(Lit -> ExpQ
    forall (m :: * -> *). Quote m => Lit -> m Exp
    litE ([Char] -> Lit
    stringL [Char]
    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 :: [Char] -> [Char] -> Parser Builder
    parseBackground [Char]
    loc [Char]
    file = do
        Parser ByteString ByteString -> Parser ByteString ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Parser ByteString ByteString -> Parser ByteString ())
    -> Parser ByteString ByteString -> Parser ByteString ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Parser ByteString ByteString
    PBL.string ByteString
    "background-image"
        ByteString
    s1 <- (Word8 -> Bool) -> Parser ByteString ByteString
    PBL.takeWhile (\Word8
    x -> Word8
    x Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    32 Bool -> Bool -> Bool
    || Word8
    x Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    9) -- space or tab
        Parser ByteString Word8 -> Parser ByteString ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Parser ByteString Word8 -> Parser ByteString ())
    -> Parser ByteString Word8 -> Parser ByteString ()
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Parser ByteString Word8
    PBL.word8 Word8
    58 -- colon
        ByteString
    s2 <- (Word8 -> Bool) -> Parser ByteString ByteString
    PBL.takeWhile (\Word8
    x -> Word8
    x Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    32 Bool -> Bool -> Bool
    || Word8
    x Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    9) -- space or tab
        Parser ByteString ByteString -> Parser ByteString ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Parser ByteString ByteString -> Parser ByteString ())
    -> Parser ByteString ByteString -> Parser ByteString ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Parser ByteString ByteString
    PBL.string ByteString
    "url('"
        ByteString
    url <- (Word8 -> Bool) -> Parser ByteString ByteString
    PBL.takeWhile (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    39) -- single quote
        Parser ByteString ByteString -> Parser ByteString ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Parser ByteString ByteString -> Parser ByteString ())
    -> Parser ByteString ByteString -> Parser ByteString ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Parser ByteString ByteString
    PBL.string ByteString
    "')"

        let b64 :: ByteString
    b64 = ByteString -> ByteString
    B64.encode (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    T.encodeUtf8 ([Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ ShowS
    takeDirectory [Char]
    file) ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    url
            newUrl :: Builder
    newUrl = [Char] -> Builder
    B.fromString (ShowS
    takeFileName [Char]
    loc) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    B.fromString [Char]
    "/" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    B.fromByteString ByteString
    b64

        Builder -> Parser Builder
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Builder -> Parser Builder) -> Builder -> Parser Builder
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    B.fromByteString ByteString
    "background-image"
              Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    B.fromByteString ByteString
    s1
              Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    B.fromByteString ByteString
    ":"
              Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    B.fromByteString ByteString
    s2
              Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    B.fromByteString ByteString
    "url('"
              Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    newUrl
              Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    B.fromByteString ByteString
    "')"

    parseDev :: Location -> FilePath -> B.Builder -> PBL.Parser B.Builder
    parseDev :: [Char] -> [Char] -> Builder -> Parser Builder
    parseDev [Char]
    loc [Char]
    file Builder
    b = do
        Builder
    b' <- [Char] -> [Char] -> Parser Builder
    parseBackground [Char]
    loc [Char]
    file Parser Builder -> Parser Builder -> Parser Builder
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Word8 -> Builder
    B.fromWord8 (Word8 -> Builder) -> Parser ByteString Word8 -> Parser Builder
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Word8
    PBL.anyWord8)
        (Parser ByteString ()
    forall t. Chunk t => Parser t ()
    PBL.endOfInput Parser ByteString () -> Parser Builder -> Parser Builder
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Builder -> Parser Builder
    forall a. a -> Parser ByteString a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Builder -> Parser Builder) -> Builder -> Parser Builder
    forall a b. (a -> b) -> a -> b
    $! Builder
    b Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    b')) Parser Builder -> Parser Builder -> Parser Builder
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ([Char] -> [Char] -> Builder -> Parser Builder
    parseDev [Char]
    loc [Char]
    file (Builder -> Parser Builder) -> Builder -> Parser Builder
    forall a b. (a -> b) -> a -> b
    $! Builder
    b Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    b')

    develPassThrough :: Location -> FilePath -> IO BL.ByteString
    develPassThrough :: [Char] -> [Char] -> IO ByteString
    develPassThrough [Char]
    _ = [Char] -> IO ByteString
    BL.readFile

    -- | Create the CSS during development
    develBgImgB64 :: Location -> FilePath -> IO BL.ByteString
    develBgImgB64 :: [Char] -> [Char] -> IO ByteString
    develBgImgB64 [Char]
    loc [Char]
    file = do
        ByteString
    ct <- [Char] -> IO ByteString
    BL.readFile [Char]
    file
        case Result Builder -> Either [Char] Builder
    forall r. Result r -> Either [Char] r
    PBL.eitherResult (Result Builder -> Either [Char] Builder)
    -> Result Builder -> Either [Char] Builder
    forall a b. (a -> b) -> a -> b
    $ Parser Builder -> ByteString -> Result Builder
    forall a. Parser a -> ByteString -> Result a
    PBL.parse ([Char] -> [Char] -> Builder -> Parser Builder
    parseDev [Char]
    loc [Char]
    file Builder
    forall a. Monoid a => a
    mempty) ByteString
    ct of
            Left [Char]
    err -> [Char] -> IO ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    err
            Right Builder
    b -> ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> ByteString
    B.toLazyByteString Builder
    b

    -- | Serve the extra image files during development
    develExtraFiles :: Location -> [T.Text] -> IO (Maybe (MimeType, BL.ByteString))
    develExtraFiles :: [Char] -> [Text] -> IO (Maybe (ByteString, ByteString))
    develExtraFiles [Char]
    loc [Text]
    parts =
        case [Text] -> [Text]
    forall a. [a] -> [a]
    reverse [Text]
    parts of
            (Text
    file:[Text]
    dir) | [Char] -> Text
    T.pack [Char]
    loc Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> [Text] -> Text
    T.intercalate Text
    "/" ([Text] -> [Text]
    forall a. [a] -> [a]
    reverse [Text]
    dir) -> do
                let file' :: Text
    file' = ByteString -> Text
    T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    B64.decodeLenient (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ ShowS
    dropExtension ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack Text
    file
                ByteString
    ct <- [Char] -> IO ByteString
    BL.readFile ([Char] -> IO ByteString) -> [Char] -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack Text
    file'
                Maybe (ByteString, ByteString)
    -> IO (Maybe (ByteString, ByteString))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (ByteString, ByteString)
     -> IO (Maybe (ByteString, ByteString)))
    -> Maybe (ByteString, ByteString)
    -> IO (Maybe (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ (ByteString, ByteString) -> Maybe (ByteString, ByteString)
    forall a. a -> Maybe a
    Just (Text -> ByteString
    defaultMimeLookup Text
    file', ByteString
    ct)
            [Text]
    _ -> Maybe (ByteString, ByteString)
    -> IO (Maybe (ByteString, ByteString))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (ByteString, ByteString)
    forall a. Maybe a
    Nothing