    {-# 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 -> String
    (Int -> UrlReference -> ShowS)
    -> (UrlReference -> String)
    -> ([UrlReference] -> ShowS)
    -> Show UrlReference
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [UrlReference] -> ShowS
    $cshowList :: [UrlReference] -> ShowS
    show :: UrlReference -> String
    $cshow :: UrlReference -> String
    showsPrec :: Int -> UrlReference -> ShowS
    $cshowsPrec :: Int -> UrlReference -> ShowS
    Show, UrlReference -> UrlReference -> Bool
    (UrlReference -> UrlReference -> Bool)
    -> (UrlReference -> UrlReference -> Bool) -> Eq UrlReference
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: UrlReference -> UrlReference -> Bool
    $c/= :: UrlReference -> UrlReference -> Bool
    == :: UrlReference -> UrlReference -> Bool
    $c== :: UrlReference -> UrlReference -> Bool
    Eq, Int -> UrlReference -> Int
    UrlReference -> Int
    (Int -> UrlReference -> Int)
    -> (UrlReference -> Int) -> Hashable UrlReference
    forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
    hash :: UrlReference -> Int
    $chash :: UrlReference -> Int
    hashWithSalt :: Int -> UrlReference -> Int
    $chashWithSalt :: Int -> 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
    min :: UrlReference -> UrlReference -> UrlReference
    $cmin :: UrlReference -> UrlReference -> UrlReference
    max :: UrlReference -> UrlReference -> UrlReference
    $cmax :: UrlReference -> UrlReference -> UrlReference
    >= :: UrlReference -> UrlReference -> Bool
    $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
    compare :: UrlReference -> UrlReference -> Ordering
    $ccompare :: UrlReference -> UrlReference -> Ordering
    $cp1Ord :: Eq 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 "url('"
        (Char -> Bool) -> Parser Text
    P.takeTill (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\'')

    checkForUrl :: T.Text -> T.Text -> EithUrl
    checkForUrl :: Text -> Text -> EithUrl
    checkForUrl n :: Text
    n@(Text
    "background-image") v :: Text
    v = Text -> Text -> EithUrl
    parseBackgroundImage Text
    n Text
    v
    checkForUrl n :: Text
    n@(Text
    "src") v :: Text
    v = Text -> Text -> EithUrl
    parseBackgroundImage Text
    n Text
    v
    checkForUrl n :: Text
    n v :: 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") v :: Text
    v = Text -> Text -> EithUrl
    parseBackgroundImage Text
    n Text
    v
    checkForImage n :: Text
    n v :: 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 n :: Text
    n v :: Text
    v = (Text
    n, case Parser Text -> Text -> Either String Text
    forall a. Parser a -> Text -> Either String a
    P.parseOnly Parser Text
    parseUrl Text
    v of
        Left _ -> Text -> Either Text UrlReference
    forall a b. a -> Either a b
    Left Text
    v -- Can't parse url
        Right url :: 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) ["http://", "https://", "/"]
                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 String Css
    parseCssWith urlParser :: Text -> Text -> EithUrl
    urlParser contents :: Text
    contents =
        let mparsed :: Either String [CssBlock]
    mparsed = Text -> Either String [CssBlock]
    parseBlocks Text
    contents in
        case Either String [CssBlock]
    mparsed of
            Left err :: String
    err -> String -> Either String Css
    forall a b. a -> Either a b
    Left String
    err
            Right blocks :: [CssBlock]
    blocks -> Css -> Either String 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) | (t :: Text
    t,b :: [(Text, Text)]
    b) <- [CssBlock]
    blocks ]

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

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

    parseCssFileUrls :: FilePath -> IO Css
    parseCssFileUrls :: String -> IO Css
    parseCssFileUrls = (Text -> Text -> EithUrl) -> String -> IO Css
    parseCssFileWith Text -> Text -> EithUrl
    checkForUrl

    renderCssWith :: (UrlReference -> T.Text) -> Css -> TL.Text
    renderCssWith :: (UrlReference -> Text) -> Css -> Text
    renderCssWith urlRenderer :: UrlReference -> Text
    urlRenderer css :: 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) | (n :: Text
    n,block :: [EithUrl]
    block) <- Css
    css]
      where
        render :: (a, Either Text UrlReference) -> (a, Text)
    render (n :: a
    n, Left b :: Text
    b) = (a
    n, Text
    b)
        render (n :: a
    n, Right f :: 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 :: String
    -> Css -> (String -> IO (Maybe a)) -> IO (HashMap UrlReference a)
    loadImages dir :: String
    dir css :: Css
    css loadImage :: String -> 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 | (_,block :: [EithUrl]
    block) <- Css
    css]
        where
            load :: HashMap UrlReference a
    -> Either a UrlReference -> IO (HashMap UrlReference a)
    load imap :: HashMap UrlReference a
    imap (Left _) = HashMap UrlReference a -> IO (HashMap UrlReference a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HashMap UrlReference a
    imap
            load imap :: HashMap UrlReference a
    imap (Right f :: 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 (m :: * -> *) a. Monad m => a -> m a
    return HashMap UrlReference a
    imap
            load imap :: HashMap UrlReference a
    imap (Right f :: UrlReference
    f@(UrlReference path :: Text
    path)) = do
                Maybe a
    img <- String -> IO (Maybe a)
    loadImage (String
    dir String -> ShowS
    </> Text -> String
    T.unpack Text
    path)
                HashMap UrlReference a -> IO (HashMap UrlReference 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 (\i :: 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 -> String
    cssStaticLocation :: Location
                         , CssGeneration -> String
    cssFileLocation :: FilePath
                         }

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

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

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

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

    parseDev :: Location -> FilePath -> B.Builder -> PBL.Parser B.Builder
    parseDev :: String -> String -> Builder -> Parser Builder
    parseDev loc :: String
    loc file :: String
    file b :: Builder
    b = do
        Builder
    b' <- String -> String -> Parser Builder
    parseBackground String
    loc String
    file Parser Builder -> Parser Builder -> Parser Builder
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Word8 -> Builder
    B.fromWord8 (Word8 -> Builder) -> Parser MimeType Word8 -> Parser Builder
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser MimeType Word8
    PBL.anyWord8)
        (Parser MimeType ()
    forall t. Chunk t => Parser t ()
    PBL.endOfInput Parser MimeType () -> Parser Builder -> Parser Builder
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Builder -> Parser Builder
    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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (String -> String -> Builder -> Parser Builder
    parseDev String
    loc String
    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 :: String -> String -> IO ByteString
    develPassThrough _ = String -> IO ByteString
    BL.readFile

    -- | Create the CSS during development
    develBgImgB64 :: Location -> FilePath -> IO BL.ByteString
    develBgImgB64 :: String -> String -> IO ByteString
    develBgImgB64 loc :: String
    loc file :: String
    file = do
        ByteString
    ct <- String -> IO ByteString
    BL.readFile String
    file
        case Result Builder -> Either String Builder
    forall r. Result r -> Either String r
    PBL.eitherResult (Result Builder -> Either String Builder)
    -> Result Builder -> Either String Builder
    forall a b. (a -> b) -> a -> b
    $ Parser Builder -> ByteString -> Result Builder
    forall a. Parser a -> ByteString -> Result a
    PBL.parse (String -> String -> Builder -> Parser Builder
    parseDev String
    loc String
    file Builder
    forall a. Monoid a => a
    mempty) ByteString
    ct of
            Left err :: String
    err -> String -> IO ByteString
    forall a. HasCallStack => String -> a
    error String
    err
            Right b :: Builder
    b -> ByteString -> IO ByteString
    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 :: String -> [Text] -> IO (Maybe (MimeType, ByteString))
    develExtraFiles loc :: String
    loc parts :: [Text]
    parts =
        case [Text] -> [Text]
    forall a. [a] -> [a]
    reverse [Text]
    parts of
            (file :: Text
    file:dir :: [Text]
    dir) | String -> Text
    T.pack String
    loc Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> [Text] -> Text
    T.intercalate "/" ([Text] -> [Text]
    forall a. [a] -> [a]
    reverse [Text]
    dir) -> do
                let file' :: Text
    file' = MimeType -> Text
    T.decodeUtf8 (MimeType -> Text) -> MimeType -> Text
    forall a b. (a -> b) -> a -> b
    $ MimeType -> MimeType
    B64.decodeLenient (MimeType -> MimeType) -> MimeType -> MimeType
    forall a b. (a -> b) -> a -> b
    $ Text -> MimeType
    T.encodeUtf8 (Text -> MimeType) -> Text -> MimeType
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ ShowS
    dropExtension ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    file
                ByteString
    ct <- String -> IO ByteString
    BL.readFile (String -> IO ByteString) -> String -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    file'
                Maybe (MimeType, ByteString) -> IO (Maybe (MimeType, ByteString))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (MimeType, ByteString) -> IO (Maybe (MimeType, ByteString)))
    -> Maybe (MimeType, ByteString)
    -> IO (Maybe (MimeType, ByteString))
    forall a b. (a -> b) -> a -> b
    $ (MimeType, ByteString) -> Maybe (MimeType, ByteString)
    forall a. a -> Maybe a
    Just (Text -> MimeType
    defaultMimeLookup Text
    file', ByteString
    ct)
            _ -> Maybe (MimeType, ByteString) -> IO (Maybe (MimeType, ByteString))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (MimeType, ByteString)
    forall a. Maybe a
    Nothing