{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Citeproc
  ( processCitations,
    getReferences,
    getStyle
  )
where

import Citeproc
import Citeproc.Pandoc ()
import Text.Pandoc.Citeproc.Locator (parseLocator)
import Text.Pandoc.Citeproc.CslJson (cslJsonToReferences)
import Text.Pandoc.Citeproc.BibTeX (readBibtexString, Variant(..))
import Text.Pandoc.Citeproc.MetaValue (metaValueToReference, metaValueToText)
import Text.Pandoc.Readers.Markdown (yamlToRefs)
import qualified Text.Pandoc.BCP47 as BCP47
import Text.Pandoc.Builder (Inlines, Many(..), deleteMeta, setMeta)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Definition as Pandoc
import Text.Pandoc.Class (PandocMonad(..), getResourcePath, getUserDataDir,
                          fetchItem, readDataFile, report, setResourcePath)
import Text.Pandoc.Error (PandocError(..))
import Text.Pandoc.Extensions (pandocExtensions)
import Text.Pandoc.Logging (LogMessage(..))
import Text.Pandoc.Options (ReaderOptions(..))
import Text.Pandoc.Shared (stringify, ordNub, blocksToInlines, tshow)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Walk (query, walk, walkM)
import Control.Applicative ((<|>))
import Control.Monad.Except (catchError, throwError)
import Control.Monad.State (State, evalState, get, put, runState)
import Data.Aeson (eitherDecode)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import Data.Char (isPunctuation, isUpper)
import Data.Default (Default(def))
import qualified Data.Foldable as Foldable
import qualified Data.Map as M
import Data.Maybe (mapMaybe, fromMaybe)
import Data.Ord ()
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import System.FilePath (takeExtension)
import Safe (lastMay, initSafe)


processCitations  :: PandocMonad m => Pandoc -> m Pandoc
processCitations :: Pandoc -> m Pandoc
processCitations (Pandoc Meta
meta [Block]
bs) = do
  Style Inlines
style <- Pandoc -> m (Style Inlines)
forall (m :: * -> *). PandocMonad m => Pandoc -> m (Style Inlines)
getStyle (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs)

  Maybe Lang
mblang <- Meta -> m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Meta -> m (Maybe Lang)
getLang Meta
meta
  let locale :: Locale
locale = Maybe Lang -> Style Inlines -> Locale
forall a. Maybe Lang -> Style a -> Locale
Citeproc.mergeLocales Maybe Lang
mblang Style Inlines
style

  [Reference Inlines]
refs <- Maybe Locale -> Pandoc -> m [Reference Inlines]
forall (m :: * -> *).
PandocMonad m =>
Maybe Locale -> Pandoc -> m [Reference Inlines]
getReferences (Locale -> Maybe Locale
forall a. a -> Maybe a
Just Locale
locale) (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs)

  let otherIdsMap :: Map Text ItemId
otherIdsMap = (Reference Inlines -> Map Text ItemId -> Map Text ItemId)
-> Map Text ItemId -> [Reference Inlines] -> Map Text ItemId
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Reference Inlines
ref Map Text ItemId
m ->
                             case Text -> [Text]
T.words (Text -> [Text]) -> (Val Inlines -> Text) -> Val Inlines -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Text
extractText (Val Inlines -> [Text]) -> Maybe (Val Inlines) -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                  Variable -> Map Variable (Val Inlines) -> Maybe (Val Inlines)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Variable
"other-ids"
                                      (Reference Inlines -> Map Variable (Val Inlines)
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference Inlines
ref) of
                                Maybe [Text]
Nothing  -> Map Text ItemId
m
                                Just [Text]
ids -> (Text -> Map Text ItemId -> Map Text ItemId)
-> Map Text ItemId -> [Text] -> Map Text ItemId
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                                  (\Text
id' ->
                                    Text -> ItemId -> Map Text ItemId -> Map Text ItemId
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
id' (Reference Inlines -> ItemId
forall a. Reference a -> ItemId
referenceId Reference Inlines
ref)) Map Text ItemId
m [Text]
ids)
                          Map Text ItemId
forall k a. Map k a
M.empty [Reference Inlines]
refs
  let meta' :: Meta
meta' = Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta Text
"nocite" Meta
meta
  let citations :: [Citation Inlines]
citations = Locale -> Map Text ItemId -> Pandoc -> [Citation Inlines]
getCitations Locale
locale Map Text ItemId
otherIdsMap (Pandoc -> [Citation Inlines]) -> Pandoc -> [Citation Inlines]
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta' [Block]
bs


  let linkCites :: Bool
linkCites = Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False MetaValue -> Bool
truish (Maybe MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
"link-citations" Meta
meta
  let opts :: CiteprocOptions
opts = CiteprocOptions
defaultCiteprocOptions{ linkCitations :: Bool
linkCitations = Bool
linkCites }
  let result :: Result Inlines
result = CiteprocOptions
-> Style Inlines
-> Maybe Lang
-> [Reference Inlines]
-> [Citation Inlines]
-> Result Inlines
forall a.
CiteprocOutput a =>
CiteprocOptions
-> Style a
-> Maybe Lang
-> [Reference a]
-> [Citation a]
-> Result a
Citeproc.citeproc CiteprocOptions
opts Style Inlines
style (Locale -> Maybe Lang
localeLanguage Locale
locale)
                  [Reference Inlines]
refs [Citation Inlines]
citations
  (Text -> m ()) -> [Text] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> (Text -> LogMessage) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogMessage
CiteprocWarning) (Result Inlines -> [Text]
forall a. Result a -> [Text]
resultWarnings Result Inlines
result)
  let sopts :: StyleOptions
sopts = Style Inlines -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style Inlines
style
  let classes :: [Text]
classes = Text
"references" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: -- TODO remove this or keep for compatibility?
                Text
"csl-bib-body" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
                [Text
"hanging-indent" | StyleOptions -> Bool
styleHangingIndent StyleOptions
sopts]
  let refkvs :: [(Text, Text)]
refkvs = (case StyleOptions -> Maybe Int
styleEntrySpacing StyleOptions
sopts of
                   Just Int
es | Int
es Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> ((Text
"entry-spacing",String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
es)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:)
                   Maybe Int
_ -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id) ([(Text, Text)] -> [(Text, Text)])
-> ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               (case StyleOptions -> Maybe Int
styleLineSpacing StyleOptions
sopts of
                   Just Int
ls | Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> ((Text
"line-spacing",String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
ls)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:)
                   Maybe Int
_ -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id) ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ []
  let bibs :: Blocks
bibs = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ ((Text, Inlines) -> Blocks) -> [(Text, Inlines)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
ident, Inlines
out) ->
                     Attr -> Blocks -> Blocks
B.divWith (Text
"ref-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident,[Text
"csl-entry"],[]) (Blocks -> Blocks) -> (Inlines -> Blocks) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
B.para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         (Inline -> Inline) -> Inlines -> Inlines
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Locale -> Inline -> Inline
convertQuotes Locale
locale) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         Inlines -> Inlines
insertSpace (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
out)
                      (Result Inlines -> [(Text, Inlines)]
forall a. Result a -> [(Text, a)]
resultBibliography Result Inlines
result)
  let moveNotes :: Bool
moveNotes = Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True MetaValue -> Bool
truish (Maybe MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall a b. (a -> b) -> a -> b
$
                        Text -> Meta -> Maybe MetaValue
lookupMeta Text
"notes-after-punctuation" Meta
meta
  let cits :: [Inlines]
cits = (Inlines -> Inlines) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map ((Inline -> Inline) -> Inlines -> Inlines
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Locale -> Inline -> Inline
convertQuotes Locale
locale)) ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$
               Result Inlines -> [Inlines]
forall a. Result a -> [a]
resultCitations Result Inlines
result

  let fixQuotes :: [Inline] -> [Inline]
