{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE ViewPatterns          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{- |
   Module      : Text.Pandoc.Shared
   Copyright   : Copyright (C) 2006-2024 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
                     addPandocAttributes,
                     orderedListMarkers,
                     extractSpaces,
                     removeFormatting,
                     deNote,
                     stringify,
                     capitalize,
                     compactify,
                     compactifyDL,
                     linesToPara,
                     figureDiv,
                     makeSections,
                     combineAttr,
                     uniqueIdent,
                     inlineListToIdentifier,
                     textToIdentifier,
                     isHeaderBlock,
                     stripEmptyParagraphs,
                     onlySimpleTableCells,
                     isTightList,
                     taskListItemFromAscii,
                     taskListItemToAscii,
                     handleTaskListItem,
                     addMetaField,
                     htmlSpanLikeElements,
                     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)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import Data.Monoid (Any (..) )
import Data.Semigroup (Min (..))
import Data.Sequence (ViewL (..), ViewR (..), viewl, viewr)
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Text.Emoji as Emoji
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.DocLayout (charWidth)
import Text.Pandoc.Walk
-- for addPandocAttributes:
import Commonmark.Pandoc (Cm(..))
import Commonmark (HasAttributes(..))

--
-- 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) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
isSep [a]
lst
  in  [a]
first[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:(a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy a -> Bool
isSep ((a -> Bool) -> [a] -> [a]
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 Text -> [Text] -> [Text]
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 ((Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
ns (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ns)) ([Char] -> [Text]) -> (Text -> [Char]) -> Text -> [Text]
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 Text -> [Text] -> [Text]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([],[Char]
xs)
splitAt' Int
n (Char
x:[Char]
xs)      = (Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
ys,[Char]
zs)
  where ([Char]
ys,[Char]
zs) = Int -> [Char] -> ([Char], [Char])
splitAt' (Int
n Int -> Int -> Int
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 ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
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 (Char -> Char -> Bool
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 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripBeginSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
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 (HasCallStack => Text -> Char
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 ([Char] -> Text) -> (Text -> [Char]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
camelCaseStrToHyphenated ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
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
aChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'-'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char -> Char
toLower Char
bChar -> [Char] -> [Char]
forall 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
aChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'-'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char -> Char
toLower Char
bChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char] -> [Char]
camelCaseStrToHyphenated (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest)
camelCaseStrToHyphenated (Char
a:[Char]
rest) = Char -> Char
toLower Char
aChar -> [Char] -> [Char]
forall 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4000 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Text
"?"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000 = Text
"M" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1000)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
900  = Text
"CM" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
900)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
500  = Text
"D" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
500)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400  = Text
"CD" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
400)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100  = Text
"C" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
90   = Text
"XC" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
90)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
50   = Text
"L"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
50)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
40   = Text
"XL" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
40)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10   = Text
"X" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9    = Text
"IX"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5    = Text
"V" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4    = Text
"IV"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1    = Text
"I" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
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 = Text -> Text
forall a. a -> a
id
tabFilter Int
tabStop = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
go ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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 (Char -> Char -> Bool
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate
                       (Int
tabStop Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Text -> Int
T.length Text
s1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
tabStop)) ([Char] -> Text
T.pack [Char]
" ")
                       Text -> Text -> Text
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 = ([Char] -> Text) -> Maybe [Char] -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack (Maybe [Char] -> Maybe Text)
-> (Text -> Maybe [Char]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char]
normalizeDate' ([Char] -> Maybe [Char])
-> (Text -> [Char]) -> Text -> Maybe [Char]
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 = (Day -> [Char]) -> Maybe Day -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TimeLocale -> [Char] -> Day -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%F")
  ([Maybe Day] -> Maybe Day
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe Day] -> Maybe Day) -> [Maybe Day] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe Day) -> [[Char]] -> [Maybe Day]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
fs -> [Char] -> [Char] -> Maybe Day
parsetimeWith [Char]
fs [Char]
s Maybe Day -> (Day -> Maybe Day) -> Maybe Day
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
>= Year
1601 Bool -> Bool -> Bool
&& Year
y Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
<= Year
9999 -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
day
          (Year, Int, Int)
_         -> Maybe Day
forall a. Maybe a
Nothing
        parsetimeWith :: [Char] -> [Char] -> Maybe Day
parsetimeWith = Bool -> TimeLocale -> [Char] -> [Char] -> Maybe Day
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
--

