{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE ViewPatterns          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{- |
   Module      : Text.Pandoc.Shared
   Copyright   : Copyright (C) 2006-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Utility functions and definitions used by the various Pandoc modules.
-}
module Text.Pandoc.Shared (
                     -- * List processing
                     splitBy,
                     splitTextBy,
                     splitTextByIndices,
                     -- * Text processing
                     inquotes,
                     tshow,
                     stripTrailingNewlines,
                     trim,
                     triml,
                     trimr,
                     trimMath,
                     stripFirstAndLast,
                     camelCaseToHyphenated,
                     camelCaseStrToHyphenated,
                     toRomanNumeral,
                     tabFilter,
                     -- * Date/time
                     normalizeDate,
                     -- * Pandoc block and inline list processing
                     orderedListMarkers,
                     extractSpaces,
                     removeFormatting,
                     deNote,
                     stringify,
                     capitalize,
                     compactify,
                     compactifyDL,
                     linesToPara,
                     figureDiv,
                     makeSections,
                     uniqueIdent,
                     inlineListToIdentifier,
                     textToIdentifier,
                     isHeaderBlock,
                     headerShift,
                     stripEmptyParagraphs,
                     onlySimpleTableCells,
                     isTightList,
                     taskListItemFromAscii,
                     taskListItemToAscii,
                     handleTaskListItem,
                     addMetaField,
                     eastAsianLineBreakFilter,
                     htmlSpanLikeElements,
                     filterIpynbOutput,
                     formatCode,
                     -- * TagSoup HTML handling
                     renderTags',
                     -- * File handling
                     inDirectory,
                     makeCanonical,
                     collapseFilePath,
                     filteredFilesFromArchive,
                     -- * for squashing blocks
                     blocksToInlines,
                     blocksToInlines',
                     blocksToInlinesWithSep,
                     defaultBlocksSeparator,
                     -- * Safe read
                     safeRead,
                     safeStrRead
                    ) where

import Codec.Archive.Zip
import qualified Control.Exception as E
import Control.Monad (MonadPlus (..), msum, unless)
import qualified Control.Monad.State.Strict as S
import qualified Data.ByteString.Lazy as BL
import Data.Containers.ListUtils (nubOrd)
import Data.Char (isAlpha, isLower, isSpace, isUpper, toLower, isAlphaNum,
                  generalCategory, GeneralCategory(NonSpacingMark,
                  SpacingCombiningMark, EnclosingMark, ConnectorPunctuation))
import Data.List (find, foldl', groupBy, intercalate, intersperse,
                  union, sortOn)
import qualified Data.Map as M
import Data.Maybe (mapMaybe, fromMaybe)
import Data.Monoid (Any (..))
import Data.Sequence (ViewL (..), ViewR (..), viewl, viewr)
import qualified Data.Set as Set
import qualified Data.Text as T
import System.Directory
import System.FilePath (isPathSeparator, splitDirectories)
import qualified System.FilePath.Posix as Posix
import Text.HTML.TagSoup (RenderOptions (..), Tag (..), renderOptions,
                          renderTagsOptions)
import Text.Pandoc.Builder (Blocks, Inlines, ToMetaValue (..))
import qualified Text.Pandoc.Builder as B
import Data.Time
import Text.Pandoc.Asciify (toAsciiText)
import Text.Pandoc.Definition
import Text.Pandoc.Extensions (Extensions, Extension(..), extensionEnabled)
import Text.Pandoc.Generic (bottomUp)
import Text.DocLayout (charWidth)
import Text.Pandoc.Walk

--
-- List processing
--

-- | Split list by groups of one or more sep.
splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy :: forall a. (a -> Bool) -> [a] -> [[a]]
splitBy a -> Bool
_ [] = []
splitBy a -> Bool
isSep [a]
lst =
  let ([a]
first, [a]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
isSep [a]
lst
  in  [a]
firstforall a. a -> [a] -> [a]
:forall a. (a -> Bool) -> [a] -> [[a]]
splitBy a -> Bool
isSep (forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
isSep [a]
rest)

-- | Split text by groups of one or more separator.
splitTextBy :: (Char -> Bool) -> T.Text -> [T.Text]
splitTextBy :: (Char -> Bool) -> Text -> [Text]
splitTextBy Char -> Bool
isSep Text
t
  | Text -> Bool
T.null Text
t = []
  | Bool
otherwise = let (Text
first, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSep Text
t
                in  Text
first forall a. a -> [a] -> [a]
: (Char -> Bool) -> Text -> [Text]
splitTextBy Char -> Bool
isSep ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSep Text
rest)

-- | Split text at the given widths. Note that the break points are
-- /not/ indices but text widths, which will be different for East Asian
-- characters, emojis, etc.
splitTextByIndices :: [Int] -> T.Text -> [T.Text]
splitTextByIndices :: [Int] -> Text -> [Text]
splitTextByIndices [Int]
ns = [Int] -> [Char] -> [Text]
splitTextByRelIndices (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
ns (Int
0forall a. a -> [a] -> [a]
:[Int]
ns)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
 where
  splitTextByRelIndices :: [Int] -> [Char] -> [Text]
splitTextByRelIndices [] [Char]
cs = [[Char] -> Text
T.pack [Char]
cs]
  splitTextByRelIndices (Int
x:[Int]
xs) [Char]
cs =
    let ([Char]
first, [Char]
rest) = Int -> [Char] -> ([Char], [Char])
splitAt' Int
x [Char]
cs
     in [Char] -> Text
T.pack [Char]
first forall a. a -> [a] -> [a]
: [Int] -> [Char] -> [Text]
splitTextByRelIndices [Int]
xs [Char]
rest

-- | Returns a pair whose first element is a prefix of @t@ and that has
-- width @n@, and whose second is the remainder of the string.
--
-- Note: Do *not* replace this with 'T.splitAt', which is not sensitive
-- to character widths!
splitAt' :: Int {-^ n -} -> [Char] {-^ t -} -> ([Char],[Char])
splitAt' :: Int -> [Char] -> ([Char], [Char])
splitAt' Int
_ []          = ([],[])
splitAt' Int
n [Char]
xs | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = ([],[Char]
xs)
splitAt' Int
n (Char
x:[Char]
xs)      = (Char
xforall a. a -> [a] -> [a]
:[Char]
ys,[Char]
zs)
  where ([Char]
ys,[Char]
zs) = Int -> [Char] -> ([Char], [Char])
splitAt' (Int
n forall a. Num a => a -> a -> a
- Char -> Int
charWidth Char
x) [Char]
xs

--
-- Text processing
--

-- | Wrap double quotes around a Text
inquotes :: T.Text -> T.Text
inquotes :: Text -> Text
inquotes Text
txt = Char -> Text -> Text
T.cons Char
'\"' (Text -> Char -> Text
T.snoc Text
txt Char
'\"')

-- | Like @'show'@, but returns a 'T.Text' instead of a 'String'.
tshow :: Show a => a -> T.Text
tshow :: forall a. Show a => a -> Text
tshow = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

-- | Strip trailing newlines from string.
stripTrailingNewlines :: T.Text -> T.Text
stripTrailingNewlines :: Text -> Text
stripTrailingNewlines = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'\n')

-- | Returns 'True' for an ASCII whitespace character, viz. space,
-- carriage return, newline, and horizontal tab.
isWS :: Char -> Bool
isWS :: Char -> Bool
isWS Char
' '  = Bool
True
isWS Char
'\r' = Bool
True
isWS Char
'\n' = Bool
True
isWS Char
'\t' = Bool
True
isWS Char
_    = Bool
False

-- | Remove leading and trailing space (including newlines) from string.
trim :: T.Text -> T.Text
trim :: Text -> Text
trim = (Char -> Bool) -> Text -> Text
T.dropAround Char -> Bool
isWS

-- | Remove leading space (including newlines) from string.
triml :: T.Text -> T.Text
triml :: Text -> Text
triml = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isWS

-- | Remove trailing space (including newlines) from string.
trimr :: T.Text -> T.Text
trimr :: Text -> Text
trimr = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isWS

-- | Trim leading space and trailing space unless after \.
trimMath :: T.Text -> T.Text
trimMath :: Text -> Text
trimMath = Text -> Text
triml forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripBeginSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse -- no Text.spanEnd
  where
    stripBeginSpace :: Text -> Text
stripBeginSpace Text
t
      | Text -> Bool
T.null Text
pref = Text
t
      | Just (Char
'\\', Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
suff = Char -> Text -> Text
T.cons (Text -> Char
T.last Text
pref) Text
suff
      | Bool
otherwise = Text
suff
      where
        (Text
pref, Text
suff) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isWS Text
t

-- | Strip leading and trailing characters from string
stripFirstAndLast :: T.Text -> T.Text
stripFirstAndLast :: Text -> Text
stripFirstAndLast Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Just (Char
_, Text
t') -> case Text -> Maybe (Text, Char)
T.unsnoc Text
t' of
    Just (Text
t'', Char
_) -> Text
t''
    Maybe (Text, Char)
_             -> Text
t'
  Maybe (Char, Text)
_               -> Text
""

-- | Change CamelCase word to hyphenated lowercase (e.g., camel-case).
camelCaseToHyphenated :: T.Text -> T.Text
camelCaseToHyphenated :: Text -> Text
camelCaseToHyphenated = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
camelCaseStrToHyphenated forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

-- This may not work as expected on general Unicode, if it contains
-- letters with a longer lower case form than upper case. I don't know
-- what the camel case practices of affected scripts are, though.
camelCaseStrToHyphenated :: String -> String
camelCaseStrToHyphenated :: [Char] -> [Char]
camelCaseStrToHyphenated [] = [Char]
""
camelCaseStrToHyphenated (Char
a:Char
b:[Char]
rest)
  | Char -> Bool
isLower Char
a
  , Char -> Bool
isUpper Char
b = Char
aforall a. a -> [a] -> [a]
:Char
'-'forall a. a -> [a] -> [a]
:Char -> Char
toLower Char
bforall a. a -> [a] -> [a]
:[Char] -> [Char]
camelCaseStrToHyphenated [Char]
rest
-- handle ABCDef = abc-def
camelCaseStrToHyphenated (Char
a:Char
b:Char
c:[Char]
rest)
  | Char -> Bool
isUpper Char
a
  , Char -> Bool
isUpper Char
b
  , Char -> Bool
isLower Char
c = Char -> Char
toLower Char
aforall a. a -> [a] -> [a]
:Char
'-'forall a. a -> [a] -> [a]
:Char -> Char
toLower Char
bforall a. a -> [a] -> [a]
:[Char] -> [Char]
camelCaseStrToHyphenated (Char
cforall a. a -> [a] -> [a]
:[Char]
rest)
camelCaseStrToHyphenated (Char
a:[Char]
rest) = Char -> Char
toLower Char
aforall a. a -> [a] -> [a]
:[Char] -> [Char]
camelCaseStrToHyphenated [Char]
rest

-- | Convert number < 4000 to uppercase roman numeral.
toRomanNumeral :: Int -> T.Text
toRomanNumeral :: Int -> Text
toRomanNumeral Int
x
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
4000 Bool -> Bool -> Bool
|| Int
x forall a. Ord a => a -> a -> Bool
< Int
0 = Text
"?"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
1000 = Text
"M" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
1000)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
900  = Text
"CM" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
900)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
500  = Text
"D" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
500)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
400  = Text
"CD" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
400)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
100  = Text
"C" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
100)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
90   = Text
"XC" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
90)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
50   = Text
"L"  forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
50)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
40   = Text
"XL" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
40)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
10   = Text
"X" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
10)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
9    = Text
"IX"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
5    = Text
"V" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
5)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
4    = Text
"IV"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
1    = Text
"I" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
1)
  | Bool