fixQuotes = case Locale -> Maybe Bool
localePunctuationInQuote Locale
locale of
                    Just Bool
True ->
                      Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline])
-> ([Inline] -> Inlines) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
forall a. CiteprocOutput a => a -> a
movePunctuationInsideQuotes (Inlines -> Inlines)
-> ([Inline] -> Inlines) -> [Inline] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList
                    Maybe Bool
_ -> [Inline] -> [Inline]
forall a. a -> a
id

  let metanocites :: Maybe MetaValue
metanocites = Text -> Meta -> Maybe MetaValue
lookupMeta Text
"nocite" Meta
meta
  let Pandoc Meta
meta'' [Block]
bs' =
         (Pandoc -> Pandoc)
-> (MetaValue -> Pandoc -> Pandoc)
-> Maybe MetaValue
-> Pandoc
-> Pandoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pandoc -> Pandoc
forall a. a -> a
id (Text -> MetaValue -> Pandoc -> Pandoc
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"nocite") Maybe MetaValue
metanocites (Pandoc -> Pandoc) -> ([Inlines] -> Pandoc) -> [Inlines] -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ([Inline] -> [Inline]) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk ((Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
capitalizeNoteCitation ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                [Inline] -> [Inline]
fixQuotes ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale) (Pandoc -> Pandoc) -> ([Inlines] -> Pandoc) -> [Inlines] -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ([Inline] -> [Inline]) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
deNote (Pandoc -> Pandoc) -> ([Inlines] -> Pandoc) -> [Inlines] -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         State [Inlines] Pandoc -> [Inlines] -> Pandoc
forall s a. State s a -> s -> a
evalState ((Inline -> StateT [Inlines] Identity Inline)
-> Pandoc -> State [Inlines] Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Inline -> StateT [Inlines] Identity Inline
insertResolvedCitations (Pandoc -> State [Inlines] Pandoc)
-> Pandoc -> State [Inlines] Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta' [Block]
bs)
         ([Inlines] -> Pandoc) -> [Inlines] -> Pandoc
forall a b. (a -> b) -> a -> b
$ [Inlines]
cits
  Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta''
         ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> [Text] -> Meta -> [Block] -> [Block] -> [Block]
insertRefs [(Text, Text)]
refkvs [Text]
classes Meta
meta''
            (([Inline] -> [Inline]) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
fixLinks ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bibs) [Block]
bs'

-- | Retrieve the CSL style specified by the csl or citation-style
-- metadata field in a pandoc document, or the default CSL style
-- if none is specified.  Retrieve the parent style
-- if the style is a dependent style.  Add abbreviations defined
-- in an abbreviation file if one has been specified.
getStyle :: PandocMonad m => Pandoc -> m (Style Inlines)
getStyle :: Pandoc -> m (Style Inlines)
getStyle (Pandoc Meta
meta [Block]
_) = do
  let cslfile :: Maybe Text
cslfile = (Text -> Meta -> Maybe MetaValue
lookupMeta Text
"csl" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"citation-style" Meta
meta)
                Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText

  let getFile :: Text -> Text -> m ByteString
getFile Text
defaultExtension Text
fp = do
        [String]
oldRp <- m [String]
forall (m :: * -> *). PandocMonad m => m [String]
getResourcePath
        Maybe String
mbUdd <- m (Maybe String)
forall (m :: * -> *). PandocMonad m => m (Maybe String)
getUserDataDir
        [String] -> m ()
forall (m :: * -> *). PandocMonad m => [String] -> m ()
setResourcePath ([String] -> m ()) -> [String] -> m ()
forall a b. (a -> b) -> a -> b
$ [String]
oldRp [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []
                                   (\String
u -> [String
u String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/csl",
                                           String
u String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/csl/dependent"]) Maybe String
mbUdd
        let fp' :: Text
fp' = if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') Text
fp Bool -> Bool -> Bool
|| Text
"data:" Text -> Text -> Bool
`T.isPrefixOf` Text
fp
                     then Text
fp
                     else Text
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
defaultExtension
        (ByteString
result, Maybe Text
_) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
fp'
        [String] -> m ()
forall (m :: * -> *). PandocMonad m => [String] -> m ()
setResourcePath [String]
oldRp
        ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result

  let getCslDefault :: m ByteString
getCslDefault = String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile String
"default.csl"

  Text
cslContents <- ByteString -> Text
UTF8.toText (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
-> (Text -> m ByteString) -> Maybe Text -> m ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ByteString
getCslDefault (Text -> Text -> m ByteString
forall (m :: * -> *). PandocMonad m => Text -> Text -> m ByteString
getFile Text
".csl") Maybe Text
cslfile

  let abbrevFile :: Maybe Text
abbrevFile = Text -> Meta -> Maybe MetaValue
lookupMeta Text
"citation-abbreviations" Meta
meta Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText

  Maybe Abbreviations
mbAbbrevs <- case Maybe Text
abbrevFile of
                 Maybe Text
Nothing -> Maybe Abbreviations -> m (Maybe Abbreviations)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Abbreviations
forall a. Maybe a
Nothing
                 Just Text
fp -> do
                   ByteString
rawAbbr <- Text -> Text -> m ByteString
forall (m :: * -> *). PandocMonad m => Text -> Text -> m ByteString
getFile Text
".json" Text
fp
                   case ByteString -> Either String Abbreviations
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
L.fromStrict ByteString
rawAbbr) of
                     Left String
err -> PandocError -> m (Maybe Abbreviations)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Maybe Abbreviations))
-> PandocError -> m (Maybe Abbreviations)
forall a b. (a -> b) -> a -> b
$ CiteprocError -> PandocError
PandocCiteprocError (CiteprocError -> PandocError) -> CiteprocError -> PandocError
forall a b. (a -> b) -> a -> b
$
                                 Text -> CiteprocError
CiteprocParseError (Text -> CiteprocError) -> Text -> CiteprocError
forall a b. (a -> b) -> a -> b
$
                                 Text
"Could not parse abbreviations file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fp
                                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err
                     Right Abbreviations
abbr -> Maybe Abbreviations -> m (Maybe Abbreviations)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Abbreviations -> m (Maybe Abbreviations))
-> Maybe Abbreviations -> m (Maybe Abbreviations)
forall a b. (a -> b) -> a -> b
$ Abbreviations -> Maybe Abbreviations
forall a. a -> Maybe a
Just Abbreviations
abbr

  let getParentStyle :: Text -> f Text
getParentStyle Text
url = do
        -- first, try to retrieve the style locally, then use HTTP.
        let basename :: Text
basename = (Char -> Bool) -> Text -> Text
T.takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'/') Text
url
        ByteString -> Text
UTF8.toText (ByteString -> Text) -> f ByteString -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          f ByteString -> (PandocError -> f ByteString) -> f ByteString
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (Text -> Text -> f ByteString
forall (m :: * -> *). PandocMonad m => Text -> Text -> m ByteString
getFile Text
".csl" Text
basename) (\PandocError
_ -> (ByteString, Maybe Text) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe Text) -> ByteString)
-> f (ByteString, Maybe Text) -> f ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
url)

  Either CiteprocError (Style Inlines)
styleRes <- (Text -> m Text)
-> Text -> m (Either CiteprocError (Style Inlines))
forall (m :: * -> *) a.
Monad m =>
(Text -> m Text) -> Text -> m (Either CiteprocError (Style a))
Citeproc.parseStyle Text -> m Text
forall (f :: * -> *). PandocMonad f => Text -> f Text
getParentStyle Text
cslContents
  case Either CiteprocError (Style Inlines)
styleRes of
     Left CiteprocError
err    -> PandocError -> m (Style Inlines)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Style Inlines))
-> PandocError -> m (Style Inlines)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocAppError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ CiteprocError -> Text
prettyCiteprocError CiteprocError
err
     Right Style Inlines