-- | Add key-value attributes to a pandoc element. If the element
-- does not have a slot for attributes, create an enclosing Span
-- (for Inlines) or Div (for Blocks).  Note that both 'Cm () Inlines'
-- and 'Cm () Blocks' are instances of 'HasAttributes'.
addPandocAttributes
  :: forall b . HasAttributes (Cm () b) => [(T.Text, T.Text)] -> b -> b
addPandocAttributes :: forall b. HasAttributes (Cm () b) => [(Text, Text)] -> b -> b
addPandocAttributes [] b
bs = b
bs
addPandocAttributes [(Text, Text)]
kvs b
bs =
  Cm () b -> b
forall b a. Cm b a -> a
unCm (Cm () b -> b) -> (Cm () b -> Cm () b) -> Cm () b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Cm () b -> Cm () b
forall a. HasAttributes a => [(Text, Text)] -> a -> a
addAttributes ((Text
"wrapper",Text
"1")(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs) (Cm () b -> b) -> Cm () b -> b
forall a b. (a -> b) -> a -> b
$ (b -> Cm () b
forall b a. a -> Cm b a
Cm b
bs :: Cm () b)

-- | 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 -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
Example      -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
Decimal      -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
UpperAlpha   -> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
cycle ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
                                     (Char -> Text) -> [Char] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'A'..Char
'Z']
                     ListNumberStyle
LowerAlpha   -> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
cycle ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
                                     (Char -> Text) -> [Char] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'a'..Char
'z']
                     ListNumberStyle
UpperRoman   -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
toRomanNumeral [Int
start..]
                     ListNumberStyle
LowerRoman   -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
T.toLower (Text -> Text) -> (Int -> Text) -> Int -> Text
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 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"."
                            ListNumberDelim
Period       -> a
str a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"."
                            ListNumberDelim
OneParen     -> a
str a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
                            ListNumberDelim