otherwise = Text
""

-- | Convert tabs to spaces. Tabs will be preserved if tab stop is set to 0.
tabFilter :: Int       -- ^ Tab stop
          -> T.Text    -- ^ Input
          -> T.Text
tabFilter :: Int -> Text -> Text
tabFilter Int
0 = forall a. a -> a
id
tabFilter Int
tabStop = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
  where go :: Text -> Text
go Text
s =
         let (Text
s1, Text
s2) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'\t') Text
s
         in  if Text -> Bool
T.null Text
s2
                then Text
s1
                else Text
s1 forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate
                       (Int
tabStop forall a. Num a => a -> a -> a
- (Text -> Int
T.length Text
s1 forall a. Integral a => a -> a -> a
`mod` Int
tabStop)) ([Char] -> Text
T.pack [Char]
" ")
                       forall a. Semigroup a => a -> a -> a
<> Text -> Text
go (Int -> Text -> Text
T.drop Int
1 Text
s2)

--
-- Date/time
--

-- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. We
-- limit years to the range 1601-9999 (ISO 8601 accepts greater than
-- or equal to 1583, but MS Word only accepts dates starting 1601).
normalizeDate :: T.Text -> Maybe T.Text
normalizeDate :: Text -> Maybe Text
normalizeDate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char]
normalizeDate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

-- | Like @'normalizeDate'@, but acts on 'String' instead of 'T.Text'.
normalizeDate' :: String -> Maybe String
normalizeDate' :: [Char] -> Maybe [Char]
normalizeDate' [Char]
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%F")
  (forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
fs -> [Char] -> [Char] -> Maybe Day
parsetimeWith [Char]
fs [Char]
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Day -> Maybe Day
rejectBadYear) [[Char]]
formats :: Maybe Day)
  where rejectBadYear :: Day -> Maybe Day
rejectBadYear Day
day = case Day -> (Year, Int, Int)
toGregorian Day
day of
          (Year
y, Int
_, Int
_) | Year
y forall a. Ord a => a -> a -> Bool
>= Year
1601 Bool -> Bool -> Bool
&& Year
y forall a. Ord a => a -> a -> Bool
<= Year
9999 -> forall a. a -> Maybe a
Just Day
day
          (Year, Int, Int)
_         -> forall a. Maybe a
Nothing
        parsetimeWith :: [Char] -> [Char] -> Maybe Day
parsetimeWith = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> [Char] -> [Char] -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale
        formats :: [[Char]]
formats = [[Char]
"%x",[Char]
"%m/%d/%Y", [Char]
"%D",[Char]
"%F", [Char]
"%d %b %Y",
                    [Char]
"%e %B %Y", [Char]
"%b. %e, %Y", [Char]
"%B %e, %Y",
                    [Char]
"%Y%m%d", [Char]
"%Y%m", [Char]
"%Y"]

--
-- Pandoc block and inline list processing
--