style -> Style Inlines -> m (Style Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Style Inlines
style{ styleAbbreviations :: Maybe Abbreviations
styleAbbreviations = Maybe Abbreviations
mbAbbrevs }


-- Retrieve citeproc lang based on metadata.
getLang :: PandocMonad m => Meta -> m (Maybe Lang)
getLang :: Meta -> m (Maybe Lang)
getLang Meta
meta = m (Maybe Lang)
-> (Text -> m (Maybe Lang)) -> Maybe Text -> m (Maybe Lang)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Lang -> m (Maybe Lang)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Lang
forall a. Maybe a
Nothing) Text -> m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Lang)
bcp47LangToIETF
                 ((Text -> Meta -> Maybe MetaValue
lookupMeta Text
"lang" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"locale" Meta
meta) Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                   MetaValue -> Maybe Text
metaValueToText)

-- | Get references defined inline in the metadata and via an external
-- bibliography.  Only references that are actually cited in the document
-- (either with a genuine citation or with `nocite`) are returned.
-- URL variables are converted to links.
getReferences :: PandocMonad m
              => Maybe Locale -> Pandoc -> m [Reference Inlines]
getReferences :: Maybe Locale -> Pandoc -> m [Reference Inlines]
getReferences Maybe Locale
mblocale (Pandoc Meta
meta [Block]
bs) = do
  Locale
locale <- case Maybe Locale
mblocale of
                Just Locale
l  -> Locale -> m Locale
forall (m :: * -> *) a. Monad m => a -> m a
return Locale
l
                Maybe Locale
Nothing -> do
                  Maybe Lang
mblang <- Meta -> m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Meta -> m (Maybe Lang)
getLang Meta
meta
                  case Maybe Lang
mblang of
                    Just Lang
lang -> Locale -> m Locale
forall (m :: * -> *) a. Monad m => a -> m a
return (Locale -> m Locale) -> Locale -> m Locale
forall a b. (a -> b) -> a -> b
$ (CiteprocError -> Locale)
-> (Locale -> Locale) -> Either CiteprocError Locale -> Locale
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CiteprocError -> Locale
forall a. Monoid a => a
mempty Locale -> Locale
forall a. a -> a
id (Either CiteprocError Locale -> Locale)
-> Either CiteprocError Locale -> Locale
forall a b. (a -> b) -> a -> b
$ Lang -> Either CiteprocError Locale
getLocale Lang
lang
                    Maybe Lang
Nothing   -> Locale -> m Locale
forall (m :: * -> *) a. Monad m => a -> m a
return Locale
forall a. Monoid a => a
mempty

  let getCiteId :: Inline -> Set Text
getCiteId (Cite [Citation]
cs [Inline]
_) = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (Citation -> Text) -> [Citation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
B.citationId [Citation]
cs
      getCiteId Inline
_ = Set Text
forall a. Monoid a => a
mempty
  let metanocites :: Maybe MetaValue
metanocites = Text -> Meta -> Maybe MetaValue
lookupMeta Text
"nocite" Meta
meta
  let nocites :: Set Text
nocites = Set Text -> (MetaValue -> Set Text) -> Maybe MetaValue -> Set Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Text
forall a. Monoid a => a
mempty ((Inline -> Set Text) -> MetaValue -> Set Text
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Set Text
getCiteId) Maybe MetaValue
metanocites
  let citeIds :: Set Text
citeIds = (Inline -> Set Text) -> Pandoc -> Set Text
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Set Text
getCiteId (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs)
  let idpred :: Text -> Bool
idpred = if Text
"*" Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
nocites
                  then Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True
                  else (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
citeIds)
  let inlineRefs :: [Reference Inlines]
inlineRefs = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"references" Meta
meta of
                    Just (MetaList [MetaValue]
rs) -> (MetaValue -> Maybe (Reference Inlines))
-> [MetaValue] -> [Reference Inlines]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe (Reference Inlines)
metaValueToReference [MetaValue]
rs
                    Maybe MetaValue
_                  -> []
  [Reference Inlines]
externalRefs <- case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"bibliography" Meta
meta of
                    Just (MetaList [MetaValue]
xs) ->
                      [[Reference Inlines]] -> [Reference Inlines]
forall a. Monoid a => [a] -> a
mconcat ([[Reference Inlines]] -> [Reference Inlines])
-> m [[Reference Inlines]] -> m [Reference Inlines]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        (Text -> m [Reference Inlines])
-> [Text] -> m [[Reference Inlines]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Locale -> (Text -> Bool) -> Text -> m [Reference Inlines]
forall (m :: * -> *).
PandocMonad m =>
Locale -> (Text -> Bool) -> Text -> m [Reference Inlines]
getRefsFromBib Locale
locale Text -> Bool
idpred)
                          ((MetaValue -> Maybe Text) -> [MetaValue] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe Text
metaValueToText [MetaValue]
xs)
                    Just MetaValue
x ->
                      case MetaValue -> Maybe Text
metaValueToText MetaValue
x of
                        Just Text
fp -> Locale -> (Text -> Bool) -> Text -> m [Reference Inlines]
forall (m :: * -> *).
PandocMonad m =>
Locale -> (Text -> Bool) -> Text -> m [Reference Inlines]
getRefsFromBib Locale
locale Text -> Bool
idpred Text
fp
                        Maybe Text
Nothing -> [Reference Inlines] -> m [Reference Inlines]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                    Maybe MetaValue
Nothing -> [Reference Inlines] -> m [Reference Inlines]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  [Reference Inlines] -> m [Reference Inlines]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reference Inlines] -> m [Reference Inlines])
-> [Reference Inlines] -> m [Reference Inlines]
forall a b. (a -> b) -> a -> b
$ (Reference Inlines -> Reference Inlines)
-> [Reference Inlines] -> [Reference Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Reference Inlines -> Reference Inlines
linkifyVariables (Reference Inlines -> Reference Inlines)
-> (Reference Inlines -> Reference Inlines)
-> Reference Inlines
-> Reference Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference Inlines -> Reference Inlines
legacyDateRanges)
               ([Reference Inlines]
externalRefs [Reference Inlines] -> [Reference Inlines] -> [Reference Inlines]
forall a. [a] -> [a] -> [a]
++ [Reference Inlines]
inlineRefs)
            -- note that inlineRefs can override externalRefs



-- If we have a span.csl-left-margin followed by span.csl-right-inline,
-- we insert a space. This ensures that they will be separated by a space,
-- even in formats that don't have special handling for the display spans.
insertSpace :: Inlines -> Inlines
insertSpace :: Inlines -> Inlines
insertSpace Inlines
ils =
  case Seq Inline -> ViewL Inline
forall a. Seq a -> ViewL a
Seq.viewl (Inlines -> Seq Inline
forall a. Many a -> Seq a
unMany Inlines
ils) of
    (Span (Text
"",[Text
"csl-left-margin"],[]) [Inline]
xs) Seq.:< Seq Inline
rest ->
      case Int -> Seq Inline -> Maybe Inline
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq Inline
rest of
        Just (Span (Text
"",[Text
"csl-right-inline"],[]) [Inline]
_) ->
          Seq Inline -> Inlines
