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