-- | Generate infinite lazy list of markers for an ordered list,
-- depending on list attributes.
orderedListMarkers :: (Int, ListNumberStyle, ListNumberDelim) -> [T.Text]
orderedListMarkers :: (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers (Int
start, ListNumberStyle
numstyle, ListNumberDelim
numdelim) =
  let nums :: [Text]
nums = case ListNumberStyle
numstyle of
                     ListNumberStyle
DefaultStyle -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
Example      -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
Decimal      -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
UpperAlpha   -> forall a. Int -> [a] -> [a]
drop (Int
start forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$
                                     forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'A'..Char
'Z']
                     ListNumberStyle
LowerAlpha   -> forall a. Int -> [a] -> [a]
drop (Int
start forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$
                                     forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'a'..Char
'z']
                     ListNumberStyle
UpperRoman   -> forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
toRomanNumeral [Int
start..]
                     ListNumberStyle
LowerRoman   -> forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
toRomanNumeral) [Int
start..]
      inDelim :: a -> a
inDelim a
str = case ListNumberDelim
numdelim of
                            ListNumberDelim
DefaultDelim -> a
str forall a. Semigroup a => a -> a -> a
<> a
"."
                            ListNumberDelim
Period       -> a
str forall a. Semigroup a => a -> a -> a
<> a
"."
                            ListNumberDelim
OneParen     -> a
str forall a. Semigroup a => a -> a -> a
<> a
")"
                            ListNumberDelim
TwoParens    -> a
"(" forall a. Semigroup a => a -> a -> a
<> a
str forall a. Semigroup a => a -> a -> a
<> a
")"
  in  forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Semigroup a, IsString a) => a -> a
inDelim [Text]
nums


-- | Extract the leading and trailing spaces from inside an inline element
-- and place them outside the element.  SoftBreaks count as Spaces for
-- these purposes.
extractSpaces :: (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces :: (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
f Inlines
is =
  let contents :: Seq Inline
contents = forall a. Many a -> Seq a
B.unMany Inlines
is
      left :: Inlines
left  = case forall a. Seq a -> ViewL a
viewl Seq Inline
contents of
                    (Inline
Space :< Seq Inline
_)     -> Inlines
B.space
                    (Inline
SoftBreak :< Seq Inline
_) -> Inlines
B.softbreak
                    ViewL Inline
_                -> forall a. Monoid a => a
mempty
      right :: Inlines
right = case forall a. Seq a -> ViewR a
viewr Seq Inline
contents of
                    (Seq Inline
_ :> Inline
Space)     -> Inlines
B.space
                    (Seq Inline
_ :> Inline
SoftBreak) -> Inlines
B.softbreak
                    ViewR Inline
_                -> forall a. Monoid a => a
mempty in
  (Inlines
left forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
f (Inlines -> Inlines
B.trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Many a
B.Many forall a b. (a -> b) -> a -> b
$ Seq Inline
contents) forall a. Semigroup a => a -> a -> a
<> Inlines
right)

-- | Extract inlines, removing formatting.
removeFormatting :: Walkable Inline a => a -> [Inline]
removeFormatting :: forall a. Walkable Inline a => a -> [Inline]
removeFormatting = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [Inline]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
deNote forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
deQuote)
  where go :: Inline -> [Inline]
        go :: Inline -> [Inline]
go (Str Text
xs)   = [Text -> Inline
Str Text
xs]
        go Inline
Space      = [Inline
Space]
        go Inline
SoftBreak  = [Inline
SoftBreak]
        go (Code Attr
_ Text
x) = [Text -> Inline
Str Text
x]
        go (Math MathType
_ Text
x) = [Text -> Inline
Str Text
x]
        go Inline
LineBreak  = [Inline
Space]
        go Inline
_          = []

-- | Replaces 'Note' elements with empty strings.
deNote :: Inline -> Inline
deNote :: Inline -> Inline
deNote (Note [Block]
_) = Text -> Inline
Str Text
""
deNote Inline
x        = Inline
x

-- | Convert pandoc structure to a string with formatting removed.
-- Footnotes are skipped (since we don't want their contents in link
-- labels).
stringify :: Walkable Inline a => a -> T.Text
stringify :: forall a. Walkable Inline a => a -> Text
stringify = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
fixInlines
  where go :: Inline -> T.Text
        go :: Inline -> Text
go Inline
Space                                       = Text
" "
        go Inline
SoftBreak                                   = Text
" "
        go (Str Text
x)                                     = Text
x
        go (Code Attr
_ Text
x)                                  = Text
x
        go (Math MathType
_ Text
x)                                  = Text
x
        go (RawInline (Format Text
"html") (Text -> [Char]
T.unpack -> (Char
'<':Char
'b':Char
'r':[Char]
_)))
                                                       = Text
" " -- see #2105
        go Inline
LineBreak                                   = Text
" "
        go Inline
_                                           = Text
""

        fixInlines :: Inline -> Inline
        fixInlines :: Inline -> Inline
fixInlines (Cite [Citation]
_ [Inline]
ils) = [Citation] -> [Inline] -> Inline
Cite [] [Inline]
ils
        fixInlines (Note [Block]
_) = [Block] -> Inline
Note []
        fixInlines (q :: Inline
q@Quoted{}) = Inline -> Inline
deQuote Inline
q
        fixInlines Inline
x = Inline
x

-- | Unwrap 'Quoted' inline elements, enclosing the contents with
-- English-style Unicode quotes instead.
deQuote :: Inline -> Inline
deQuote :: Inline -> Inline
deQuote (Quoted QuoteType
SingleQuote [Inline]
xs) =
  Attr -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
"\8216" forall a. a -> [a] -> [a]
: [Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8217"])
deQuote (Quoted QuoteType
DoubleQuote [Inline]
xs) =
  Attr -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
"\8220" forall a. a -> [a] -> [a]
: [Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8221"])
deQuote Inline
x = Inline
x

-- | Bring all regular text in a pandoc structure to uppercase.
--
-- This function correctly handles cases where a lowercase character doesn't
-- match to a single uppercase character – e.g. “Straße” would be converted
-- to “STRASSE”, not “STRAßE”.
capitalize :: Walkable Inline a => a -> a
capitalize :: forall a. Walkable Inline a => a -> a
capitalize = forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
go
  where go :: Inline -> Inline
        go :: Inline -> Inline
go (Str Text
s) = Text -> Inline
Str forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
s
        go Inline
x       = Inline
x

-- | Change final list item from @Para@ to @Plain@ if the list contains
-- no other @Para@ blocks.  Otherwise (if the list items contain @Para@
-- blocks besides possibly at the end), turn any @Plain@s into @Para@s (#5285).
compactify :: [Blocks]  -- ^ List of list items (each a list of blocks)
           -> [Blocks]
compactify :: [Blocks] -> [Blocks]
compactify [] = []
compactify [Blocks]
items =
  let ([Blocks]
others, Blocks
final) = (forall a. [a] -> [a]
init [Blocks]
items, forall a. [a] -> a
last [Blocks]
items)
  in  case forall a. [a] -> [a]
reverse (forall a. Many a -> [a]
B.toList Blocks
final) of
           (Para [Inline]
a:[Block]
xs)
             | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline] -> Block
Para [Inline]
x | Para [Inline]
x <- [Block]
xs forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Many a -> [a]
B.toList [Blocks]
others]
             -> [Blocks]
others forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> Many a
B.fromList (forall a. [a] -> [a]
reverse ([Inline] -> Block
Plain [Inline]
a forall a. a -> [a] -> [a]
: [Block]
xs))]
           [Block]
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline] -> Block
Para [Inline]
x | Para [Inline]
x <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Many a -> [a]
B.toList [Blocks]
items]
             -> [Blocks]
