{-# 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
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)
type Css = [(T.Text, [EithUrl])]
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)
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
Right Text
url ->
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)
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
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)
-> Location
-> FilePath
-> 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)) |]
}
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)
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
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)
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)
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
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
develExtraFiles :: Location -> [T.Text] -> IO (Maybe (MimeType, BL.ByteString))
[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