diff options
Diffstat (limited to 'src/Text/Pandoc/Shared.hs')
| -rw-r--r-- | src/Text/Pandoc/Shared.hs | 60 |
1 files changed, 40 insertions, 20 deletions
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 58e065845..9d799fa52 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -110,8 +110,9 @@ import Data.Char ( toLower, isLower, isUpper, isAlpha, import Data.List ( find, stripPrefix, intercalate ) import Data.Version ( showVersion ) import qualified Data.Map as M -import Network.URI ( escapeURIString, isURI, nonStrictRelativeTo, - unEscapeString, parseURIReference, isAllowedInURI ) +import Network.URI ( escapeURIString, nonStrictRelativeTo, + unEscapeString, parseURIReference, isAllowedInURI, + parseURI, URI(..) ) import qualified Data.Set as Set import System.Directory import System.FilePath (splitDirectories, isPathSeparator) @@ -129,6 +130,7 @@ import System.IO (stderr) import System.IO.Temp import Text.HTML.TagSoup (renderTagsOptions, RenderOptions(..), Tag(..), renderOptions) +import Text.Pandoc.Compat.Monoid ((<>)) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Data.ByteString.Base64 (decodeLenient) @@ -373,17 +375,19 @@ isSpaceOrEmpty (Str "") = True isSpaceOrEmpty _ = False -- | Extract the leading and trailing spaces from inside an inline element --- and place them outside the element. - +-- and place them outside the element. SoftBreaks count as Spaces for +-- these purposes. extractSpaces :: (Inlines -> Inlines) -> Inlines -> Inlines extractSpaces f is = let contents = B.unMany is left = case viewl contents of - (Space :< _) -> B.space - _ -> mempty + (Space :< _) -> B.space + (SoftBreak :< _) -> B.softbreak + _ -> mempty right = case viewr contents of - (_ :> Space) -> B.space - _ -> mempty in + (_ :> Space) -> B.space + (_ :> SoftBreak) -> B.softbreak + _ -> mempty in (left <> f (B.trimInlines . B.Many $ contents) <> right) -- | Normalize @Pandoc@ document, consolidating doubled 'Space's, @@ -450,6 +454,8 @@ normalizeInlines (Str x : ys) = isStr _ = False fromStr (Str z) = z fromStr _ = error "normalizeInlines - fromStr - not a Str" +normalizeInlines (Space : SoftBreak : ys) = + SoftBreak : normalizeInlines ys normalizeInlines (Space : ys) = if null rest then [] @@ -522,10 +528,10 @@ normalizeInlines (Note bs : ys) = Note (normalizeBlocks bs) : normalizeInlines ys normalizeInlines (Quoted qt ils : ys) = Quoted qt (normalizeInlines ils) : normalizeInlines ys -normalizeInlines (Link ils t : ys) = - Link (normalizeInlines ils) t : normalizeInlines ys -normalizeInlines (Image ils t : ys) = - Image (normalizeInlines ils) t : normalizeInlines ys +normalizeInlines (Link attr ils t : ys) = + Link attr (normalizeInlines ils) t : normalizeInlines ys +normalizeInlines (Image attr ils t : ys) = + Image attr (normalizeInlines ils) t : normalizeInlines ys normalizeInlines (Cite cs ils : ys) = Cite cs (normalizeInlines ils) : normalizeInlines ys normalizeInlines (x : xs) = x : normalizeInlines xs @@ -537,6 +543,7 @@ removeFormatting = query go . walk deNote where go :: Inline -> [Inline] go (Str xs) = [Str xs] go Space = [Space] + go SoftBreak = [SoftBreak] go (Code _ x) = [Str x] go (Math _ x) = [Str x] go LineBreak = [Space] @@ -551,6 +558,7 @@ stringify :: Walkable Inline a => a -> String stringify = query go . walk deNote where go :: Inline -> [Char] go Space = " " + go SoftBreak = " " go (Str x) = x go (Code _ x) = x go (Math _ x) = x @@ -854,7 +862,6 @@ readDefaultDataFile fname = #else getDataFileName fname' >>= checkExistence >>= BS.readFile where fname' = if fname == "README" then fname else "data" </> fname -#endif checkExistence :: FilePath -> IO FilePath checkExistence fn = do @@ -862,6 +869,7 @@ checkExistence fn = do if exists then return fn else err 97 ("Could not find data file " ++ fn) +#endif -- | Read file from specified user data directory or, if not found there, from -- Cabal data directory. @@ -878,18 +886,30 @@ readDataFileUTF8 :: Maybe FilePath -> FilePath -> IO String readDataFileUTF8 userDir fname = UTF8.toString `fmap` readDataFile userDir fname +-- | Specialized version of parseURIReference that disallows +-- single-letter schemes. Reason: these are usually windows absolute +-- paths. +parseURIReference' :: String -> Maybe URI +parseURIReference' s = + case parseURIReference s of + Just u | length (uriScheme u) > 2 -> Just u + _ -> Nothing + -- | Fetch an image or other item from the local filesystem or the net. -- Returns raw content and maybe mime type. fetchItem :: Maybe String -> String -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType)) fetchItem sourceURL s = - case (sourceURL >>= parseURIReference . ensureEscaped, ensureEscaped s) of - (_, s') | isURI s' -> openURL s' + case (sourceURL >>= parseURIReference' . ensureEscaped, ensureEscaped s) of (Just u, s') -> -- try fetching from relative path at source - case parseURIReference s' of + case parseURIReference' s' of Just u' -> openURL $ show $ u' `nonStrictRelativeTo` u Nothing -> openURL s' -- will throw error - (Nothing, _) -> E.try readLocalFile -- get from local file system + (Nothing, s') -> + case parseURI s' of -- requires absolute URI + -- We don't want to treat C:/ as a scheme: + Just u' | length (uriScheme u') > 2 -> openURL (show u') + _ -> E.try readLocalFile -- get from local file system where readLocalFile = do cont <- BS.readFile fp return (cont, mime) @@ -913,9 +933,9 @@ fetchItem' media sourceURL s = do -- | Read from a URL and return raw data and maybe mime type. openURL :: String -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType)) openURL u - | Just u' <- stripPrefix "data:" u = - let mime = takeWhile (/=',') u' - contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u' + | Just u'' <- stripPrefix "data:" u = + let mime = takeWhile (/=',') u'' + contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u'' in return $ Right (decodeLenient contents, Just mime) #ifdef HTTP_CLIENT | otherwise = withSocketsDo $ E.try $ do |