items
           [Block]
_ -> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> Block
plainToPara) [Blocks]
items

plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain [Inline]
ils) = [Inline] -> Block
Para [Inline]
ils
plainToPara Block
x = Block
x


-- | Like @compactify@, but acts on items of definition lists.
compactifyDL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
compactifyDL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
compactifyDL [(Inlines, [Blocks])]
items =
  case forall a. [a] -> [a]
reverse [(Inlines, [Blocks])]
items of
        ((Inlines
t,[Blocks]
ds):[(Inlines, [Blocks])]
ys) ->
           case forall a. [a] -> [a]
reverse (forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
B.toList) [Blocks]
ds) of
             ((Para [Inline]
x:[Block]
xs) : [[Block]]
zs) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isPara [Block]
xs) ->
                  forall a. [a] -> [a]
reverse [(Inlines, [Blocks])]
ys forall a. [a] -> [a] -> [a]
++
                    [(Inlines
t, forall a. [a] -> [a]
reverse (forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> Many a
B.fromList [[Block]]
zs) forall a. [a] -> [a] -> [a]
++
                         [forall a. [a] -> Many a
B.fromList (forall a. [a] -> [a]
reverse ([Inline] -> Block
Plain [Inline]
xforall a. a -> [a] -> [a]
:[Block]
xs))])]
             [[Block]]
_     -> [(Inlines, [Blocks])]
items
        [(Inlines, [Blocks])]
_          -> [(Inlines, [Blocks])]
items


-- | Combine a list of lines by adding hard linebreaks.
combineLines :: [[Inline]] -> [Inline]
combineLines :: [[Inline]] -> [Inline]
combineLines = forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak]

-- | Convert a list of lines into a paragraph with hard line breaks. This is
--   useful e.g. for rudimentary support of LineBlock elements in writers.
linesToPara :: [[Inline]] -> Block
linesToPara :: [[Inline]] -> Block
linesToPara = [Inline] -> Block
Para forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Inline]] -> [Inline]
combineLines

-- | Creates a Div block from figure components. The intended use is in
-- writers of formats that do not have markup support for figures.
--
-- The resulting div is given the class @figure@ and contains the figure
-- body and the figure caption. The latter is wrapped in a 'Div' of
-- class @caption@, with the stringified @short-caption@ as attribute.
figureDiv :: Attr -> Caption -> [Block] -> Block
figureDiv :: Attr -> Caption -> [Block] -> Block
figureDiv (Text
ident, [Text]
classes, [(Text, Text)]
kv) (Caption Maybe [Inline]
shortcapt [Block]
longcapt) [Block]
body =
  let divattr :: Attr
divattr = ( Text
ident
              , [Text
"figure"] forall a. Eq a => [a] -> [a] -> [a]
`union` [Text]
classes
              , [(Text, Text)]
kv
              )
      captkv :: [(Text, Text)]
captkv = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\[Inline]
s -> [(Text
"short-caption", forall a. Walkable Inline a => a -> Text
stringify [Inline]
s)]) Maybe [Inline]
shortcapt
      capt :: [Block]
capt = [Attr -> [Block] -> Block
Div (Text
"", [Text
"caption"], [(Text, Text)]
captkv) [Block]
longcapt | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
longcapt)]
  in Attr -> [Block] -> Block
Div Attr
divattr ([Block]
body forall a. [a] -> [a] -> [a]
++ [Block]
capt)

-- | Returns 'True' iff the given element is a 'Para'.
isPara :: Block -> Bool
isPara :: Block -> Bool
isPara (Para [Inline]
_) = Bool
True
isPara Block
_        = Bool
False

-- | Convert Pandoc inline list to plain text identifier.
inlineListToIdentifier :: Extensions -> [Inline] -> T.Text
inlineListToIdentifier :: Extensions -> [Inline] -> Text
inlineListToIdentifier Extensions
exts =
  Extensions -> Text -> Text
textToIdentifier Extensions
exts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Walkable Inline a => a -> Text
stringify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
unEmojify
  where
    unEmojify :: [Inline] -> [Inline]
    unEmojify :: [Inline] -> [Inline]
unEmojify
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts Bool -> Bool -> Bool
||
        Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_ascii_identifiers Extensions
exts = forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
unEmoji
      | Bool
otherwise = forall a. a -> a
id
    unEmoji :: Inline -> Inline
unEmoji (Span (Text
"",[Text
"emoji"],[(Text
"data-emoji",Text
ename)]) [Inline]
_) = Text -> Inline
Str Text
ename
    unEmoji Inline
x = Inline
x

-- | Convert string to plain text identifier.
textToIdentifier :: Extensions -> T.Text -> T.Text
textToIdentifier :: Extensions -> Text -> Text
textToIdentifier Extensions
exts =
  Text -> Text
dropNonLetter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
filterAscii forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toIdent
  where
    dropNonLetter :: Text -> Text
dropNonLetter
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts = forall a. a -> a
id
      | Bool
otherwise = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlpha)
    filterAscii :: Text -> Text
filterAscii
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_ascii_identifiers Extensions
exts
        = Text -> Text
toAsciiText
      | Bool
otherwise = forall a. a -> a
id
    toIdent :: Text -> Text
toIdent
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts =
        Text -> Text
filterPunct forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
spaceToDash forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
      | Bool
otherwise = Text -> [Text] -> Text
T.intercalate Text
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
filterPunct forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
    filterPunct :: Text -> Text
filterPunct = (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAllowedPunct Char
c)
    isAllowedPunct :: Char -> Bool
isAllowedPunct Char
c
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts
        = Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
||
          Char -> GeneralCategory
generalCategory Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GeneralCategory
NonSpacingMark, GeneralCategory
SpacingCombiningMark,
                                    GeneralCategory
EnclosingMark, GeneralCategory
ConnectorPunctuation]
      | Bool
otherwise = Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'
    spaceToDash :: Text -> Text
spaceToDash = (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char -> Bool
isSpace Char
c then Char
'-' else Char
c)


-- | Put a list of Pandoc blocks into a hierarchical structure:
-- a list of sections (each a Div with class "section" and first
-- element a Header).  If the 'numbering' parameter is True, Header
-- numbers are added via the number attribute on the header.
-- If the baseLevel parameter is Just n, Header levels are
-- adjusted to be gapless starting at level n.
makeSections :: Bool -> Maybe Int -> [Block] -> [Block]
makeSections :: Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
numbering Maybe Int
mbBaseLevel [Block]
bs =
  forall s a. State s a -> s -> a
S.evalState ([Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
bs) (Maybe Int
mbBaseLevel, [])
 where
  go :: [Block] -> S.State (Maybe Int, [Int]) [Block]
  go :: [Block] -> State (Maybe Int, [Int]) [Block]
go (Header Int
level (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
title':[Block]
xs) = do
    (Maybe Int
mbLevel, [Int]
lastnum) <- forall s (m :: * -> *). MonadState s m => m s
S.get
    let level' :: Int
level' = forall a. a -> Maybe a -> a
fromMaybe Int
level Maybe Int
mbLevel
    let lastnum' :: [Int]
lastnum' = forall a. Int -> [a] -> [a]
take Int
level' [Int]
lastnum
    let newnum :: [Int]
newnum =
          if Int
level' forall a. Ord a => a -> a -> Bool
> Int
0
             then case forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lastnum' of
                      Int
x | Text
"unnumbered" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes -> []
                        | Int
x forall a. Ord a => a -> a -> Bool
>= Int
level' -> forall a. [a] -> [a]
init [Int]
lastnum' forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [Int]
lastnum' forall a. Num a => a -> a -> a
+ Int
1]
                        | Bool
otherwise -> [Int]
lastnum forall a. [a] -> [a] -> [a]
++
                             forall a. Int -> a -> [a]
replicate (Int
level' forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lastnum forall a. Num a => a -> a -> a
- Int
1) Int
0 forall a. [a] -> [a] -> [a]
++ [Int
1]
             else []
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
newnum) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify forall a b. (a -> b) -> a -> b
$ \(Maybe Int
mbl, [Int]
_) -> (Maybe Int
mbl, [Int]
newnum)
    let ([Block]
sectionContents, [Block]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> Block -> Bool
headerLtEq Int
level) [Block]
xs
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify forall a b. (a -> b) -> a -> b
$ \(Maybe Int
_, [Int]
ln) -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
mbLevel, [Int]
ln)
    [Block]
sectionContents' <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
sectionContents
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify forall a b. (a -> b) -> a -> b
$ \(Maybe Int
_, [Int]
ln) -> (Maybe Int
mbLevel, [Int]
ln)
    [Block]
rest' <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
rest
    let kvs' :: [(Text, Text)]
kvs' = -- don't touch number if already present
               case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs of
                  Maybe Text
Nothing | Bool
numbering
                          , Text
"unnumbered" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes ->
                        (Text
"number", Text -> [Text] -> Text
T.intercalate Text
"." (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
tshow [Int]
newnum)) forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                  Maybe Text
_ -> [(Text, Text)]
kvs
    let divattr :: Attr
divattr = (Text
ident, Text
"section"forall a. a -> [a] -> [a]
:[Text]
classes, [(Text, Text)]
kvs')
    let attr :: Attr
attr = (Text
"",[Text]
classes,[(Text, Text)]
kvs')
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Attr -> [Block] -> Block
Div Attr
divattr (Int -> Attr -> [Inline] -> Block
Header Int
level' Attr
attr [Inline]
title' forall a. a -> [a] -> [a]
: [Block]
sectionContents') forall a. a -> [a] -> [a]
: [Block]
rest'
  go (Div divattr :: Attr
divattr@(Text
dident,[Text]
dclasses,[(Text, Text)]
_) (Header Int
level Attr
hattr [Inline]
title':[Block]
ys) : [Block]
xs)
      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case
               Header Int
level' Attr
_ [Inline]
_ -> Int
level' forall a. Ord a => a -> a -> Bool
> Int
level
               Block
_                 -> Bool
True) [Block]
ys
      , Text
"column" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses
      , Text
"columns" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses
      , Text
"fragment" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses = do
    [Block]
inner <- [Block] -> State (Maybe Int, [Int]) [Block]
go (Int -> Attr -> [Inline] -> Block
Header Int
level Attr
hattr [Inline]
title'forall a. a -> [a] -> [a]
:[Block]
ys)
    [Block]
rest <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
xs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      case [Block]
inner of
            [Div divattr' :: Attr
divattr'@(Text
dident',[Text]
_,[(Text, Text)]
_) [Block]
zs]
              | Text -> Bool
T.null Text
dident Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
dident' Bool -> Bool -> Bool
|| Text
dident forall a. Eq a => a -> a -> Bool
== Text
dident'
              -> Attr -> [Block] -> Block
Div (Attr -> Attr -> Attr
combineAttr Attr
divattr' Attr
divattr) [Block]
zs forall a. a -> [a] -> [a]
: [Block]
rest
            [Block]
_ -> Attr -> [Block] -> Block
Div Attr
divattr [Block]
inner forall a. a -> [a] -> [a]
: [Block]
rest
  go (Div Attr
attr [Block]
xs : [Block]
rest) = do
    [Block]
xs' <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
xs
    [Block]
rest' <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
rest
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div Attr
attr [Block]
xs' forall a. a -> [a] -> [a]
: [Block]
rest'
  go (Block
x:[Block]
xs) = (Block
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
xs
  go [] = forall (m :: * -> *) a. Monad m => a -> m a
return []

  combineAttr :: Attr -> Attr -> Attr
  combineAttr :: Attr -> Attr -> Attr
combineAttr (Text
id1, [Text]
classes1, [(Text, Text)]
kvs1) (Text
id2, [Text]
classes2, [(Text, Text)]
kvs2) =
    (if Text -> Bool
T.null Text
id1 then Text
id2 else Text
id1,
     forall a. Ord a => [a] -> [a]
nubOrd ([Text]
classes1 forall a. [a] -> [a] -> [a]
++ [Text]
classes2),
     forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Text
k,Text
v) [(Text, Text)]
kvs -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Text)]
kvs of
                             Maybe Text
Nothing -> (Text
k,Text
v)forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs
                             Just Text
_  -> [(Text, Text)]
kvs) forall a. Monoid a => a
mempty ([(Text, Text)]
kvs1 forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
kvs2))

headerLtEq :: Int -> Block -> Bool
headerLtEq :: Int -> Block -> Bool
headerLtEq Int
level (Header Int
l Attr
_ [Inline]
_)  = Int
l forall a. Ord a => a -> a -> Bool
<= Int
level
headerLtEq Int
level (Div Attr
_ (Block
b:[Block]
_))   = Int -> Block -> Bool
headerLtEq Int
level Block
b
headerLtEq Int
_ Block
_                   = Bool
False

-- | Generate a unique identifier from a list of inlines.
-- Second argument is a list of already used identifiers.
uniqueIdent :: Extensions -> [Inline] -> Set.Set T.Text -> T.Text
uniqueIdent :: Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts [Inline]
title' Set Text
usedIdents =
  if Text
baseIdent forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
usedIdents
     then forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
baseIdent forall a. Show a => a -> Text
numIdent
          forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Int
x -> forall a. Show a => a -> Text
numIdent Int
x forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
usedIdents) ([Int
1..Int
60000] :: [Int])
          -- if we have more than 60,000, allow repeats
     else Text
baseIdent
  where
    baseIdent :: Text
baseIdent = case Extensions -> [Inline] -> Text
inlineListToIdentifier Extensions
exts [Inline]
title' of
                     Text
"" -> Text
"section"
                     Text
x  -> Text
x
    numIdent :: a -> Text
numIdent a
n = Text
baseIdent forall a. Semigroup a => a -> a -> a
<> Text
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow a
n

-- | True if block is a Header block.
isHeaderBlock :: Block -> Bool
isHeaderBlock :: Block -> Bool
isHeaderBlock Header{} = Bool
True
isHeaderBlock Block
_        = Bool
False

-- | Shift header levels up or down.
headerShift :: Int -> Pandoc -> Pandoc
headerShift :: Int -> Pandoc -> Pandoc
headerShift Int
n (Pandoc Meta
meta (Header Int
m Attr
_ [Inline]
ils : [Block]
bs))
  | Int
n forall a. Ord a => a -> a -> Bool
< Int
0
  , Int
m forall a. Num a => a -> a -> a
+ Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Pandoc -> Pandoc
headerShift Int
n forall a b. (a -> b) -> a -> b
$
                 Inlines -> Pandoc -> Pandoc
B.setTitle (forall a. [a] -> Many a
B.fromList [Inline]
ils) forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs
headerShift Int
n (Pandoc Meta
meta [Block]
bs) = Meta -> [Block] -> Pandoc
Pandoc Meta
meta (forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
shift [Block]
bs)

 where
   shift :: Block -> Block
   shift :: Block -> Block
shift (Header Int
level Attr
attr [Inline]
inner)
     | Int
level forall a. Num a => a -> a -> a
+ Int
n forall a. Ord a => a -> a -> Bool
> Int
0  = Int -> Attr -> [Inline] -> Block
Header (Int
level forall a. Num a => a -> a -> a
+ Int
n) Attr
attr [Inline]
inner
     | Bool
otherwise      = [Inline] -> Block
Para [Inline]
inner
   shift Block
x            = Block
x

-- | Remove empty paragraphs.
stripEmptyParagraphs :: Pandoc -> Pandoc
stripEmptyParagraphs :: Pandoc -> Pandoc
stripEmptyParagraphs = forall a b. Walkable a b => (a -> a) -> b -> b
walk [Block] -> [Block]
go
  where go :: [Block] -> [Block]
        go :: [Block] -> [Block]
go = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isEmptyParagraph)
        isEmptyParagraph :: Block -> Bool
isEmptyParagraph (Para []) = Bool
True
        isEmptyParagraph Block
_         = Bool
False

-- | Detect if table rows contain only cells consisting of a single
-- paragraph that has no @LineBreak@.
onlySimpleTableCells :: [[[Block]]] -> Bool
onlySimpleTableCells :: [[[Block]]] -> Bool
onlySimpleTableCells = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  where
    isSimpleCell :: [Block] -> Bool
isSimpleCell [Plain [Inline]
ils] = Bool -> Bool
not ([Inline] -> Bool
hasLineBreak [Inline]
ils)
    isSimpleCell [Para [Inline]
ils ] = Bool -> Bool
not ([Inline] -> Bool
hasLineBreak [Inline]
ils)
    isSimpleCell []          = Bool
True
    isSimpleCell [Block]
_           = Bool
False
    hasLineBreak :: [Inline] -> Bool
hasLineBreak = Any -> Bool
getAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
isLineBreak
    isLineBreak :: Inline -> Any
isLineBreak Inline
LineBreak = Bool -> Any
Any Bool
True
    isLineBreak Inline
_         = Bool -> Any
Any Bool
False

-- | Detect if a list is tight.
isTightList :: [[Block]] -> Bool
isTightList :: [[Block]] -> Bool
isTightList = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[Block]
item -> [Block] -> Bool
firstIsPlain [Block]
item Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
item)
  where firstIsPlain :: [Block] -> Bool
firstIsPlain (Plain [Inline]
_ : [Block]
_) = Bool
True
        firstIsPlain [Block]
_             = Bool
False

-- | Convert a list item containing tasklist syntax (e.g. @[x]@)
-- to using @U+2610 BALLOT BOX@ or @U+2612 BALLOT BOX WITH X@.
taskListItemFromAscii :: Extensions -> [Block] -> [Block]
taskListItemFromAscii :: Extensions -> [Block] -> [Block]
taskListItemFromAscii = ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem [Inline] -> [Inline]
fromMd
  where
    fromMd :: [Inline] -> [Inline]
fromMd (Str Text
"[" : Inline
Space : Str Text
"]" : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☐" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd (Str Text
"[x]"                 : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☒" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd (Str Text
"[X]"                 : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☒" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd [Inline]
is = [Inline]
is

-- | Convert a list item containing text starting with @U+2610 BALLOT BOX@
-- or @U+2612 BALLOT BOX WITH X@ to tasklist syntax (e.g. @[x]@).
taskListItemToAscii :: Extensions -> [Block] -> [Block]
taskListItemToAscii :: Extensions -> [Block] -> [Block]
taskListItemToAscii = ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem [Inline] -> [Inline]
toMd
  where
    toMd :: [Inline] -> [Inline]
toMd (Str Text
"☐" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[ ]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"☒" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[x]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"❏" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[ ]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"✓" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[x]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toMd [Inline]
is = [Inline]
is
    rawMd :: Text -> Inline
rawMd = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"markdown")

handleTaskListItem :: ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem :: ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem [Inline] -> [Inline]
handleInlines Extensions
exts [Block]
bls =
  if Extension
Ext_task_lists Extension -> Extensions -> Bool
`extensionEnabled` Extensions
exts
  then [Block] -> [Block]
handleItem [Block]
bls
  else [Block]
bls
  where
    handleItem :: [Block] -> [Block]
handleItem (Plain [Inline]
is : [Block]
bs) = [Inline] -> Block
Plain ([Inline] -> [Inline]
handleInlines [Inline]
is) forall a. a -> [a] -> [a]
: [Block]
bs
    handleItem (Para [Inline]
is  : [Block]
bs) = [Inline] -> Block
Para  ([Inline] -> [Inline]
handleInlines [Inline]
is) forall a. a -> [a] -> [a]
: [Block]
bs
    handleItem [Block]
bs = [Block]
bs

-- | Set a field of a 'Meta' object.  If the field already has a value,
-- convert it into a list with the new value appended to the old value(s).
addMetaField :: ToMetaValue a
             => T.Text
             -> a
             -> Meta
             -> Meta
addMetaField :: forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
key a
val (Meta Map Text MetaValue
meta) =
  Map Text MetaValue -> Meta
Meta forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith MetaValue -> MetaValue -> MetaValue
combine Text
key (forall a. ToMetaValue a => a -> MetaValue
toMetaValue a
val) Map Text MetaValue
meta
  where combine :: MetaValue -> MetaValue -> MetaValue
combine MetaValue
newval (MetaList [MetaValue]
xs) = [MetaValue] -> MetaValue
MetaList ([MetaValue]
xs forall a. [a] -> [a] -> [a]
++ MetaValue -> [MetaValue]
tolist MetaValue
newval)
        combine MetaValue
newval MetaValue
x             = [MetaValue] -> MetaValue
MetaList [MetaValue
x, MetaValue
newval]
        tolist :: MetaValue -> [MetaValue]
tolist (MetaList [MetaValue]
ys) = [MetaValue]
ys
        tolist MetaValue
y             = [MetaValue
y]

-- | Remove soft breaks between East Asian characters.
eastAsianLineBreakFilter :: Pandoc -> Pandoc
eastAsianLineBreakFilter :: Pandoc -> Pandoc
eastAsianLineBreakFilter = forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp [Inline] -> [Inline]
go
  where go :: [Inline] -> [Inline]
go (Inline
x:Inline
SoftBreak:Inline
y:[Inline]
zs)
          | Just (Text
_, Char
b) <- Text -> Maybe (Text, Char)
T.unsnoc forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify Inline
x
          , Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify Inline
y
          , Char -> Int
charWidth Char
b forall a. Eq a => a -> a -> Bool
== Int
2
          , Char -> Int
charWidth Char
c forall a. Eq a => a -> a -> Bool
== Int
2
          = Inline
xforall a. a -> [a] -> [a]
:Inline
yforall a. a -> [a] -> [a]
:[Inline]
zs
          | Bool
otherwise
          = Inline
xforall a. a -> [a] -> [a]
:Inline
SoftBreakforall a. a -> [a] -> [a]
:Inline
yforall a. a -> [a] -> [a]
:[Inline]
zs
        go [Inline]
xs
          = [Inline]
xs

-- | Set of HTML elements that are represented as Span with a class equal as
-- the element tag itself.
htmlSpanLikeElements :: Set.Set T.Text
htmlSpanLikeElements :: Set Text
htmlSpanLikeElements = forall a. Ord a => [a] -> Set a
Set.fromList [Text
"kbd", Text
"mark", Text
"dfn"]

-- | Process ipynb output cells.  If mode is Nothing,
-- remove all output.  If mode is Just format, select
-- best output for the format.  If format is not ipynb,
-- strip out ANSI escape sequences from CodeBlocks (see #5633).
filterIpynbOutput :: Maybe Format -> Pandoc -> Pandoc
filterIpynbOutput :: Maybe Format -> Pandoc -> Pandoc
filterIpynbOutput Maybe Format
mode = forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
go
  where go :: Block -> Block
go (Div (Text
ident, Text
"output":[Text]
os, [(Text, Text)]
kvs) [Block]
bs) =
          case Maybe Format
mode of
            Maybe Format
Nothing  -> Attr -> [Block] -> Block
Div (Text
ident, Text
"output"forall a. a -> [a] -> [a]
:[Text]
os, [(Text, Text)]
kvs) []
            -- "best" for ipynb includes all formats:
            Just Format
fmt
              | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"ipynb"
                          -> Attr -> [Block] -> Block
Div (Text
ident, Text
"output"forall a. a -> [a] -> [a]
:[Text]
os, [(Text, Text)]
kvs) [Block]
bs
              | Bool
otherwise -> Attr -> [Block] -> Block
Div (Text
ident, Text
"output"forall a. a -> [a] -> [a]
:[Text]
os, [(Text, Text)]
kvs) forall a b. (a -> b) -> a -> b
$
                              forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
removeANSI forall a b. (a -> b) -> a -> b
$
                              forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Block -> Int
rank [Block]
bs
                 where
                  rank :: Block -> Int
rank (RawBlock (Format Text
"html") Text
_)
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = Int
1 :: Int
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"markdown" = Int
3
                    | Bool
otherwise = Int
4
                  rank (RawBlock (Format Text
"latex") Text
_)
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" = Int
1
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"markdown" = Int
3
                    | Bool
otherwise = Int
4
                  rank (RawBlock Format
f Text
_)
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Format
f = Int
1
                    | Bool
otherwise = Int
4
                  rank (Para [Image{}]) = Int
2
                  rank Block
_ = Int
3
                  removeANSI :: Block -> Block
removeANSI (CodeBlock Attr
attr Text
code) =
                    Attr -> Text -> Block
CodeBlock Attr
attr (Text -> Text
removeANSIEscapes Text
code)
                  removeANSI Block
x = Block
x
                  removeANSIEscapes :: Text -> Text
removeANSIEscapes Text
t
                    | Just Text
cs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"\x1b[" Text
t =
                        Text -> Text
removeANSIEscapes forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'm') Text
cs
                    | Just (Char
c, Text
cs) <- Text -> Maybe (Char, Text)
T.uncons Text
t = Char -> Text -> Text
T.cons Char
c forall a b. (a -> b) -> a -> b
$ Text -> Text
removeANSIEscapes Text
cs
                    | Bool
otherwise = Text
""
        go Block
x = Block
x

-- | Reformat 'Inlines' as code, putting the stringlike parts in 'Code'
-- elements while bringing other inline formatting outside.
-- The idea is that e.g. `[Str "a",Space,Strong [Str "b"]]` should turn
-- into `[Code ("",[],[]) "a ", Strong [Code ("",[],[]) "b"]]`.
-- This helps work around the limitation that pandoc's Code element can
-- only contain string content (see issue #7525).
formatCode :: Attr -> Inlines -> Inlines
formatCode :: Attr -> Inlines -> Inlines
formatCode Attr
attr = forall a. [a] -> Many a
B.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
fmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
B.toList
  where
    isPlaintext :: Inline -> Bool
isPlaintext (Str Text
_) = Bool
True
    isPlaintext Inline
Space = Bool
True
    isPlaintext Inline
SoftBreak = Bool
True
    isPlaintext (Quoted QuoteType
_ [Inline]
_) = Bool
True
    isPlaintext Inline
_ = Bool
False
    fmt :: [Inline] -> [Inline]
fmt = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Inline] -> [Inline]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Inline
a Inline
b -> Inline -> Bool
isPlaintext Inline
a Bool -> Bool -> Bool
&& Inline -> Bool
isPlaintext Inline
b)
      where
        go :: [Inline] -> [Inline]
go [Inline]
xs
          | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
isPlaintext [Inline]
xs = forall a. Many a -> [a]
B.toList forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
B.codeWith Attr
attr forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs
          | Bool
otherwise = [Inline]
xs

--
-- TagSoup HTML handling
--

-- | Render HTML tags.
renderTags' :: [Tag T.Text] -> T.Text
renderTags' :: [Tag Text] -> Text
renderTags' = forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions
               forall str. StringLike str => RenderOptions str
renderOptions{ optMinimize :: Text -> Bool
optMinimize = forall {t :: * -> *}. Foldable t => t Text -> Text -> Bool
matchTags [Text
"hr", Text
"br", Text
"img",
                                                       Text
"meta", Text
"link", Text
"col", Text
"use"]
                            , optRawTag :: Text -> Bool
optRawTag   = forall {t :: * -> *}. Foldable t => t Text -> Text -> Bool
matchTags [Text
"script", Text
"style"] }
              where matchTags :: t Text -> Text -> Bool
matchTags t Text
tags = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t Text
tags forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower

--
-- File handling
--

-- | Perform an IO action in a directory, returning to starting directory.
inDirectory :: FilePath -> IO a -> IO a
inDirectory :: forall a. [Char] -> IO a -> IO a
inDirectory [Char]
path IO a
action = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
                             IO [Char]
getCurrentDirectory
                             [Char] -> IO ()
setCurrentDirectory
                             (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
setCurrentDirectory [Char]
path forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
action)

-- | Canonicalizes a file path by removing redundant @.@ and @..@.
makeCanonical :: FilePath -> FilePath
makeCanonical :: [Char] -> [Char]
makeCanonical = [[Char]] -> [Char]
Posix.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
transformPathParts forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitDirectories
 where  transformPathParts :: [[Char]] -> [[Char]]
transformPathParts = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. (Eq a, IsString a) => [a] -> a -> [a]
go []
        go :: [a] -> a -> [a]
go [a]
as        a
"."  = [a]
as
        go (a
"..":[a]
as) a
".." = [a
"..", a
".."] forall a. Semigroup a => a -> a -> a
<> [a]
as
        go (a
_:[a]
as)    a
".." = [a]
as
        go [a]
as        a
x    = a
x forall a. a -> [a] -> [a]
: [a]
as