TwoParens    -> a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
str a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
  in  (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
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 = Inlines -> Seq Inline
forall a. Many a -> Seq a
B.unMany Inlines
is
      left :: Inlines
left  = case Seq Inline -> ViewL Inline
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
_                -> Inlines
forall a. Monoid a => a
mempty
      right :: Inlines
right = case Seq Inline -> ViewR Inline
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
_                -> Inlines
forall a. Monoid a => a
mempty in
  (Inlines
left Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
f (Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Inline -> Inlines
forall a. Seq a -> Many a
B.Many (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ Seq Inline
contents) Inlines -> Inlines -> Inlines
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 = (Inline -> [Inline]) -> a -> [Inline]
forall c. Monoid c => (Inline -> c) -> a -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [Inline]
go (a -> [Inline]) -> (a -> a) -> a -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> a -> a
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
deNote (Inline -> Inline) -> (Inline -> Inline) -> Inline -> Inline
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 = (Inline -> Text) -> a -> Text
forall c. Monoid c => (Inline -> c) -> a -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
go (a -> Text) -> (a -> a) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> a -> a
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" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs [Inline] -> [Inline] -> [Inline]
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" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs [Inline] -> [Inline] -> [Inline]
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 = (Inline -> Inline) -> a -> a
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 (Text -> Inline) -> Text -> Inline
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) = ([Blocks] -> [Blocks]
forall a. HasCallStack => [a] -> [a]
init [Blocks]
items, [Blocks] -> Blocks
forall a. HasCallStack => [a] -> a
last [Blocks]
items)
  in  case [Block] -> [Block]
forall a. [a] -> [a]
reverse (Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
final) of
           (Para [Inline]
a:[Block]
xs)
             | [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline] -> Block
Para [Inline]
x | Para [Inline]
x <- [Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ (Blocks -> [Block]) -> [Blocks] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Blocks -> [Block]
forall a. Many a -> [a]
B.toList [Blocks]
others]
             -> [Blocks]
others [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++ [[Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Block] -> [Block]
forall a. [a] -> [a]
reverse ([Inline] -> Block
Plain [Inline]
a Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs))]
           [Block]
_ | [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline] -> Block
Para [Inline]
x | Para [Inline]
x <- (Blocks -> [Block]) -> [Blocks] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Blocks -> [Block]
forall a. Many a -> [a]
B.toList [Blocks]
items]
             -> [Blocks]
items
           [Block]
_ -> (Blocks -> Blocks) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> Block) -> Blocks -> Blocks
forall a b. (a -> b) -> Many a -> Many b
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 [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
forall a. [a] -> [a]
reverse [(Inlines, [Blocks])]
items of
        ((Inlines
t,[Blocks]
ds):[(Inlines, [Blocks])]
ys) ->
           case [[Block]] -> [[Block]]
forall a. [a] -> [a]
reverse ((Blocks -> [Block]) -> [Blocks] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map ([Block] -> [Block]
forall a. [a] -> [a]
reverse ([Block] -> [Block]) -> (Blocks -> [Block]) -> Blocks -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [Block]
forall a. Many a -> [a]
B.toList) [Blocks]
ds) of
             ((Para [Inline]
x:[Block]
xs) : [[Block]]
zs) | Bool -> Bool
not ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isPara [Block]
xs) ->
                  [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
forall a. [a] -> [a]
reverse [(Inlines, [Blocks])]
ys [(Inlines, [Blocks])]
-> [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
forall a. [a] -> [a] -> [a]
++
                    [(Inlines
t, [Blocks] -> [Blocks]
forall a. [a] -> [a]
reverse (([Block] -> Blocks) -> [[Block]] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [[Block]]
zs) [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++
                         [[Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Block] -> [Block]
forall a. [a] -> [a]
reverse ([Inline] -> Block
Plain [Inline]
xBlock -> [Block] -> [Block]
forall 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 = [Inline] -> [[Inline]] -> [Inline]
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 ([Inline] -> Block)
-> ([[Inline]] -> [Inline]) -> [[Inline]] -> Block
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"] [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Text]
classes
              , [(Text, Text)]
kv
              )
      captkv :: [(Text, Text)]
captkv = [(Text, Text)]
-> ([Inline] -> [(Text, Text)]) -> Maybe [Inline] -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Text, Text)]
forall a. Monoid a => a
mempty (\[Inline]
s -> [(Text
"short-caption", [Inline] -> Text
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 ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
longcapt)]
  in Attr -> [Block] -> Block
Div Attr
divattr ([Block]
body [Block] -> [Block] -> [Block]
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 (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> ([Inline] -> [Inline]) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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 = (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
unEmoji
      | Bool
otherwise = [Inline] -> [Inline]
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 (Str Text
t) = Text -> Inline
Str ((Text -> [Text] -> Text) -> Text -> Text
Emoji.replaceEmojis Text -> [Text] -> Text
forall {p}. p -> [p] -> p
emojisToAliases Text
t)
    unEmoji Inline
x = Inline
x
    emojisToAliases :: p -> [p] -> p
emojisToAliases p
t [] = p
t
    emojisToAliases p
_ (p
a:[p]
_) = p
a

-- | Convert string to plain text identifier.
textToIdentifier :: Extensions -> T.Text -> T.Text
textToIdentifier :: Extensions -> Text -> Text
textToIdentifier Extensions
exts =
  Text -> Text
dropNonLetter (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
filterAscii (Text -> Text) -> (Text -> Text) -> Text -> Text
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 = Text -> Text
forall a. a -> a
id
      | Bool
otherwise = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
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 = Text -> Text
forall a. a -> a
id
    toIdent :: Text -> Text
toIdent
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts =
        Text -> Text
filterPunct (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
spaceToDash (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
      | Bool
otherwise = Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
filterPunct (Text -> Text) -> (Text -> Text) -> Text -> Text
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
||
          Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> [GeneralCategory] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GeneralCategory
NonSpacingMark, GeneralCategory
SpacingCombiningMark,
                                    GeneralCategory
EnclosingMark, GeneralCategory
ConnectorPunctuation]
      | Bool
otherwise = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
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 so that the lowest header level is n.
-- (There may still be gaps in header level if the author leaves them.)
makeSections :: Bool -> Maybe Int -> [Block] -> [Block]
makeSections :: Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
numbering Maybe Int
mbBaseLevel [Block]
bs =
  State [Int] [Block] -> [Int] -> [Block]
forall s a. State s a -> s -> a
S.evalState ([Block] -> State [Int] [Block]
go [Block]
bs) []
 where
  getLevel :: Block -> Min Int
getLevel (Header Int
level Attr
_ [Inline]
_) = Int -> Min Int
forall a. a -> Min a
Min Int
level
  getLevel Block
_ = Int -> Min Int
forall a. a -> Min a
Min Int
99
  minLevel :: Int
minLevel = Min Int -> Int
forall a. Min a -> a
getMin (Min Int -> Int) -> Min Int -> Int
forall a b. (a -> b) -> a -> b
$ (Block -> Min Int) -> [Block] -> Min Int
forall c. Monoid c => (Block -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> Min Int
getLevel [Block]
bs
  go :: [Block] -> S.State [Int] [Block]
  go :: [Block] -> State [Int] [Block]
go (Header Int
level (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
title':[Block]
xs) = do
    [Int]
lastnum <- StateT [Int] Identity [Int]
forall s (m :: * -> *). MonadState s m => m s
S.get
    let level' :: Int
level' = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
level (\Int
n -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minLevel) Maybe Int
mbBaseLevel
    let adjustNum :: Int -> p -> p
adjustNum Int
lev p
numComponent
          | Int
lev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
level = p
numComponent
          | Int
lev Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
level = p
numComponent p -> p -> p
forall a. Num a => a -> a -> a
+ p
1
          | Bool
otherwise = p
0
    let newnum :: [Int]
newnum = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall {p}. Num p => Int -> p -> p
adjustNum [Int
minLevel..Int
level]
                    ([Int]
lastnum [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
    Bool -> StateT [Int] Identity () -> StateT [Int] Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
newnum Bool -> Bool -> Bool
|| Text
"unnumbered" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes) (StateT [Int] Identity () -> StateT [Int] Identity ())
-> StateT [Int] Identity () -> StateT [Int] Identity ()
forall a b. (a -> b) -> a -> b
$ [Int] -> StateT [Int] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
S.put [Int]
newnum
    let ([Block]
sectionContents, [Block]
rest) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> Block -> Bool
headerLtEq Int
level) [Block]
xs
    [Block]
sectionContents' <- [Block] -> State [Int] [Block]
go [Block]
sectionContents
    [Block]
rest' <- [Block] -> State [Int] [Block]
go [Block]
rest
    let kvs' :: [(Text, Text)]
kvs' = -- don't touch number if already present
               case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs of
                  Maybe Text
Nothing | Bool
numbering
                          , Text
"unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes ->
                        (Text
"number", Text -> [Text] -> Text
T.intercalate Text
"." ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow [Int]
newnum)) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                  Maybe Text
_ -> [(Text, Text)]
kvs
    let divattr :: Attr
divattr = (Text
ident, Text
"section"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
classes, [(Text, Text)]
kvs')
    let attr :: Attr
attr = (Text
"",[Text]
classes,[(Text, Text)]
kvs')
    [Block] -> State [Int] [Block]
forall a. a -> StateT [Int] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> State [Int] [Block]) -> [Block] -> State [Int] [Block]
forall a b. (a -> b) -> a -> b
$
      Attr -> [Block] -> Block
Div Attr
divattr (Int -> Attr -> [Inline] -> Block
Header Int
level' Attr
attr [Inline]
title' Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
sectionContents') Block -> [Block] -> [Block]
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)
      | (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case
               Header Int
level' Attr
_ [Inline]
_ -> Int
level' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
level
               Block
_                 -> Bool
True) [Block]
ys
      , Text
"column" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses
      , Text
"columns" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses
      , Text
"fragment" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses = do
    [Block]
inner <- [Block] -> State [Int] [Block]
go (Int -> Attr -> [Inline] -> Block
Header Int
level Attr
hattr [Inline]
title'Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
ys)
    [Block]
rest <- [Block] -> State [Int] [Block]
go [Block]
xs
    [Block] -> State [Int] [Block]
forall a. a -> StateT [Int] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> State [Int] [Block]) -> [Block] -> State [Int] [Block]
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
dident'
              -> Attr -> [Block] -> Block
Div (Attr -> Attr -> Attr
combineAttr Attr
divattr' Attr
divattr) [Block]
zs Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
            [Block]
_ -> Attr -> [Block] -> Block
Div Attr
divattr [Block]
inner Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
  go (Div Attr
attr [Block]
xs : [Block]
rest) = do
    [Block]
xs' <- [Block] -> State [Int] [Block]
go [Block]
xs
    [Block]
rest' <- [Block] -> State [Int] [Block]
go [Block]
rest
    [Block] -> State [Int] [Block]
forall a. a -> StateT [Int] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> State [Int] [Block]) -> [Block] -> State [Int] [Block]
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div Attr
attr [Block]
xs' Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest'
  go (Block
x:[Block]
xs) = (Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:) ([Block] -> [Block]) -> State [Int] [Block] -> State [Int] [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> State [Int] [Block]
go [Block]
xs
  go [] = [Block] -> State [Int] [Block]
forall a. a -> StateT [Int] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Combine two 'Attr'. Classes are concatenated.  For the id and key-value
-- attributes, the first one takes precedence in case of duplicates.
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,
   [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd ([Text]
classes1 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
classes2),
   ((Text, Text) -> [(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Text
k,Text
v) [(Text, Text)]
kvs -> case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Text)]
kvs of
                           Maybe Text
Nothing -> (Text
k,Text
v)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs
                           Just Text
_  -> [(Text, Text)]
kvs) [(Text, Text)]
kvs1 [(Text, Text)]
kvs2)

headerLtEq :: Int -> Block -> Bool
headerLtEq :: Int -> Block -> Bool
headerLtEq Int
level (Header Int
l Attr
_ [Inline]
_)  = Int
l Int -> Int -> Bool
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 Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
usedIdents
     then Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
baseIdent Int -> Text
forall a. Show a => a -> Text
numIdent
          (Maybe Int -> Text) -> Maybe Int -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> Maybe Int
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Int
x -> Int -> Text
forall a. Show a => a -> Text
numIdent Int
x Text -> Set Text -> Bool
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
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

-- | Remove empty paragraphs.
stripEmptyParagraphs :: Pandoc -> Pandoc
stripEmptyParagraphs :: Pandoc -> Pandoc
stripEmptyParagraphs = ([Block] -> [Block]) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Block] -> [Block]
go
  where go :: [Block] -> [Block]
        go :: [Block] -> [Block]
go = (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
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 = ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleCell ([[Block]] -> Bool)
-> ([[[Block]]] -> [[Block]]) -> [[[Block]]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Block]]] -> [[Block]]
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 (Any -> Bool) -> ([Inline] -> Any) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Any) -> [Inline] -> Any
forall c. Monoid c => (Inline -> c) -> [Inline] -> 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 = ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isPlainItem
  where
    isPlainItem :: [Block] -> Bool
isPlainItem [] = Bool
True
    isPlainItem (Plain [Inline]
_ : [Block]
_) = Bool
True
    isPlainItem [BulletList [[Block]]
xs] = [[Block]] -> Bool
isTightList [[Block]]
xs
    isPlainItem [OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
xs] = [[Block]] -> Bool
isTightList [[Block]]
xs
    isPlainItem [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
"☐" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd (Str Text
"[x]"                 : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☒" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd (Str Text
"[X]"                 : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☒" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
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
"[ ]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"☒" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[x]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"❏" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[ ]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"✓" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[x]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
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) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs
    handleItem (Para [Inline]
is  : [Block]
bs) = [Inline] -> Block
Para  ([Inline] -> [Inline]
handleInlines [Inline]
is) Block -> [Block] -> [Block]
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 (Map Text MetaValue -> Meta) -> Map Text MetaValue -> Meta
forall a b. (a -> b) -> a -> b
$ (MetaValue -> MetaValue -> MetaValue)
-> Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith MetaValue -> MetaValue -> MetaValue
combine Text
key (a -> MetaValue
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 [MetaValue] -> [MetaValue] -> [MetaValue]
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]

-- | 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 = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text
"kbd", Text
"mark", Text
"dfn"]

-- | 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 = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([Inline] -> Inlines)
-> (Inlines -> [Inline]) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
fmt ([Inline] -> [Inline])
-> (Inlines -> [Inline]) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
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 = ([Inline] -> [Inline]) -> [[Inline]] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Inline] -> [Inline]
go ([[Inline]] -> [Inline])
-> ([Inline] -> [[Inline]]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline -> Bool) -> [Inline] -> [[Inline]]
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
          | (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
isPlaintext [Inline]
xs = Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline]) -> Inlines -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
B.codeWith Attr
attr (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
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' = RenderOptions Text -> [Tag Text] -> Text
forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions
               RenderOptions Text
forall str. StringLike str => RenderOptions str
renderOptions{ optMinimize = matchTags ["hr", "br", "img",
                                                       "meta", "link", "col",
                                                       "use", "path", "rect"]
                            , optRawTag   = matchTags ["script", "style"] }
              where matchTags :: t Text -> Text -> Bool
matchTags t Text
tags = (Text -> t Text -> Bool) -> t Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> t Text -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t Text
tags (Text -> Bool) -> (Text -> Text) -> Text -> Bool
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 = IO [Char] -> ([Char] -> IO ()) -> ([Char] -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
                             IO [Char]
getCurrentDirectory
                             [Char] -> IO ()
setCurrentDirectory
                             (IO a -> [Char] -> IO a
forall a b. a -> b -> a
const (IO a -> [Char] -> IO a) -> IO a -> [Char] -> IO a
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
setCurrentDirectory [Char]
path IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
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 ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
transformPathParts ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitDirectories
 where  transformPathParts :: [[Char]] -> [[Char]]
transformPathParts = [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Char] -> [[Char]])
-> [[Char]] -> [[Char]] -> [[Char]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [[Char]] -> [Char] -> [[Char]]
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
".."] [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 a -> [a] -> [a]
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 ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Char] -> [[Char]])
-> [[Char]] -> [[Char]] -> [[Char]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [[Char]] -> [Char] -> [[Char]]
go [] ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
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]
".."[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
r
                            ([Char] -> Maybe Bool
checkPathSeperator -> Just Bool
True) -> [Char]
".."[Char] -> [[Char]] -> [[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]
x[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
rs
    isSingleton :: [a] -> Maybe a
isSingleton []  = Maybe a
forall a. Maybe a
Nothing
    isSingleton [a
x] = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    isSingleton [a]
_   = Maybe a
forall a. Maybe a
Nothing
    checkPathSeperator :: [Char] -> Maybe Bool
checkPathSeperator = (Char -> Bool) -> Maybe Char -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Bool
isPathSeparator (Maybe Char -> Maybe Bool)
-> ([Char] -> Maybe Char) -> [Char] -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe Char
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 =
  ([Char] -> Maybe ([Char], ByteString))
-> [[Char]] -> [([Char], ByteString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Archive -> [Char] -> Maybe ([Char], ByteString)
fileAndBinary Archive
zf) (([Char] -> Bool) -> [[Char]] -> [[Char]]
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 Maybe Entry
-> (Entry -> Maybe ([Char], ByteString))
-> Maybe ([Char], ByteString)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Entry
e -> ([Char], ByteString) -> Maybe ([Char], ByteString)
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) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines (Para [Inline]
ils) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines (LineBlock [[Inline]]
lns) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([Inline] -> Inlines) -> [Inline] -> Inlines
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) =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ([Block] -> Inlines) -> [[Block]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst
blockToInlines (BulletList [[Block]]
blkslst) =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ([Block] -> Inlines) -> [[Block]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst
blockToInlines (DefinitionList [([Inline], [[Block]])]
pairslst) =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> Inlines)
-> [([Inline], [[Block]])] -> [Inlines]
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) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.str Text
":" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
      [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (([Block] -> Inlines) -> [[Block]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst)
blockToInlines (Header Int
_ Attr
_  [Inline]
ils) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines Block
HorizontalRule = Inlines
forall a. Monoid a => a
mempty
blockToInlines (Table Attr
_ Caption
_ [ColSpec]
_ (TableHead Attr
_ [Row]
hbd) [TableBody]
bodies (TableFoot Attr
_ [Row]
fbd)) =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.linebreak ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$
    ([[Block]] -> Inlines) -> [[[Block]]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([[Block]] -> [Inlines]) -> [[Block]] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> Inlines) -> [[Block]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines') (Row -> [[Block]]
plainRowBody (Row -> [[Block]]) -> [Row] -> [[[Block]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row]
hbd [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [TableBody] -> [Row]
unTableBodies [TableBody]
bodies [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [Row]
fbd)
  where
    plainRowBody :: Row -> [[Block]]
plainRowBody (Row Attr
_ [Cell]
body) = Cell -> [Block]
cellBody (Cell -> [Block]) -> [Cell] -> [[Block]]
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 [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [Row]
bd
    unTableBodies :: [TableBody] -> [Row]
unTableBodies = (TableBody -> [Row]) -> [TableBody] -> [Row]
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 =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Block] -> [Inlines]) -> [Block] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
sep ([Inlines] -> [Inlines])
-> ([Block] -> [Inlines]) -> [Block] -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Inlines) -> [Block] -> [Inlines]
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 = Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline])
-> ([Block] -> Inlines) -> [Block] -> [Inline]
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 = [Char] -> m a
forall (m :: * -> *) a. (MonadPlus m, Read a) => [Char] -> m a
safeStrRead ([Char] -> m a) -> (Text -> [Char]) -> Text -> m a
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 ReadS a
forall a. Read a => ReadS a
reads [Char]
s of
                  (a
d,[Char]
x):[(a, [Char])]
_
                    | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
x -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
                  [(a, [Char])]
_                 -> m a
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero