{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Text.Pandoc.SelfContained ( makeDataURI, makeSelfContained ) where
import Codec.Compression.GZip as Gzip
import Control.Applicative ((<|>))
import Control.Monad.Trans (lift)
import Data.ByteString (ByteString)
import Data.ByteString.Base64
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import Data.Char (isAlphaNum, isAscii)
import Network.URI (escapeURIString)
import System.FilePath (takeDirectory, takeExtension, (</>))
import Text.HTML.TagSoup
import Text.Pandoc.Class.PandocMonad (PandocMonad (..), fetchItem,
getInputFiles, report, setInputFiles)
import Text.Pandoc.Logging
import Text.Pandoc.Error (PandocError(..))
import Text.Pandoc.MIME (MimeType)
import Text.Pandoc.Shared (isURI, renderTags', trim, tshow)
import Text.Pandoc.UTF8 (toString, toText, fromText)
import Text.Parsec (ParsecT, runParserT)
import Control.Monad.Except (throwError, catchError)
import qualified Text.Parsec as P
isOk :: Char -> Bool
isOk :: Char -> Bool
isOk Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c
makeDataURI :: (MimeType, ByteString) -> T.Text
makeDataURI :: (MimeType, ByteString) -> MimeType
makeDataURI (MimeType
mime, ByteString
raw) =
if Bool
textual
then MimeType
"data:" MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
mime' MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
"," MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> String -> MimeType
T.pack ((Char -> Bool) -> String -> String
escapeURIString Char -> Bool
isOk (ByteString -> String
toString ByteString
raw))
else MimeType
"data:" MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
mime' MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
";base64," MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> ByteString -> MimeType
toText (ByteString -> ByteString
encode ByteString
raw)
where textual :: Bool
textual = MimeType
"text/" MimeType -> MimeType -> Bool
`T.isPrefixOf` MimeType
mime
mime' :: MimeType
mime' = if Bool
textual Bool -> Bool -> Bool
&& (Char -> Bool) -> MimeType -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';') MimeType
mime
then MimeType
mime MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
";charset=utf-8"
else MimeType
mime
isSourceAttribute :: T.Text -> (T.Text, T.Text) -> Bool
isSourceAttribute :: MimeType -> (MimeType, MimeType) -> Bool
isSourceAttribute MimeType
tagname (MimeType
x,MimeType
_) =
MimeType
x MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
== MimeType
"src" Bool -> Bool -> Bool
||
MimeType
x MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
== MimeType
"data-src" Bool -> Bool -> Bool
||
(MimeType
x MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
== MimeType
"href" Bool -> Bool -> Bool
&& MimeType
tagname MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
== MimeType
"link") Bool -> Bool -> Bool
||
MimeType
x MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
== MimeType
"poster" Bool -> Bool -> Bool
||
MimeType
x MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
== MimeType
"data-background-image"
convertTags :: PandocMonad m => [Tag T.Text] -> m [Tag T.Text]
convertTags :: [Tag MimeType] -> m [Tag MimeType]
convertTags [] = [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return []
convertTags (t :: Tag MimeType
t@TagOpen{}:[Tag MimeType]
ts)
| MimeType -> Tag MimeType -> MimeType
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib MimeType
"data-external" Tag MimeType
t MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
== MimeType
"1" = (Tag MimeType
tTag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:) ([Tag MimeType] -> [Tag MimeType])
-> m [Tag MimeType] -> m [Tag MimeType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
ts
convertTags (t :: Tag MimeType
t@(TagOpen MimeType
"script" [(MimeType, MimeType)]
as):tc :: Tag MimeType
tc@(TagClose MimeType
"script"):[Tag MimeType]
ts) =
case MimeType -> Tag MimeType -> MimeType
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib MimeType
"src" Tag MimeType
t of
MimeType
"" -> (Tag MimeType
tTag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:) ([Tag MimeType] -> [Tag MimeType])
-> m [Tag MimeType] -> m [Tag MimeType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
ts
MimeType
src -> do
let typeAttr :: MimeType
typeAttr = MimeType -> Tag MimeType -> MimeType
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib MimeType
"type" Tag MimeType
t
GetDataResult
res <- MimeType -> MimeType -> m GetDataResult
forall (m :: * -> *).
PandocMonad m =>
MimeType -> MimeType -> m GetDataResult
getData MimeType
typeAttr MimeType
src
[Tag MimeType]
rest <- [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
ts
case GetDataResult
res of
AlreadyDataURI MimeType
dataUri -> [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$ MimeType -> [(MimeType, MimeType)] -> Tag MimeType
forall str. str -> [Attribute str] -> Tag str
TagOpen MimeType
"script"
((MimeType
"src",MimeType
dataUri) (MimeType, MimeType)
-> [(MimeType, MimeType)] -> [(MimeType, MimeType)]
forall a. a -> [a] -> [a]
: [(MimeType
x,MimeType
y) | (MimeType
x,MimeType
y) <- [(MimeType, MimeType)]
as, MimeType
x MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
/= MimeType
"src"]) Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:
MimeType -> Tag MimeType
forall str. str -> Tag str
TagClose MimeType
"script" Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: [Tag MimeType]
rest
Fetched (MimeType
mime, ByteString
bs)
| (MimeType
"text/javascript" MimeType -> MimeType -> Bool
`T.isPrefixOf` MimeType
mime Bool -> Bool -> Bool
||
MimeType
"application/javascript" MimeType -> MimeType -> Bool
`T.isPrefixOf` MimeType
mime Bool -> Bool -> Bool
||
MimeType
"application/x-javascript" MimeType -> MimeType -> Bool
`T.isPrefixOf` MimeType
mime) Bool -> Bool -> Bool
&&
Bool -> Bool
not (ByteString
"</script" ByteString -> ByteString -> Bool
`B.isInfixOf` ByteString
bs) ->
[Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$
MimeType -> [(MimeType, MimeType)] -> Tag MimeType
forall str. str -> [Attribute str] -> Tag str
TagOpen MimeType
"script" [(MimeType
"type", MimeType
typeAttr)|Bool -> Bool
not (MimeType -> Bool
T.null MimeType
typeAttr)]
Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: MimeType -> Tag MimeType
forall str. str -> Tag str
TagText (ByteString -> MimeType
toText ByteString
bs)
Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: MimeType -> Tag MimeType
forall str. str -> Tag str
TagClose MimeType
"script"
Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: [Tag MimeType]
rest
| Bool
otherwise ->
[Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$ MimeType -> [(MimeType, MimeType)] -> Tag MimeType
forall str. str -> [Attribute str] -> Tag str
TagOpen MimeType
"script"
((MimeType
"src",(MimeType, ByteString) -> MimeType
makeDataURI (MimeType
mime, ByteString
bs)) (MimeType, MimeType)
-> [(MimeType, MimeType)] -> [(MimeType, MimeType)]
forall a. a -> [a] -> [a]
:
[(MimeType
x,MimeType
y) | (MimeType
x,MimeType
y) <- [(MimeType, MimeType)]
as, MimeType
x MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
/= MimeType
"src"]) Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:
MimeType -> Tag MimeType
forall str. str -> Tag str
TagClose MimeType
"script" Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: [Tag MimeType]
rest
CouldNotFetch PandocError
_ -> [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$ Tag MimeType
tTag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:Tag MimeType
tcTag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:[Tag MimeType]
rest
convertTags (t :: Tag MimeType
t@(TagOpen MimeType
"link" [(MimeType, MimeType)]
as):[Tag MimeType]
ts) =
case MimeType -> Tag MimeType -> MimeType
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib MimeType
"href" Tag MimeType
t of
MimeType
"" -> (Tag MimeType
tTag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:) ([Tag MimeType] -> [Tag MimeType])
-> m [Tag MimeType] -> m [Tag MimeType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
ts
MimeType
src -> do
GetDataResult
res <- MimeType -> MimeType -> m GetDataResult
forall (m :: * -> *).
PandocMonad m =>
MimeType -> MimeType -> m GetDataResult
getData (MimeType -> Tag MimeType -> MimeType
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib MimeType
"type" Tag MimeType
t) MimeType
src
case GetDataResult
res of
AlreadyDataURI MimeType
dataUri -> do
[Tag MimeType]
rest <- [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
ts
[Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$ MimeType -> [(MimeType, MimeType)] -> Tag MimeType
forall str. str -> [Attribute str] -> Tag str
TagOpen MimeType
"link"
((MimeType
"href",MimeType
dataUri) (MimeType, MimeType)
-> [(MimeType, MimeType)] -> [(MimeType, MimeType)]
forall a. a -> [a] -> [a]
: [(MimeType
x,MimeType
y) | (MimeType
x,MimeType
y) <- [(MimeType, MimeType)]
as, MimeType
x MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
/= MimeType
"href"]) Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:
[Tag MimeType]
rest
Fetched (MimeType
mime, ByteString
bs)
| MimeType
"text/css" MimeType -> MimeType -> Bool
`T.isPrefixOf` MimeType
mime
Bool -> Bool -> Bool
&& MimeType -> Bool
T.null (MimeType -> Tag MimeType -> MimeType
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib MimeType
"media" Tag MimeType
t)
Bool -> Bool -> Bool
&& Bool -> Bool
not (ByteString
"</" ByteString -> ByteString -> Bool
`B.isInfixOf` ByteString
bs) -> do
[Tag MimeType]
rest <- [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$
(Tag MimeType -> Bool) -> [Tag MimeType] -> [Tag MimeType]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Tag MimeType -> Tag MimeType -> Bool
forall a. Eq a => a -> a -> Bool
==MimeType -> Tag MimeType
forall str. str -> Tag str
TagClose MimeType
"link") [Tag MimeType]
ts
[Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$
MimeType -> [(MimeType, MimeType)] -> Tag MimeType
forall str. str -> [Attribute str] -> Tag str
TagOpen MimeType
"style" [(MimeType
"type", MimeType
"text/css")]
Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: MimeType -> Tag MimeType
forall str. str -> Tag str
TagText (ByteString -> MimeType
toText ByteString
bs)
Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: MimeType -> Tag MimeType
forall str. str -> Tag str
TagClose MimeType
"style"
Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: [Tag MimeType]
rest
| Bool
otherwise -> do
[Tag MimeType]
rest <- [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
ts
[Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$ MimeType -> [(MimeType, MimeType)] -> Tag MimeType
forall str. str -> [Attribute str] -> Tag str
TagOpen MimeType
"link"
((MimeType
"href",(MimeType, ByteString) -> MimeType
makeDataURI (MimeType
mime, ByteString
bs)) (MimeType, MimeType)
-> [(MimeType, MimeType)] -> [(MimeType, MimeType)]
forall a. a -> [a] -> [a]
:
[(MimeType
x,MimeType
y) | (MimeType
x,MimeType
y) <- [(MimeType, MimeType)]
as, MimeType
x MimeType -> MimeType -> Bool
forall a. Eq a => a -> a -> Bool
/= MimeType
"href"]) Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: [Tag MimeType]
rest
CouldNotFetch PandocError
_ -> do
[Tag MimeType]
rest <- [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
ts
[Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$ Tag MimeType
tTag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:[Tag MimeType]
rest
convertTags (t :: Tag MimeType
t@(TagOpen MimeType
tagname [(MimeType, MimeType)]
as):[Tag MimeType]
ts)
| ((MimeType, MimeType) -> Bool) -> [(MimeType, MimeType)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MimeType -> (MimeType, MimeType) -> Bool
isSourceAttribute MimeType
tagname) [(MimeType, MimeType)]
as
= do
[(MimeType, MimeType)]
as' <- ((MimeType, MimeType) -> m (MimeType, MimeType))
-> [(MimeType, MimeType)] -> m [(MimeType, MimeType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (MimeType, MimeType) -> m (MimeType, MimeType)
forall (m :: * -> *).
PandocMonad m =>
(MimeType, MimeType) -> m (MimeType, MimeType)
processAttribute [(MimeType, MimeType)]
as
[Tag MimeType]
rest <- [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
ts
[Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag MimeType] -> m [Tag MimeType])
-> [Tag MimeType] -> m [Tag MimeType]
forall a b. (a -> b) -> a -> b
$ MimeType -> [(MimeType, MimeType)] -> Tag MimeType
forall str. str -> [Attribute str] -> Tag str
TagOpen MimeType
tagname [(MimeType, MimeType)]
as' Tag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
: [Tag MimeType]
rest
where processAttribute :: (MimeType, MimeType) -> m (MimeType, MimeType)
processAttribute (MimeType
x,MimeType
y) =
if MimeType -> (MimeType, MimeType) -> Bool
isSourceAttribute MimeType
tagname (MimeType
x,MimeType
y)
then do
GetDataResult
res <- MimeType -> MimeType -> m GetDataResult
forall (m :: * -> *).
PandocMonad m =>
MimeType -> MimeType -> m GetDataResult
getData (MimeType -> Tag MimeType -> MimeType
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib MimeType
"type" Tag MimeType
t) MimeType
y
case GetDataResult
res of
AlreadyDataURI MimeType
enc -> (MimeType, MimeType) -> m (MimeType, MimeType)
forall (m :: * -> *) a. Monad m => a -> m a
return (MimeType
x, MimeType
enc)
Fetched (MimeType
mt,ByteString
bs) -> (MimeType, MimeType) -> m (MimeType, MimeType)
forall (m :: * -> *) a. Monad m => a -> m a
return (MimeType
x, (MimeType, ByteString) -> MimeType
makeDataURI (MimeType
mt,ByteString
bs))
CouldNotFetch PandocError
_ -> (MimeType, MimeType) -> m (MimeType, MimeType)
forall (m :: * -> *) a. Monad m => a -> m a
return (MimeType
x, MimeType
y)
else (MimeType, MimeType) -> m (MimeType, MimeType)
forall (m :: * -> *) a. Monad m => a -> m a
return (MimeType
x,MimeType
y)
convertTags (Tag MimeType
t:[Tag MimeType]
ts) = (Tag MimeType
tTag MimeType -> [Tag MimeType] -> [Tag MimeType]
forall a. a -> [a] -> [a]
:) ([Tag MimeType] -> [Tag MimeType])
-> m [Tag MimeType] -> m [Tag MimeType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
ts
cssURLs :: PandocMonad m
=> FilePath -> ByteString -> m ByteString
cssURLs :: String -> ByteString -> m ByteString
cssURLs String
d ByteString
orig = do
Either ParseError ByteString
res <- ParsecT ByteString () m ByteString
-> () -> String -> ByteString -> m (Either ParseError ByteString)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (String -> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
parseCSSUrls String
d) () String
"css" ByteString
orig
case Either ParseError ByteString
res of
Left ParseError
e -> do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ MimeType -> LogMessage
CouldNotParseCSS (MimeType -> LogMessage) -> MimeType -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> MimeType
T.pack (String -> MimeType) -> String -> MimeType
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
orig
Right ByteString
bs -> ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
parseCSSUrls :: PandocMonad m
=> FilePath -> ParsecT ByteString () m ByteString
parseCSSUrls :: String -> ParsecT ByteString () m ByteString
parseCSSUrls String
d = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ParsecT ByteString () m [ByteString]
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m [ByteString]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many
(ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSWhite ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSComment ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
pCSSImport String
d ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
pCSSUrl String
d ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSOther)
pCSSImport :: PandocMonad m
=> FilePath -> ParsecT ByteString () m ByteString
pCSSImport :: String -> ParsecT ByteString () m ByteString
pCSSImport String
d = ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString)
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ do
String -> ParsecT ByteString () m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"@import"
ParsecT ByteString () m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
Either ByteString (MimeType, ByteString)
res <- (ParsecT ByteString () m (MimeType, ByteString)
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (MimeType, ByteString)
pQuoted ParsecT ByteString () m (MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ByteString () m (MimeType, ByteString)
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (MimeType, ByteString)
pUrl) ParsecT ByteString () m (MimeType, ByteString)
-> ((MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString)))
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall (m :: * -> *).
PandocMonad m =>
String
-> (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
handleCSSUrl String
d
ParsecT ByteString () m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
';'
ParsecT ByteString () m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
case Either ByteString (MimeType, ByteString)
res of
Left ByteString
b -> ByteString -> ParsecT ByteString () m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ParsecT ByteString () m ByteString)
-> ByteString -> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack String
"@import " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b
Right (MimeType
_, ByteString
b) -> ByteString -> ParsecT ByteString () m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
pCSSWhite :: PandocMonad m => ParsecT ByteString () m ByteString
pCSSWhite :: ParsecT ByteString () m ByteString
pCSSWhite = Char -> ByteString
B.singleton (Char -> ByteString)
-> ParsecT ByteString () m Char
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space ParsecT ByteString () m ByteString
-> ParsecT ByteString () m () -> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
pCSSComment :: PandocMonad m => ParsecT ByteString () m ByteString
= ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString)
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ do
String -> ParsecT ByteString () m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"/*"
ParsecT ByteString () m Char
-> ParsecT ByteString () m String -> ParsecT ByteString () m String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill ParsecT ByteString () m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar (ParsecT ByteString () m String -> ParsecT ByteString () m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (String -> ParsecT ByteString () m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"*/"))
ByteString -> ParsecT ByteString () m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
pCSSOther :: PandocMonad m => ParsecT ByteString () m ByteString
pCSSOther :: ParsecT ByteString () m ByteString
pCSSOther =
(String -> ByteString
B.pack (String -> ByteString)
-> ParsecT ByteString () m String
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m Char -> ParsecT ByteString () m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (String -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
"u/ \n\r\t")) ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Char -> ByteString
B.singleton (Char -> ByteString)
-> ParsecT ByteString () m Char
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'u') ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Char -> ByteString
B.singleton (Char -> ByteString)
-> ParsecT ByteString () m Char
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'/')
pCSSUrl :: PandocMonad m
=> FilePath -> ParsecT ByteString () m ByteString
pCSSUrl :: String -> ParsecT ByteString () m ByteString
pCSSUrl String
d = ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString)
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ do
Either ByteString (MimeType, ByteString)
res <- ParsecT ByteString () m (MimeType, ByteString)
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (MimeType, ByteString)
pUrl ParsecT ByteString () m (MimeType, ByteString)
-> ((MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString)))
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall (m :: * -> *).
PandocMonad m =>
String
-> (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
handleCSSUrl String
d
case Either ByteString (MimeType, ByteString)
res of
Left ByteString
b -> ByteString -> ParsecT ByteString () m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
Right (MimeType
mt,ByteString
b) -> do
let enc :: MimeType
enc = (MimeType, ByteString) -> MimeType
makeDataURI (MimeType
mt, ByteString
b)
ByteString -> ParsecT ByteString () m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ParsecT ByteString () m ByteString)
-> ByteString -> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ MimeType -> ByteString
fromText (MimeType -> ByteString) -> MimeType -> ByteString
forall a b. (a -> b) -> a -> b
$ MimeType
"url(" MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
enc MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
")"
pQuoted :: PandocMonad m
=> ParsecT ByteString () m (T.Text, ByteString)
pQuoted :: ParsecT ByteString () m (MimeType, ByteString)
pQuoted = ParsecT ByteString () m (MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m (MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString))
-> ParsecT ByteString () m (MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString)
forall a b. (a -> b) -> a -> b
$ do
Char
quote <- String -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"\"'"
MimeType
url <- String -> MimeType
T.pack (String -> MimeType)
-> ParsecT ByteString () m String
-> ParsecT ByteString () m MimeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m Char
-> ParsecT ByteString () m Char -> ParsecT ByteString () m String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill ParsecT ByteString () m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar (Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
quote)
let fallback :: ByteString
fallback = MimeType -> ByteString
fromText (MimeType -> ByteString) -> MimeType -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> MimeType
T.singleton Char
quote MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType -> MimeType
trim MimeType
url MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> Char -> MimeType
T.singleton Char
quote
(MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (MimeType
url, ByteString
fallback)
pUrl :: PandocMonad m
=> ParsecT ByteString () m (T.Text, ByteString)
pUrl :: ParsecT ByteString () m (MimeType, ByteString)
pUrl = ParsecT ByteString () m (MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m (MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString))
-> ParsecT ByteString () m (MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString)
forall a b. (a -> b) -> a -> b
$ do
String -> ParsecT ByteString () m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"url("
ParsecT ByteString () m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
Maybe Char
quote <- Maybe Char
-> ParsecT ByteString () m (Maybe Char)
-> ParsecT ByteString () m (Maybe Char)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Maybe Char
forall a. Maybe a
Nothing (Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> ParsecT ByteString () m Char
-> ParsecT ByteString () m (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"\"'")
MimeType
url <- String -> MimeType
T.pack (String -> MimeType)
-> ParsecT ByteString () m String
-> ParsecT ByteString () m MimeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m Char
-> ParsecT ByteString () m Char -> ParsecT ByteString () m String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill ParsecT ByteString () m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar (ParsecT ByteString () m Char
-> (Char -> ParsecT ByteString () m Char)
-> Maybe Char
-> ParsecT ByteString () m Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ParsecT ByteString () m Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead (Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
')')) Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Maybe Char
quote)
ParsecT ByteString () m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
')'
let fallback :: ByteString
fallback = MimeType -> ByteString
fromText (MimeType
"url(" MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType -> (Char -> MimeType) -> Maybe Char -> MimeType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MimeType
"" Char -> MimeType
T.singleton Maybe Char
quote MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType -> MimeType
trim MimeType
url MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<>
MimeType -> (Char -> MimeType) -> Maybe Char -> MimeType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MimeType
"" Char -> MimeType
T.singleton Maybe Char
quote MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
")")
(MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (MimeType
url, ByteString
fallback)
handleCSSUrl :: PandocMonad m
=> FilePath -> (T.Text, ByteString)
-> ParsecT ByteString () m
(Either ByteString (MimeType, ByteString))
handleCSSUrl :: String
-> (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
handleCSSUrl String
d (MimeType
url, ByteString
fallback) =
case (Char -> Bool) -> String -> String
escapeURIString (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'|') (MimeType -> String
T.unpack (MimeType -> String) -> MimeType -> String
forall a b. (a -> b) -> a -> b
$ MimeType -> MimeType
trim MimeType
url) of
Char
'#':String
_ -> Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString)))
-> Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString (MimeType, ByteString)
forall a b. a -> Either a b
Left ByteString
fallback
Char
'd':Char
'a':Char
't':Char
'a':Char
':':String
_ -> Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString)))
-> Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString (MimeType, ByteString)
forall a b. a -> Either a b
Left ByteString
fallback
String
u -> do let url' :: MimeType
url' = if MimeType -> Bool
isURI (String -> MimeType
T.pack String
u) then String -> MimeType
T.pack String
u else String -> MimeType
T.pack (String
d String -> String -> String
</> String
u)
GetDataResult
res <- m GetDataResult -> ParsecT ByteString () m GetDataResult
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GetDataResult -> ParsecT ByteString () m GetDataResult)
-> m GetDataResult -> ParsecT ByteString () m GetDataResult
forall a b. (a -> b) -> a -> b
$ MimeType -> MimeType -> m GetDataResult
forall (m :: * -> *).
PandocMonad m =>
MimeType -> MimeType -> m GetDataResult
getData MimeType
"" MimeType
url'
case GetDataResult
res of
AlreadyDataURI MimeType
uri -> Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString)))
-> Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString (MimeType, ByteString)
forall a b. a -> Either a b
Left (MimeType -> ByteString
fromText (MimeType -> ByteString) -> MimeType -> ByteString
forall a b. (a -> b) -> a -> b
$ MimeType
"url(" MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
uri MimeType -> MimeType -> MimeType
forall a. Semigroup a => a -> a -> a
<> MimeType
")")
Fetched (MimeType
mt', ByteString
raw) -> do
(MimeType
mt, ByteString
b) <- if MimeType
"text/css" MimeType -> MimeType -> Bool
`T.isPrefixOf` MimeType
mt'
then (MimeType
"text/css",) (ByteString -> (MimeType, ByteString))
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m (MimeType, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ByteString -> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m ByteString
cssURLs String
d ByteString
raw
else (MimeType, ByteString)
-> ParsecT ByteString () m (MimeType, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (MimeType
mt', ByteString
raw)
Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString)))
-> Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall a b. (a -> b) -> a -> b
$ (MimeType, ByteString) -> Either ByteString (MimeType, ByteString)
forall a b. b -> Either a b
Right (MimeType
mt, ByteString
b)
CouldNotFetch PandocError
_ -> Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString)))
-> Either ByteString (MimeType, ByteString)
-> ParsecT
ByteString () m (Either ByteString (MimeType, ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString (MimeType, ByteString)
forall a b. a -> Either a b
Left ByteString
fallback
data GetDataResult =
AlreadyDataURI T.Text
| CouldNotFetch PandocError
| Fetched (MimeType, ByteString)
deriving (Int -> GetDataResult -> String -> String
[GetDataResult] -> String -> String
GetDataResult -> String
(Int -> GetDataResult -> String -> String)
-> (GetDataResult -> String)
-> ([GetDataResult] -> String -> String)
-> Show GetDataResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GetDataResult] -> String -> String
$cshowList :: [GetDataResult] -> String -> String
show :: GetDataResult -> String
$cshow :: GetDataResult -> String
showsPrec :: Int -> GetDataResult -> String -> String
$cshowsPrec :: Int -> GetDataResult -> String -> String
Show)
getData :: PandocMonad m
=> MimeType -> T.Text
-> m GetDataResult
getData :: MimeType -> MimeType -> m GetDataResult
getData MimeType
mimetype MimeType
src
| MimeType
"data:" MimeType -> MimeType -> Bool
`T.isPrefixOf` MimeType
src = GetDataResult -> m GetDataResult
forall (m :: * -> *) a. Monad m => a -> m a
return (GetDataResult -> m GetDataResult)
-> GetDataResult -> m GetDataResult
forall a b. (a -> b) -> a -> b
$ MimeType -> GetDataResult
AlreadyDataURI MimeType
src
| Bool
otherwise = m GetDataResult
-> (PandocError -> m GetDataResult) -> m GetDataResult
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m GetDataResult
fetcher PandocError -> m GetDataResult
forall (m :: * -> *).
PandocMonad m =>
PandocError -> m GetDataResult
handler
where
fetcher :: m GetDataResult
fetcher = do
let ext :: MimeType
ext = MimeType -> MimeType
T.toLower (MimeType -> MimeType) -> MimeType -> MimeType
forall a b. (a -> b) -> a -> b
$ String -> MimeType
T.pack (String -> MimeType) -> String -> MimeType
forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ MimeType -> String
T.unpack MimeType
src
(ByteString
raw, Maybe MimeType
respMime) <- MimeType -> m (ByteString, Maybe MimeType)
forall (m :: * -> *).
PandocMonad m =>
MimeType -> m (ByteString, Maybe MimeType)
fetchItem MimeType
src
let raw' :: ByteString
raw' = if MimeType
ext MimeType -> [MimeType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MimeType
".gz", MimeType
".svgz"]
then [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Gzip.decompress (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
raw]
else ByteString
raw
let mime :: MimeType
mime = case (MimeType
mimetype, Maybe MimeType
respMime) of
(MimeType
"",Maybe MimeType
Nothing) -> MimeType
"application/octet-stream"
(MimeType
x, Maybe MimeType
Nothing) -> MimeType
x
(MimeType
_, Just MimeType
x ) -> MimeType
x
ByteString
result <- if MimeType
"text/css" MimeType -> MimeType -> Bool
`T.isPrefixOf` MimeType
mime
then do
[String]
oldInputs <- m [String]
forall (m :: * -> *). PandocMonad m => m [String]
getInputFiles
[String] -> m ()
forall (m :: * -> *). PandocMonad m => [String] -> m ()
setInputFiles [MimeType -> String
T.unpack MimeType
src]
ByteString
res <- String -> ByteString -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m ByteString
cssURLs (String -> String
takeDirectory (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ MimeType -> String
T.unpack MimeType
src) ByteString
raw'
[String] -> m ()
forall (m :: * -> *). PandocMonad m => [String] -> m ()
setInputFiles [String]
oldInputs
ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
res
else ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
raw'
GetDataResult -> m GetDataResult
forall (m :: * -> *) a. Monad m => a -> m a
return (GetDataResult -> m GetDataResult)
-> GetDataResult -> m GetDataResult
forall a b. (a -> b) -> a -> b
$ (MimeType, ByteString) -> GetDataResult
Fetched (MimeType
mime, ByteString
result)
handler :: PandocError -> m GetDataResult
handler PandocError
e = case PandocError
e of
PandocResourceNotFound MimeType
r -> do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ MimeType -> MimeType -> LogMessage
CouldNotFetchResource MimeType
r MimeType
""
GetDataResult -> m GetDataResult
forall (m :: * -> *) a. Monad m => a -> m a
return (GetDataResult -> m GetDataResult)
-> GetDataResult -> m GetDataResult
forall a b. (a -> b) -> a -> b
$ PandocError -> GetDataResult
CouldNotFetch PandocError
e
PandocHttpError MimeType
u HttpException
er -> do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ MimeType -> MimeType -> LogMessage
CouldNotFetchResource MimeType
u (HttpException -> MimeType
forall a. Show a => a -> MimeType
tshow HttpException
er)
GetDataResult -> m GetDataResult
forall (m :: * -> *) a. Monad m => a -> m a
return (GetDataResult -> m GetDataResult)
-> GetDataResult -> m GetDataResult
forall a b. (a -> b) -> a -> b
$ PandocError -> GetDataResult
CouldNotFetch PandocError
e
PandocError
_ -> PandocError -> m GetDataResult
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
makeSelfContained :: PandocMonad m => T.Text -> m T.Text
makeSelfContained :: MimeType -> m MimeType
makeSelfContained MimeType
inp = do
let tags :: [Tag MimeType]
tags = MimeType -> [Tag MimeType]
forall str. StringLike str => str -> [Tag str]
parseTags MimeType
inp
[Tag MimeType]
out' <- [Tag MimeType] -> m [Tag MimeType]
forall (m :: * -> *).
PandocMonad m =>
[Tag MimeType] -> m [Tag MimeType]
convertTags [Tag MimeType]
tags
MimeType -> m MimeType
forall (m :: * -> *) a. Monad m => a -> m a
return (MimeType -> m MimeType) -> MimeType -> m MimeType
forall a b. (a -> b) -> a -> b
$ [Tag MimeType] -> MimeType
renderTags' [Tag MimeType]
out'