-- | Remove intermediate "." and ".." directories from a path.
--
-- > collapseFilePath "./foo" == "foo"
-- > collapseFilePath "/bar/../baz" == "/baz"
-- > collapseFilePath "/../baz" == "/../baz"
-- > collapseFilePath "parent/foo/baz/../bar" ==  "parent/foo/bar"
-- > collapseFilePath "parent/foo/baz/../../bar" ==  "parent/bar"
-- > collapseFilePath "parent/foo/.." ==  "parent"
-- > collapseFilePath "/parent/foo/../../bar" ==  "/bar"
collapseFilePath :: FilePath -> FilePath
collapseFilePath :: [Char] -> [Char]
collapseFilePath = [[Char]] -> [Char]
Posix.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [[Char]] -> [Char] -> [[Char]]
go [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitDirectories
  where
    go :: [[Char]] -> [Char] -> [[Char]]
go [[Char]]
rs [Char]
"." = [[Char]]
rs
    go r :: [[Char]]
r@([Char]
p:[[Char]]
rs) [Char]
".." = case [Char]
p of
                            [Char]
".."                              -> [Char]
".."forall a. a -> [a] -> [a]
:[[Char]]
r
                            ([Char] -> Maybe Bool
checkPathSeperator -> Just Bool
True) -> [Char]
".."forall a. a -> [a] -> [a]
:[[Char]]
r
                            [Char]
_                                 -> [[Char]]
rs
    go [[Char]]
_ ([Char] -> Maybe Bool
checkPathSeperator -> Just Bool
True) = [[Char
Posix.pathSeparator]]
    go [[Char]]
rs [Char]
x = [Char]
xforall a. a -> [a] -> [a]
:[[Char]]
rs
    isSingleton :: [a] -> Maybe a
isSingleton []  = forall a. Maybe a
Nothing
    isSingleton [a
x] = forall a. a -> Maybe a
Just a
x
    isSingleton [a]
_   = forall a. Maybe a
Nothing
    checkPathSeperator :: [Char] -> Maybe Bool
checkPathSeperator = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Bool
isPathSeparator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> Maybe a
isSingleton

--
-- File selection from the archive
--
filteredFilesFromArchive :: Archive -> (FilePath -> Bool) -> [(FilePath, BL.ByteString)]
filteredFilesFromArchive :: Archive -> ([Char] -> Bool) -> [([Char], ByteString)]
filteredFilesFromArchive Archive
zf [Char] -> Bool
f =
  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Archive -> [Char] -> Maybe ([Char], ByteString)
fileAndBinary Archive
zf) (forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
f (Archive -> [[Char]]
filesInArchive Archive
zf))
  where
    fileAndBinary :: Archive -> FilePath -> Maybe (FilePath, BL.ByteString)
    fileAndBinary :: Archive -> [Char] -> Maybe ([Char], ByteString)
fileAndBinary Archive
a [Char]
fp = [Char] -> Archive -> Maybe Entry
findEntryByPath [Char]
fp Archive
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Entry
e -> forall a. a -> Maybe a
Just ([Char]
fp, Entry -> ByteString
fromEntry Entry
e)

---
--- Squash blocks into inlines
---

blockToInlines :: Block -> Inlines
blockToInlines :: Block -> Inlines
blockToInlines (Plain [Inline]
ils) = forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines (Para [Inline]
ils) = forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines (LineBlock [[Inline]]
lns) = forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$ [[Inline]] -> [Inline]
combineLines [[Inline]]
lns
blockToInlines (CodeBlock Attr
attr Text
str) = Attr -> Text -> Inlines
B.codeWith Attr
attr Text
str
blockToInlines (RawBlock (Format Text
fmt) Text
str) = Text -> Text -> Inlines
B.rawInline Text
fmt Text
str
blockToInlines (BlockQuote [Block]
blks) = [Block] -> Inlines
blocksToInlines' [Block]
blks
blockToInlines (OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
blkslst) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst
blockToInlines (BulletList [[Block]]
blkslst) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst
blockToInlines (DefinitionList [([Inline], [[Block]])]
pairslst) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ([Inline], [[Block]]) -> Inlines
f [([Inline], [[Block]])]
pairslst
  where
    f :: ([Inline], [[Block]]) -> Inlines
f ([Inline]
ils, [[Block]]
blkslst) = forall a. [a] -> Many a
B.fromList [Inline]
ils forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.str Text
":" forall a. Semigroup a => a -> a -> a
<> Inlines
B.space forall a. Semigroup a => a -> a -> a
<>
      forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst)
blockToInlines (Header Int
_ Attr
_  [Inline]
ils) = forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines Block
HorizontalRule = forall a. Monoid a => a
mempty
blockToInlines (Table Attr
_ Caption
_ [ColSpec]
_ (TableHead Attr
_ [Row]
hbd) [TableBody]
bodies (TableFoot Attr
_ [Row]
fbd)) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Inlines
B.linebreak forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines') (Row -> [[Block]]
plainRowBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row]
hbd forall a. Semigroup a => a -> a -> a
<> [TableBody] -> [Row]
unTableBodies [TableBody]
bodies forall a. Semigroup a => a -> a -> a
<> [Row]
fbd)
  where
    plainRowBody :: Row -> [[Block]]
plainRowBody (Row Attr
_ [Cell]
body) = Cell -> [Block]
cellBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cell]
body
    cellBody :: Cell -> [Block]
cellBody (Cell Attr
_ Alignment
_ RowSpan
_ ColSpan
_ [Block]
body) = [Block]
body
    unTableBody :: TableBody -> [Row]
unTableBody (TableBody Attr
_ RowHeadColumns
_ [Row]
hd [Row]
bd) = [Row]
hd forall a. Semigroup a => a -> a -> a
<> [Row]
bd
    unTableBodies :: [TableBody] -> [Row]
unTableBodies = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TableBody -> [Row]
unTableBody
blockToInlines (Div Attr
_ [Block]
blks) = [Block] -> Inlines
blocksToInlines' [Block]
blks
blockToInlines (Figure Attr
_ Caption
_ [Block]
body) = [Block] -> Inlines
blocksToInlines' [Block]
body

blocksToInlinesWithSep :: Inlines -> [Block] -> Inlines
blocksToInlinesWithSep :: Inlines -> [Block] -> Inlines
blocksToInlinesWithSep Inlines
sep =
  forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Inlines
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Block -> Inlines
blockToInlines

blocksToInlines' :: [Block] -> Inlines
blocksToInlines' :: [Block] -> Inlines
blocksToInlines' = Inlines -> [Block] -> Inlines
blocksToInlinesWithSep Inlines
defaultBlocksSeparator

blocksToInlines :: [Block] -> [Inline]
blocksToInlines :: [Block] -> [Inline]
blocksToInlines = forall a. Many a -> [a]
B.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Inlines
blocksToInlines'

-- | Inline elements used to separate blocks when squashing blocks into
-- inlines.
defaultBlocksSeparator :: Inlines
defaultBlocksSeparator :: Inlines
defaultBlocksSeparator =
  -- This is used in the pandoc.utils.blocks_to_inlines function. Docs
  -- there should be updated if this is changed.
  Inlines
B.linebreak

--
-- Safe read
--

safeRead :: (MonadPlus m, Read a) => T.Text -> m a
safeRead :: forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead = forall (m :: * -> *) a. (MonadPlus m, Read a) => [Char] -> m a
safeStrRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

safeStrRead :: (MonadPlus m, Read a) => String -> m a
safeStrRead :: forall (m :: * -> *) a. (MonadPlus m, Read a) => [Char] -> m a
safeStrRead [Char]
s = case forall a. Read a => ReadS a
reads [Char]
s of
                  (a
d,[Char]
x):[(a, [Char])]
_
                    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
d
                  [(a, [Char])]
_                 -> forall (m :: * -> *) a. MonadPlus m => m a
mzero