forall a. Seq a -> Many a
Many (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$
            Attr -> [Inline] -> Inline
Span (Text
"",[Text
"csl-left-margin"],[]) ([Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ case [Inline] -> Maybe Inline
forall a. [a] -> Maybe a
lastMay [Inline]
xs of
                                                      Just Inline
Space -> []
                                                      Maybe Inline
_          -> [Inline
Space])
            Inline -> Seq Inline -> Seq Inline
forall a. a -> Seq a -> Seq a
Seq.<| Seq Inline
rest
        Maybe Inline
_ -> Inlines
ils
    ViewL Inline
_ -> Inlines
ils

getRefsFromBib :: PandocMonad m
               => Locale -> (Text -> Bool) -> Text -> m [Reference Inlines]
getRefsFromBib :: Locale -> (Text -> Bool) -> Text -> m [Reference Inlines]
getRefsFromBib Locale
locale Text -> Bool
idpred Text
fp = do
  (ByteString
raw, Maybe Text
_) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
fp
  case String -> Maybe BibFormat
formatFromExtension (Text -> String
T.unpack Text
fp) of
    Just BibFormat
f -> Locale
-> BibFormat
-> (Text -> Bool)
-> Maybe Text
-> ByteString
-> m [Reference Inlines]
forall (m :: * -> *).
PandocMonad m =>
Locale
-> BibFormat
-> (Text -> Bool)
-> Maybe Text
-> ByteString
-> m [Reference Inlines]
getRefs Locale
locale BibFormat
f Text -> Bool
idpred (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fp) ByteString
raw
    Maybe BibFormat
Nothing -> PandocError -> m [Reference Inlines]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m [Reference Inlines])
-> PandocError -> m [Reference Inlines]
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocAppError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$
                 Text
"Could not determine bibliography format for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fp

getRefs :: PandocMonad m
        => Locale
        -> BibFormat
        -> (Text -> Bool)
        -> Maybe Text
        -> ByteString
        -> m [Reference Inlines]
getRefs :: Locale
-> BibFormat
-> (Text -> Bool)
-> Maybe Text
-> ByteString
-> m [Reference Inlines]
getRefs Locale
locale BibFormat
format Text -> Bool
idpred Maybe Text
mbfp ByteString
raw = do
  let err' :: Text -> m a
err' = PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m a) -> (Text -> PandocError) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Text -> Text -> PandocError
PandocBibliographyError (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty Maybe Text
mbfp)
  case BibFormat
format of
    BibFormat
Format_bibtex ->
      (ParseError -> m [Reference Inlines])
-> ([Reference Inlines] -> m [Reference Inlines])
-> Either ParseError [Reference Inlines]
-> m [Reference Inlines]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> m [Reference Inlines]
forall a. Text -> m a
err' (Text -> m [Reference Inlines])
-> (ParseError -> Text) -> ParseError -> m [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Text
forall a. Show a => a -> Text
tshow) [Reference Inlines] -> m [Reference Inlines]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError [Reference Inlines] -> m [Reference Inlines])
-> (ByteString -> Either ParseError [Reference Inlines])
-> ByteString
-> m [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Variant
-> Locale
-> (Text -> Bool)
-> Text
-> Either ParseError [Reference Inlines]
readBibtexString Variant
Bibtex Locale
locale Text -> Bool
idpred (Text -> Either ParseError [Reference Inlines])
-> (ByteString -> Text)
-> ByteString
-> Either ParseError [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
UTF8.toText (ByteString -> m [Reference Inlines])
-> ByteString -> m [Reference Inlines]
forall a b. (a -> b) -> a -> b
$ ByteString
raw
    BibFormat
Format_biblatex ->
      (ParseError -> m [Reference Inlines])
-> ([Reference Inlines] -> m [Reference Inlines])
-> Either ParseError [Reference Inlines]
-> m [Reference Inlines]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> m [Reference Inlines]
forall a. Text -> m a
err' (Text -> m [Reference Inlines])
-> (ParseError -> Text) -> ParseError -> m [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Text
forall a. Show a => a -> Text
tshow) [Reference Inlines] -> m [Reference Inlines]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError [Reference Inlines] -> m [Reference Inlines])
-> (ByteString -> Either ParseError [Reference Inlines])
-> ByteString
-> m [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Variant
-> Locale
-> (Text -> Bool)
-> Text
-> Either ParseError [Reference Inlines]
readBibtexString Variant
Biblatex Locale
locale Text -> Bool
idpred (Text -> Either ParseError [Reference Inlines])
-> (ByteString -> Text)
-> ByteString
-> Either ParseError [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
UTF8.toText (ByteString -> m [Reference Inlines])
-> ByteString -> m [Reference Inlines]
forall a b. (a -> b) -> a -> b
$ ByteString
raw
    BibFormat
Format_json ->
      (String -> m [Reference Inlines])
-> ([Reference Inlines] -> m [Reference Inlines])
-> Either String [Reference Inlines]
-> m [Reference Inlines]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> m [Reference Inlines]
forall a. Text -> m a
err' (Text -> m [Reference Inlines])
-> (String -> Text) -> String -> m [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
             ([Reference Inlines] -> m [Reference Inlines]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reference Inlines] -> m [Reference Inlines])
-> ([Reference Inlines] -> [Reference Inlines])
-> [Reference Inlines]
-> m [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference Inlines -> Bool)
-> [Reference Inlines] -> [Reference Inlines]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
idpred (Text -> Bool)
-> (Reference Inlines -> Text) -> Reference Inlines -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemId -> Text
unItemId (ItemId -> Text)
-> (Reference Inlines -> ItemId) -> Reference Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference Inlines -> ItemId
forall a. Reference a -> ItemId
referenceId)) (Either String [Reference Inlines] -> m [Reference Inlines])
-> (ByteString -> Either String [Reference Inlines])
-> ByteString
-> m [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ByteString -> Either String [Reference Inlines]
cslJsonToReferences (ByteString -> m [Reference Inlines])
-> ByteString -> m [Reference Inlines]
forall a b. (a -> b) -> a -> b
$ ByteString
raw
    BibFormat
Format_yaml -> do
      [MetaValue]
rs <- (Text -> Bool)
-> ReaderOptions -> Maybe String -> ByteString -> m [MetaValue]
forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ReaderOptions -> Maybe String -> ByteString -> m [MetaValue]
yamlToRefs Text -> Bool
idpred
              ReaderOptions
forall a. Default a => a
def{ readerExtensions :: Extensions
readerExtensions = Extensions
pandocExtensions }
              (Text -> String
T.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mbfp)
              (ByteString -> ByteString
L.fromStrict ByteString
raw)
      [Reference Inlines] -> m [Reference Inlines]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reference Inlines] -> m [Reference Inlines])
-> [Reference Inlines] -> m [Reference Inlines]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Maybe (Reference Inlines))
-> [MetaValue] -> [Reference Inlines]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe (Reference Inlines)
metaValueToReference [MetaValue]
rs

-- localized quotes
convertQuotes :: Locale -> Inline -> Inline
convertQuotes :: Locale -> Inline -> Inline
convertQuotes Locale
locale (Quoted QuoteType
qt [Inline]
ils) =
  case (Text -> Map Text [(Term, Text)] -> Maybe [(Term, Text)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
openterm Map Text [(Term, Text)]
terms, Text -> Map Text [(Term, Text)] -> Maybe [(Term, Text)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
closeterm Map Text [(Term, Text)]
terms) of
    (Just ((Term
_,Text
oq):[(Term, Text)]
_), Just ((Term
_,Text
cq):[(Term, Text)]
_)) ->
         Attr -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
oq Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
cq])
    (Maybe [(Term, Text)], Maybe [(Term, Text)])
_ -> QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt [Inline]
ils
  where
   terms :: Map Text [(Term, Text)]
terms = Locale -> Map Text [(Term, Text)]
localeTerms Locale
locale
   openterm :: Text
openterm = case QuoteType
qt of
                QuoteType
DoubleQuote -> Text
"open-quote"
                QuoteType
SingleQuote -> Text
"open-inner-quote"
   closeterm :: Text
closeterm = case QuoteType
qt of
                 QuoteType
DoubleQuote -> Text
"close-quote"
                 QuoteType
SingleQuote -> Text
"close-inner-quote"
convertQuotes Locale
_ Inline
x = Inline
x

-- assumes we walk in same order as query
insertResolvedCitations :: Inline -> State [Inlines] Inline
insertResolvedCitations :: Inline -> StateT [Inlines] Identity Inline
insertResolvedCitations (Cite [Citation]
cs [Inline]
ils) = do
  [Inlines]
resolved <- StateT [Inlines] Identity [Inlines]
forall s (m :: * -> *). MonadState s m => m s
get
  case [Inlines]
resolved of
    [] -> Inline -> StateT [Inlines] Identity Inline
forall (m :: * -> *) a. Monad m => a -> m a
return ([Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
ils)
    (Inlines
x:[Inlines]
xs) -> do
      [Inlines] -> StateT [Inlines] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Inlines]
xs
      Inline -> StateT [Inlines] Identity Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT [Inlines] Identity Inline)
-> Inline -> StateT [Inlines] Identity Inline
forall a b. (a -> b) -> a -> b
$ [Citation] -> [Inline] -> Inline
Cite [Citation]
cs (([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
fixLinks ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
x)
insertResolvedCitations Inline
x = Inline -> StateT [Inlines] Identity Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

getCitations :: Locale
             -> M.Map Text ItemId
             -> Pandoc
             -> [Citeproc.Citation Inlines]
getCitations :: Locale -> Map Text ItemId -> Pandoc -> [Citation Inlines]
getCitations Locale
locale Map Text ItemId
otherIdsMap = Seq (Citation Inlines) -> [Citation Inlines]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq (Citation Inlines) -> [Citation Inlines])
-> (Pandoc -> Seq (Citation Inlines))
-> Pandoc
-> [Citation Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Seq (Citation Inlines))
-> Pandoc -> Seq (Citation Inlines)
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Seq (Citation Inlines)
getCitation
 where
  getCitation :: Inline -> Seq (Citation Inlines)
getCitation (Cite [Citation]
cs [Inline]
_fallback) = Citation Inlines -> Seq (Citation Inlines)
forall a. a -> Seq a
Seq.singleton (Citation Inlines -> Seq (Citation Inlines))
-> Citation Inlines -> Seq (Citation Inlines)
forall a b. (a -> b) -> a -> b
$
    Citation :: forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citeproc.Citation { citationId :: Maybe Text
Citeproc.citationId = Maybe Text
forall a. Maybe a
Nothing
                      , citationNoteNumber :: Maybe Int
Citeproc.citationNoteNumber =
                          case [Citation]
cs of
                            []    -> Maybe Int
forall a. Maybe a
Nothing
                            (Pandoc.Citation{ citationNoteNum :: Citation -> Int
Pandoc.citationNoteNum = Int
n }:
                               [Citation]
_) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
                                  | Bool
otherwise -> Maybe Int
forall a. Maybe a
Nothing
                      , citationItems :: [CitationItem Inlines]
Citeproc.citationItems =
                           Locale -> Map Text ItemId -> [Citation] -> [CitationItem Inlines]
fromPandocCitations Locale
locale Map Text ItemId
otherIdsMap [Citation]
cs
                      }
  getCitation Inline
_ = Seq (Citation Inlines)
forall a. Monoid a => a
mempty

fromPandocCitations :: Locale
                    -> M.Map Text ItemId
                    -> [Pandoc.Citation]
                    -> [CitationItem Inlines]
fromPandocCitations :: Locale -> Map Text ItemId -> [Citation] -> [CitationItem Inlines]
fromPandocCitations Locale
locale Map Text ItemId
otherIdsMap = (Citation -> [CitationItem Inlines])
-> [Citation] -> [CitationItem Inlines]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Citation -> [CitationItem Inlines]
go
 where
  go :: Citation -> [CitationItem Inlines]
go Citation
c =
    let (Maybe (Text, Text)
loclab, [Inline]
suffix) = Locale -> [Inline] -> (Maybe (Text, Text), [Inline])
parseLocator Locale
locale (Citation -> [Inline]
citationSuffix Citation
c)
        (Maybe Text
mblab, Maybe Text
mbloc) = case Maybe (Text, Text)
loclab of
                           Just (Text
loc, Text
lab) -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
loc, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lab)
                           Maybe (Text, Text)
Nothing         -> (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing)
        cit :: CitationItem Inlines
cit = CitationItem :: forall a.
ItemId
-> Maybe Text
-> Maybe Text
-> CitationItemType
-> Maybe a
-> Maybe a
-> CitationItem a
CitationItem
               { citationItemId :: ItemId
citationItemId = ItemId -> Maybe ItemId -> ItemId
forall a. a -> Maybe a -> a
fromMaybe
                   (Text -> ItemId
ItemId (Text -> ItemId) -> Text -> ItemId
forall a b. (a -> b) -> a -> b
$ Citation -> Text
Pandoc.citationId Citation
c)
                   (Text -> Map Text ItemId -> Maybe ItemId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Citation -> Text
Pandoc.citationId Citation
c) Map Text ItemId
otherIdsMap)
               , citationItemLabel :: Maybe Text
citationItemLabel = Maybe Text
mblab
               , citationItemLocator :: Maybe Text
citationItemLocator = Maybe Text
mbloc
               , citationItemType :: CitationItemType
citationItemType = CitationItemType
NormalCite
               , citationItemPrefix :: Maybe Inlines
citationItemPrefix = case Citation -> [Inline]
citationPrefix Citation
c of
                                        [] -> Maybe Inlines
forall a. Maybe a
Nothing
                                        [Inline]
ils -> Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines) -> Inlines -> Maybe Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                                                      Inlines
B.space
               , citationItemSuffix :: Maybe Inlines
citationItemSuffix = case [Inline]
suffix of
                                        [] -> Maybe Inlines
forall a. Maybe a
Nothing
                                        [Inline]
ils -> Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines) -> Inlines -> Maybe Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils
               }
     in if Citation -> Text
Pandoc.citationId Citation
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*"
           then []
           else
             case Citation -> CitationMode
citationMode Citation
c of
                  CitationMode
AuthorInText   -> [ CitationItem Inlines
cit{ citationItemType :: CitationItemType
citationItemType = CitationItemType
AuthorOnly
                                         , citationItemSuffix :: Maybe Inlines
citationItemSuffix = Maybe Inlines
forall a. Maybe a
Nothing }
                                    , CitationItem Inlines
cit{ citationItemType :: CitationItemType
citationItemType =
                                              CitationItemType
Citeproc.SuppressAuthor
                                         , citationItemPrefix :: Maybe Inlines
citationItemPrefix = Maybe Inlines
forall a. Maybe a
Nothing } ]
                  CitationMode
NormalCitation -> [ CitationItem Inlines
cit ]
                  CitationMode
Pandoc.SuppressAuthor
                                 -> [ CitationItem Inlines
cit{ citationItemType :: CitationItemType
citationItemType =
                                              CitationItemType
Citeproc.SuppressAuthor } ]



data BibFormat =
    Format_biblatex
  | Format_bibtex
  | Format_json
  | Format_yaml
  deriving (Int -> BibFormat -> String -> String
[BibFormat] -> String -> String
BibFormat -> String
(Int -> BibFormat -> String -> String)
-> (BibFormat -> String)
-> ([BibFormat] -> String -> String)
-> Show BibFormat
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BibFormat] -> String -> String
$cshowList :: [BibFormat] -> String -> String
show :: BibFormat -> String
$cshow :: BibFormat -> String
showsPrec :: Int -> BibFormat -> String -> String
$cshowsPrec :: Int -> BibFormat -> String -> String
Show, BibFormat -> BibFormat -> Bool
(BibFormat -> BibFormat -> Bool)
-> (BibFormat -> BibFormat -> Bool) -> Eq BibFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BibFormat -> BibFormat -> Bool
$c/= :: BibFormat -> BibFormat -> Bool
== :: BibFormat -> BibFormat -> Bool
$c== :: BibFormat -> BibFormat -> Bool
Eq, Eq BibFormat
Eq BibFormat
-> (BibFormat -> BibFormat -> Ordering)
-> (BibFormat -> BibFormat -> Bool)
-> (BibFormat -> BibFormat -> Bool)
-> (BibFormat -> BibFormat -> Bool)
-> (BibFormat -> BibFormat -> Bool)
-> (BibFormat -> BibFormat -> BibFormat)
-> (BibFormat -> BibFormat -> BibFormat)
-> Ord BibFormat
BibFormat -> BibFormat -> Bool
BibFormat -> BibFormat -> Ordering
BibFormat -> BibFormat -> BibFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BibFormat -> BibFormat -> BibFormat
$cmin :: BibFormat -> BibFormat -> BibFormat
max :: BibFormat -> BibFormat -> BibFormat
$cmax :: BibFormat -> BibFormat -> BibFormat
>= :: BibFormat -> BibFormat -> Bool
$c>= :: BibFormat -> BibFormat -> Bool
> :: BibFormat -> BibFormat -> Bool
$c> :: BibFormat -> BibFormat -> Bool
<= :: BibFormat -> BibFormat -> Bool
$c<= :: BibFormat -> BibFormat -> Bool
< :: BibFormat -> BibFormat -> Bool
$c< :: BibFormat -> BibFormat -> Bool
compare :: BibFormat -> BibFormat -> Ordering
$ccompare :: BibFormat -> BibFormat -> Ordering
$cp1Ord :: Eq BibFormat
Ord)

formatFromExtension :: FilePath -> Maybe BibFormat
formatFromExtension :: String -> Maybe BibFormat
formatFromExtension String
fp = case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension String
fp of
                           String
"biblatex" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
Just BibFormat
Format_biblatex
                           String
"bibtex"   -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
Just BibFormat
Format_bibtex
                           String
"bib"      -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
Just BibFormat
Format_biblatex
                           String
"json"     -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
Just BibFormat
Format_json
                           String
"yaml"     -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
Just BibFormat
Format_yaml
                           String
_          -> Maybe BibFormat
forall a. Maybe a
Nothing


isNote :: Inline -> Bool
isNote :: Inline -> Bool
isNote (Note [Block]
_)          = Bool
True
isNote (Cite [Citation]
_ [Note [Block]
_]) = Bool
True
 -- the following allows citation styles that are "in-text" but use superscript
 -- references to be treated as if they are "notes" for the purposes of moving
 -- the citations after trailing punctuation (see <https://github.com/jgm/pandoc-citeproc/issues/382>):
isNote (Cite [Citation]
_ [Superscript [Inline]
_]) = Bool
True
isNote Inline
_                 = Bool
False

isSpacy :: Inline -> Bool
isSpacy :: Inline -> Bool
isSpacy Inline
Space     = Bool
True
isSpacy Inline
SoftBreak = Bool
True
isSpacy Inline
_         = Bool
False


mvPunct :: Bool -> Locale -> [Inline] -> [Inline]
mvPunct :: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale (Inline
x : [Inline]
xs)
  | Inline -> Bool
isSpacy Inline
x = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
xs
-- 'x [^1],' -> 'x,[^1]'
mvPunct Bool
moveNotes Locale
locale (Inline
q : Inline
s : Inline
x : [Inline]
ys)
  | Inline -> Bool
isSpacy Inline
s
  , Inline -> Bool
isNote Inline
x
  = let spunct :: Text
spunct = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isPunctuation (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ys
    in  if Bool
moveNotes
           then if Text -> Bool
T.null Text
spunct
                   then Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
ys
                   else Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
spunct Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale
                        (Inlines -> [Inline]
forall a. Many a -> [a]
B.toList
                          ((Char -> Bool) -> Inlines -> Inlines
forall a. CiteprocOutput a => (Char -> Bool) -> a -> a
dropTextWhile Char -> Bool
isPunctuation ([Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ys)))
           else Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
ys
-- 'x[^1],' -> 'x,[^1]'
mvPunct Bool
moveNotes Locale
locale (Cite [Citation]
cs [Inline]
ils : [Inline]
ys)
   | Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils)
   , Inline -> Bool
isNote ([Inline] -> Inline
forall a. [a] -> a
last [Inline]
ils)
   , [Inline] -> Bool
startWithPunct [Inline]
ys
   , Bool
moveNotes
   = let s :: Text
s = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ys
         spunct :: Text
spunct = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isPunctuation Text
s
     in  [Citation] -> [Inline] -> Inline
Cite [Citation]
cs ([Inline] -> [Inline]
forall a. [a] -> [a]
init [Inline]
ils
                  [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
spunct | Bool -> Bool
not (Bool -> [Inline] -> Bool
endWithPunct Bool
False ([Inline] -> [Inline]
forall a. [a] -> [a]
init [Inline]
ils))]
                  [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Inline
forall a. [a] -> a
last [Inline]
ils]) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
         Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale
           (Inlines -> [Inline]
forall a. Many a -> [a]
B.toList ((Char -> Bool) -> Inlines -> Inlines
forall a. CiteprocOutput a => (Char -> Bool) -> a -> a
dropTextWhile Char -> Bool
isPunctuation ([Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ys)))
mvPunct Bool
moveNotes Locale
locale (Inline
s : Inline
x : [Inline]
ys) | Inline -> Bool
isSpacy Inline
s, Inline -> Bool
isNote Inline
x =
  Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
ys
mvPunct Bool
moveNotes Locale
locale (Inline
s : x :: Inline
x@(Cite [Citation]
_ (Superscript [Inline]
_ : [Inline]
_)) : [Inline]
ys)
  | Inline -> Bool
isSpacy Inline
s = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
ys
mvPunct Bool
moveNotes Locale
locale (Cite [Citation]
cs [Inline]
ils : Str Text
"." : [Inline]
ys)
  | Text
"." Text -> Text -> Bool
`T.isSuffixOf` ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils)
  = [Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
ils Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
ys
mvPunct Bool
moveNotes Locale
locale (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
xs
mvPunct Bool
_ Locale
_ [] = []

-- move https://doi.org etc. prefix inside link text (#6723):
fixLinks :: [Inline] -> [Inline]
fixLinks :: [Inline] -> [Inline]
fixLinks (Str Text
t : Link Attr
attr [Str Text
u1] (Text
u2,Text
tit) : [Inline]
xs)
  | Text
u2 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u1
  = Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Text -> Inline
Str (Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u1)] (Text
u2,Text
tit) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixLinks [Inline]
xs
fixLinks (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixLinks [Inline]
xs
fixLinks [] = []


endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct Bool
_ [] = Bool
False
endWithPunct Bool
onlyFinal xs :: [Inline]
xs@(Inline
_:[Inline]
_) =
  case String -> String
forall a. [a] -> [a]
reverse (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs) of
       []                       -> Bool
True
       -- covers .), .", etc.:
       (Char
d:Char
c:String
_) | Char -> Bool
isPunctuation Char
d
                 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onlyFinal
                 Bool -> Bool -> Bool
&& Char -> Bool
isEndPunct Char
c -> Bool
True
       (Char
c:String
_) | Char -> Bool
isEndPunct Char
c      -> Bool
True
             | Bool
otherwise         -> Bool
False
  where isEndPunct :: Char -> Bool
isEndPunct Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
".,;:!?" :: String)



startWithPunct :: [Inline] -> Bool
startWithPunct :: [Inline] -> Bool
startWithPunct [Inline]
ils =
  case Text -> Maybe (Char, Text)
T.uncons ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils) of
    Just (Char
c,Text
_) -> Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
".,;:!?" :: [Char])
    Maybe (Char, Text)
Nothing -> Bool
False

truish :: MetaValue -> Bool
truish :: MetaValue -> Bool
truish (MetaBool Bool
t) = Bool
t
truish (MetaString Text
s) = Text -> Bool
isYesValue (Text -> Text
T.toLower Text
s)
truish (MetaInlines [Inline]
ils) = Text -> Bool
isYesValue (Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish (MetaBlocks [Plain [Inline]
ils]) = Text -> Bool
isYesValue (Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish MetaValue
_ = Bool
False

isYesValue :: Text -> Bool
isYesValue :: Text -> Bool
isYesValue Text
"t" = Bool
True
isYesValue Text
"true" = Bool
True
isYesValue Text
"yes" = Bool
True
isYesValue Text
_ = Bool
False

-- if document contains a Div with id="refs", insert
-- references as its contents.  Otherwise, insert references
-- at the end of the document in a Div with id="refs"
insertRefs :: [(Text,Text)] -> [Text] -> Meta -> [Block] -> [Block] -> [Block]
insertRefs :: [(Text, Text)] -> [Text] -> Meta -> [Block] -> [Block] -> [Block]
insertRefs [(Text, Text)]
_ [Text]
_ Meta
_  []   [Block]
bs = [Block]
bs
insertRefs [(Text, Text)]
refkvs [Text]
refclasses Meta
meta [Block]
refs [Block]
bs =
  if Meta -> Bool
isRefRemove Meta
meta
     then [Block]
bs
     else case State Bool [Block] -> Bool -> ([Block], Bool)
forall s a. State s a -> s -> (a, s)
runState ((Block -> StateT Bool Identity Block)
-> [Block] -> State Bool [Block]
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Block -> StateT Bool Identity Block
go [Block]
bs) Bool
False of
               ([Block]
bs', Bool
True) -> [Block]
bs'
               ([Block]
_, Bool
False)
                 -> case Meta -> Maybe [Inline]
refTitle Meta
meta of
                      Maybe [Inline]
Nothing ->
                        case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
bs of
                          Header Int
lev (Text
id',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ys : [Block]
xs ->
                            [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
                            [Int -> Attr -> [Inline] -> Block
Header Int
lev (Text
id',[Text] -> [Text]
forall a. (IsString a, Eq a) => [a] -> [a]
addUnNumbered [Text]
classes,[(Text, Text)]
kvs) [Inline]
ys,
                             Attr -> [Block] -> Block
Div (Text
"refs",[Text]
refclasses,[(Text, Text)]
refkvs) [Block]
refs]
                          [Block]
_ -> [Block]
bs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
refDiv]
                      Just [Inline]
ils -> [Block]
bs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
                        [Int -> Attr -> [Inline] -> Block
Header Int
1 (Text
"bibliography", [Text
"unnumbered"], []) [Inline]
ils,
                         Block
refDiv]
  where
   refDiv :: Block
refDiv = Attr -> [Block] -> Block
Div (Text
"refs", [Text]
refclasses, [(Text, Text)]
refkvs) [Block]
refs
   addUnNumbered :: [a] -> [a]
addUnNumbered [a]
cs = a
"unnumbered" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a
c | a
c <- [a]
cs, a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"unnumbered"]
   go :: Block -> State Bool Block
   go :: Block -> StateT Bool Identity Block
go (Div (Text
"refs",[Text]
cs,[(Text, Text)]
kvs) [Block]
xs) = do
     Bool -> StateT Bool Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
True
     -- refHeader isn't used if you have an explicit references div
     let cs' :: [Text]
cs' = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
cs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
refclasses
     Block -> StateT Bool Identity Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> StateT Bool Identity Block)
-> Block -> StateT Bool Identity Block
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div (Text
"refs",[Text]
cs',[(Text, Text)]
kvs) ([Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
refs)
   go Block
x = Block -> StateT Bool Identity Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x

refTitle :: Meta -> Maybe [Inline]
refTitle :: Meta -> Maybe [Inline]
refTitle Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"reference-section-title" Meta
meta of
    Just (MetaString Text
s)           -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Text -> Inline
Str Text
s]
    Just (MetaInlines [Inline]
ils)        -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
    Just (MetaBlocks [Plain [Inline]
ils]) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
    Just (MetaBlocks [Para [Inline]
ils])  -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
    Maybe MetaValue
_                             -> Maybe [Inline]
forall a. Maybe a
Nothing

isRefRemove :: Meta -> Bool
isRefRemove :: Meta -> Bool
isRefRemove Meta
meta =
  Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False MetaValue -> Bool
truish (Maybe MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
"suppress-bibliography" Meta
meta

legacyDateRanges :: Reference Inlines -> Reference Inlines
legacyDateRanges :: Reference Inlines -> Reference Inlines
legacyDateRanges Reference Inlines
ref =
  Reference Inlines
ref{ referenceVariables :: Map Variable (Val Inlines)
referenceVariables = (Val Inlines -> Val Inlines)
-> Map Variable (Val Inlines) -> Map Variable (Val Inlines)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Val Inlines -> Val Inlines
forall a. Val a -> Val a
go (Map Variable (Val Inlines) -> Map Variable (Val Inlines))
-> Map Variable (Val Inlines) -> Map Variable (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Reference Inlines -> Map Variable (Val Inlines)
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference Inlines
ref }
 where
  go :: Val a -> Val a
go (DateVal Date
d)
    | [DateParts] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Date -> [DateParts]
dateParts Date
d)
    , Just Text
lit <- Date -> Maybe Text
dateLiteral Date
d
    = case Text -> Text -> [Text]
T.splitOn Text
"_" Text
lit of
        [Text
x,Text
y] -> case Text -> Maybe Date
Citeproc.rawDateEDTF (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y) of
                   Just Date
d' -> Date -> Val a
forall a. Date -> Val a
DateVal Date
d'
                   Maybe Date
Nothing -> Date -> Val a
forall a. Date -> Val a
DateVal Date
d
        [Text]
_ -> Date -> Val a
forall a. Date -> Val a
DateVal Date
d
  go Val a
x = Val a
x

linkifyVariables :: Reference Inlines -> Reference Inlines
linkifyVariables :: Reference Inlines -> Reference Inlines
linkifyVariables Reference Inlines
ref =
  Reference Inlines
ref{ referenceVariables :: Map Variable (Val Inlines)
referenceVariables = (Variable -> Val Inlines -> Val Inlines)
-> Map Variable (Val Inlines) -> Map Variable (Val Inlines)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey Variable -> Val Inlines -> Val Inlines
forall a. (Eq a, IsString a) => a -> Val Inlines -> Val Inlines
go (Map Variable (Val Inlines) -> Map Variable (Val Inlines))
-> Map Variable (Val Inlines) -> Map Variable (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Reference Inlines -> Map Variable (Val Inlines)
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference Inlines
ref }
 where
  go :: a -> Val Inlines -> Val Inlines
go a
"URL" Val Inlines
x    = Text -> Val Inlines -> Val Inlines
tolink Text
"https://" Val Inlines
x
  go a
"DOI" Val Inlines
x    = Text -> Val Inlines -> Val Inlines
tolink Text
"https://doi.org/" (Val Inlines -> Val Inlines
forall a. Val Inlines -> Val a
fixShortDOI Val Inlines
x)
  go a
"ISBN" Val Inlines
x   = Text -> Val Inlines -> Val Inlines
tolink Text
"https://worldcat.org/isbn/" Val Inlines
x
  go a
"PMID" Val Inlines
x   = Text -> Val Inlines -> Val Inlines
tolink Text
"https://www.ncbi.nlm.nih.gov/pubmed/" Val Inlines
x
  go a
"PMCID" Val Inlines
x  = Text -> Val Inlines -> Val Inlines
tolink Text
"https://www.ncbi.nlm.nih.gov/pmc/articles/" Val Inlines
x
  go a
_ Val Inlines
x        = Val Inlines
x
  fixShortDOI :: Val Inlines -> Val a
fixShortDOI Val Inlines
x = let x' :: Text
x' = Val Inlines -> Text
extractText Val Inlines
x
                  in  if Text
"10/" Text -> Text -> Bool
`T.isPrefixOf` Text
x'
                         then Text -> Val a
forall a. Text -> Val a
TextVal (Text -> Val a) -> Text -> Val a
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
3 Text
x'
                              -- see https://shortdoi.org
                         else Text -> Val a
forall a. Text -> Val a
TextVal Text
x'
  tolink :: Text -> Val Inlines -> Val Inlines
tolink Text
pref Val Inlines
x = let x' :: Text
x' = Val Inlines -> Text
extractText Val Inlines
x
                      x'' :: Text
x'' = if Text
"://" Text -> Text -> Bool
`T.isInfixOf` Text
x'
                               then Text
x'
                               else Text
pref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x'
                  in  if Text -> Bool
T.null Text
x'
                         then Val Inlines
x
                         else Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Text -> Text -> Inlines -> Inlines
B.link Text
x'' Text
"" (Text -> Inlines
B.str Text
x'))

extractText :: Val Inlines -> Text
extractText :: Val Inlines -> Text
extractText (TextVal Text
x)  = Text
x
extractText (FancyVal Inlines
x) = Inlines -> Text
forall a. CiteprocOutput a => a -> Text
toText Inlines
x
extractText (NumVal Int
n)   = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
extractText Val Inlines
_            = Text
forall a. Monoid a => a
mempty

capitalizeNoteCitation :: Inline -> Inline
capitalizeNoteCitation :: Inline -> Inline
capitalizeNoteCitation (Cite [Citation]
cs [Note [Para [Inline]
ils]]) =
  [Citation] -> [Inline] -> Inline
Cite [Citation]
cs
  [[Block] -> Inline
Note [[Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline]) -> Inlines -> [Inline]
forall a b. (a -> b) -> a -> b
$ Maybe Lang -> TextCase -> Inlines -> Inlines
forall a. CiteprocOutput a => Maybe Lang -> TextCase -> a -> a
addTextCase Maybe Lang
forall a. Maybe a
Nothing TextCase
CapitalizeFirst
              (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils]]
capitalizeNoteCitation Inline
x = Inline
x

deNote :: [Inline] -> [Inline]
deNote :: [Inline] -> [Inline]
deNote [] = []
deNote (Note [Block]
bs:[Inline]
rest) =
  [Block] -> Inline
Note (([Inline] -> [Inline]) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
go [Block]
bs) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
deNote [Inline]
rest
 where
  go :: [Inline] -> [Inline]
go [] = []
  go (Cite (Citation
c:[Citation]
cs) [Inline]
ils : [Inline]
zs)
    | Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText
      = [Citation] -> [Inline] -> Inline
Cite (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs) ((Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Inline -> [Inline]
noteAfterComma ([Inline] -> Bool
needsPeriod [Inline]
zs)) [Inline]
ils) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
go [Inline]
zs
    | Bool
otherwise
      = [Citation] -> [Inline] -> Inline
Cite (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs) ((Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
noteInParens [Inline]
ils) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
go [Inline]
zs
  go (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
go [Inline]
xs
  needsPeriod :: [Inline] -> Bool
needsPeriod [] = Bool
True
  needsPeriod (Str Text
t:[Inline]
_) = case Text -> Maybe (Char, Text)
T.uncons Text
t of
                            Maybe (Char, Text)
Nothing    -> Bool
False
                            Just (Char
c,Text
_) -> Char -> Bool
isUpper Char
c
  needsPeriod (Inline
Space:[Inline]
zs) = [Inline] -> Bool
needsPeriod [Inline]
zs
  needsPeriod [Inline]
_ = Bool
False
  noteInParens :: Inline -> [Inline]
noteInParens (Note [Block]
bs')
       = Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
"(" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
         [Inline] -> [Inline]
removeFinalPeriod ([Block] -> [Inline]
blocksToInlines [Block]
bs') [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
")"]
  noteInParens Inline
x = [Inline
x]
  noteAfterComma :: Bool -> Inline -> [Inline]
noteAfterComma Bool
needsPer (Note [Block]
bs')
       = Text -> Inline
Str Text
"," Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
         (if Bool
needsPer
             then [Inline] -> [Inline]
forall a. a -> a
id
             else [Inline] -> [Inline]
removeFinalPeriod) ([Block] -> [Inline]
blocksToInlines [Block]
bs')
  noteAfterComma Bool
_ Inline
x = [Inline
x]
deNote (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
deNote [Inline]
xs

-- Note: we can't use dropTextWhileEnd indiscriminately,
-- because this would remove the final period on abbreviations like Ibid.
-- But it turns out that when the note citation ends with Ibid.
-- (or Ed. etc.), the last inline will be Str "" as a result of
-- the punctuation-fixing mechanism that removes the double '.'.
removeFinalPeriod :: [Inline] -> [Inline]
removeFinalPeriod :: [Inline] -> [Inline]
removeFinalPeriod [Inline]
ils =
  case [Inline] -> Maybe Inline
forall a. [a] -> Maybe a
lastMay [Inline]
ils of
    Just (Span Attr
attr [Inline]
ils')
      -> [Inline] -> [Inline]
forall a. [a] -> [a]
initSafe [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Attr -> [Inline] -> Inline
Span Attr
attr ([Inline] -> [Inline]
removeFinalPeriod [Inline]
ils')]
    Just (Emph [Inline]
ils')
      -> [Inline] -> [Inline]
forall a. [a] -> [a]
initSafe [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Inline
Emph ([Inline] -> [Inline]
removeFinalPeriod [Inline]
ils')]
    Just (Strong [Inline]
ils')
      -> [Inline] -> [Inline]
forall a. [a] -> [a]
initSafe [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Inline
Strong ([Inline] -> [Inline]
removeFinalPeriod [Inline]
ils')]
    Just (SmallCaps [Inline]
ils')
      -> [Inline] -> [Inline]
forall a. [a] -> [a]
initSafe [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Inline
SmallCaps ([Inline] -> [Inline]
removeFinalPeriod [Inline]
ils')]
    Just (Str Text
t)
      | Int -> Text -> Text
T.takeEnd Int
1 Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"." -> [Inline] -> [Inline]
forall a. [a] -> [a]
initSafe [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str (Int -> Text -> Text
T.dropEnd Int
1 Text
t)]
      | Text -> Bool
forall a. (Eq a, IsString a) => a -> Bool
isRightQuote (Int -> Text -> Text
T.takeEnd Int
1 Text
t)
        -> [Inline] -> [Inline]
removeFinalPeriod
             ([Inline] -> [Inline]
forall a. [a] -> [a]
initSafe [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
tInit | Bool -> Bool
not (Text -> Bool
T.null Text
tInit)]) [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
tEnd]
             where
               tEnd :: Text
tEnd  = Int -> Text -> Text
T.takeEnd Int
1 Text
t
               tInit :: Text
tInit = Int -> Text -> Text
T.dropEnd Int
1 Text
t
    Maybe Inline
_ -> [Inline]
ils
 where
  isRightQuote :: a -> Bool
isRightQuote a
"\8221" = Bool
True
  isRightQuote a
"\8217" = Bool
True
  isRightQuote a
"\187"  = Bool
True
  isRightQuote a
_       = Bool
False

bcp47LangToIETF :: PandocMonad m => Text -> m (Maybe Lang)
bcp47LangToIETF :: Text -> m (Maybe Lang)
bcp47LangToIETF Text
bcplang =
  case Text -> Either Text Lang
BCP47.parseBCP47 Text
bcplang of
    Left Text
_ -> do
      LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
InvalidLang Text
bcplang
      Maybe Lang -> m (Maybe Lang)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Lang
forall a. Maybe a
Nothing
    Right Lang
lang ->
      Maybe Lang -> m (Maybe Lang)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Lang -> m (Maybe Lang)) -> Maybe Lang -> m (Maybe Lang)
forall a b. (a -> b) -> a -> b
$ Lang -> Maybe Lang
forall a. a -> Maybe a
Just
             (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Lang
Lang (Lang -> Text
BCP47.langLanguage Lang
lang)
                    (if Text -> Bool
T.null (Lang -> Text
BCP47.langRegion Lang
lang)
                        then Maybe Text
forall a. Maybe a
Nothing
                        else Text -> Maybe Text
forall a. a -> Maybe a
Just (Lang -> Text
BCP47.langRegion Lang
lang))