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

import Citeproc
import Citeproc.Pandoc ()
import Text.Pandoc.Citeproc.Locator (parseLocator, toLocatorMap,
                                     LocatorInfo(..))
import Text.Pandoc.Citeproc.CslJson (cslJsonToReferences)
import Text.Pandoc.Citeproc.BibTeX (readBibtexString, Variant(..))
import Text.Pandoc.MIME (MimeType)
import Text.Pandoc.Readers.RIS (readRIS)
import Text.Pandoc.Citeproc.MetaValue (metaValueToReference, metaValueToText)
import Text.Pandoc.Readers.Markdown (yamlToRefs)
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, report, setResourcePath, toTextM)
import Text.Pandoc.Data (readDataFile)
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, tshow)
import Data.Containers.ListUtils (nubOrd)
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 :: forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
processCitations (Pandoc Meta
meta [Block]
bs) = do
  Style (Many Inline)
style <- forall (m :: * -> *).
PandocMonad m =>
Pandoc -> m (Style (Many Inline))
getStyle (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs)
  Maybe Lang
mblang <- forall (m :: * -> *). PandocMonad m => Meta -> m (Maybe Lang)
getCiteprocLang Meta
meta
  let locale :: Locale
locale = forall a. Maybe Lang -> Style a -> Locale
Citeproc.mergeLocales Maybe Lang
mblang Style (Many Inline)
style

  let addQuoteSpan :: Inline -> Inline
addQuoteSpan (Quoted QuoteType
_ [Inline]
xs) = Attr -> [Inline] -> Inline
Span (Text
"",[Text
"csl-quoted"],[]) [Inline]
xs
      addQuoteSpan Inline
x = Inline
x
  [Reference (Many Inline)]
refs <- forall a b. (a -> b) -> [a] -> [b]
map (forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
addQuoteSpan) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          forall (m :: * -> *).
PandocMonad m =>
Maybe Locale -> Pandoc -> m [Reference (Many Inline)]
getReferences (forall a. a -> Maybe a
Just Locale
locale) (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs)

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


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

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

removeQuoteSpan :: Inline -> Inline
removeQuoteSpan :: Inline -> Inline
removeQuoteSpan (Span (Text
"",[Text
"csl-quoted"],[]) [Inline]
xs) = Attr -> [Inline] -> Inline
Span Attr
nullAttr [Inline]
xs
removeQuoteSpan Inline
x = Inline
x

-- | 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 :: forall (m :: * -> *).
PandocMonad m =>
Pandoc -> m (Style (Many Inline))
getStyle (Pandoc Meta
meta [Block]
_) = do
  let cslfile :: Maybe Text
cslfile = (Text -> Meta -> Maybe MetaValue
lookupMeta Text
"csl" Meta
meta forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"citation-style" Meta
meta)
                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 <- forall (m :: * -> *). PandocMonad m => m [String]
getResourcePath
        Maybe String
mbUdd <- forall (m :: * -> *). PandocMonad m => m (Maybe String)
getUserDataDir
        forall (m :: * -> *). PandocMonad m => [String] -> m ()
setResourcePath forall a b. (a -> b) -> a -> b
$ [String]
oldRp forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe []
                                   (\String
u -> [String
u forall a. Semigroup a => a -> a -> a
<> String
"/csl",
                                           String
u forall a. Semigroup a => a -> a -> a
<> String
"/csl/dependent"]) Maybe String
mbUdd
        let fp' :: Text
fp' = if (Char -> Bool) -> Text -> Bool
T.any (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 forall a. Semigroup a => a -> a -> a
<> Text
defaultExtension
        (ByteString
result, Maybe Text
_) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
fp'
        forall (m :: * -> *). PandocMonad m => [String] -> m ()
setResourcePath [String]
oldRp
        forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result

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

  Text
cslContents <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ByteString
getCslDefault (forall {m :: * -> *}. PandocMonad m => Text -> Text -> m ByteString
getFile Text
".csl") Maybe Text
cslfile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                   forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m Text
toTextM (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Text -> String
T.unpack Maybe Text
cslfile)

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

  let getParentStyle :: Text -> m 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 (forall a. Eq a => a -> a -> Bool
/=Char
'/') Text
url
        forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall {m :: * -> *}. PandocMonad m => Text -> Text -> m ByteString
getFile Text
".csl" Text
basename) (\PandocError
_ -> forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
url)
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m Text
toTextM (Text -> String
T.unpack Text
url)

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


-- Retrieve citeproc lang based on metadata.
getCiteprocLang :: PandocMonad m => Meta -> m (Maybe Lang)
getCiteprocLang :: forall (m :: * -> *). PandocMonad m => Meta -> m (Maybe Lang)
getCiteprocLang Meta
meta = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Lang)
bcp47LangToIETF
  ((Text -> Meta -> Maybe MetaValue
lookupMeta Text
"lang" Meta
meta forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"locale" Meta
meta) 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 :: forall (m :: * -> *).
PandocMonad m =>
Maybe Locale -> Pandoc -> m [Reference (Many Inline)]
getReferences Maybe Locale
mblocale (Pandoc Meta
meta [Block]
bs) = do
  Locale
locale <- case Maybe Locale
mblocale of
                Just Locale
l  -> forall (m :: * -> *) a. Monad m => a -> m a
return Locale
l
                Maybe Locale
Nothing -> do
                  Maybe Lang
mblang <- forall (m :: * -> *). PandocMonad m => Meta -> m (Maybe Lang)
getCiteprocLang Meta
meta
                  case Maybe Lang
mblang of
                    Just Lang
lang -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Monoid a => a
mempty forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Lang -> Either CiteprocError Locale
getLocale Lang
lang
                    Maybe Lang
Nothing   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

  let getCiteId :: Inline -> Set Text
getCiteId (Cite [Citation]
cs [Inline]
_) = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
B.citationId [Citation]
cs
      getCiteId Inline
_ = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (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 = 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
"*" forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
nocites
                  then forall a b. a -> b -> a
const Bool
True
                  else (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
citeIds)
  let inlineRefs :: [Reference (Many Inline)]
inlineRefs = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"references" Meta
meta of
                    Just (MetaList [MetaValue]
rs) ->
                      forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
idpred forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemId -> Text
unItemId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reference a -> ItemId
referenceId)
                         forall a b. (a -> b) -> a -> b
$  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe (Reference (Many Inline))
metaValueToReference [MetaValue]
rs
                    Maybe MetaValue
_                  -> []
  [Reference (Many Inline)]
externalRefs <- case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"bibliography" Meta
meta of
                    Just (MetaList [MetaValue]
xs) ->
                      forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Locale -> (Text -> Bool) -> Text -> m [Reference (Many Inline)]
getRefsFromBib Locale
locale Text -> Bool
idpred)
                          (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 -> forall (m :: * -> *).
PandocMonad m =>
Locale -> (Text -> Bool) -> Text -> m [Reference (Many Inline)]
getRefsFromBib Locale
locale Text -> Bool
idpred Text
fp
                        Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
                    Maybe MetaValue
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Reference (Many Inline) -> Reference (Many Inline)
legacyDateRanges ([Reference (Many Inline)]
externalRefs forall a. [a] -> [a] -> [a]
++ [Reference (Many Inline)]
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 :: Many Inline -> Many Inline
insertSpace Many Inline
ils =
  case forall a. Seq a -> ViewL a
Seq.viewl (forall a. Many a -> Seq a
unMany Many Inline
ils) of
    (Span (Text
"",[Text
"csl-left-margin"],[]) [Inline]
xs) Seq.:< Seq Inline
rest ->
      case forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq Inline
rest of
        Just (Span (Text
"",[Text
"csl-right-inline"],[]) [Inline]
_) ->
          forall a. Seq a -> Many a
Many forall a b. (a -> b) -> a -> b
$
            Attr -> [Inline] -> Inline
Span (Text
"",[Text
"csl-left-margin"],[]) ([Inline]
xs forall a. [a] -> [a] -> [a]
++ case forall a. [a] -> Maybe a
lastMay [Inline]
xs of
                                                      Just Inline
Space -> []
                                                      Maybe Inline
_          -> [Inline
Space])
            forall a. a -> Seq a -> Seq a
Seq.<| Seq Inline
rest
        Maybe Inline
_ -> Many Inline
ils
    ViewL Inline
_ -> Many Inline
ils

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

getRefs :: PandocMonad m
        => Locale
        -> BibFormat
        -> (Text -> Bool)
        -> Maybe Text
        -> ByteString
        -> m [Reference Inlines]
getRefs :: forall (m :: * -> *).
PandocMonad m =>
Locale
-> BibFormat
-> (Text -> Bool)
-> Maybe Text
-> ByteString
-> m [Reference (Many Inline)]
getRefs Locale
locale BibFormat
format Text -> Bool
idpred Maybe Text
mbfp ByteString
raw = do
  let err' :: Text -> m a
err' = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Text -> Text -> PandocError
PandocBibliographyError (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe Text
mbfp)
  let fp :: String
fp = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Text -> String
T.unpack Maybe Text
mbfp
  case BibFormat
format of
    BibFormat
Format_bibtex ->
      forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m Text
toTextM String
fp ByteString
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall {a}. Text -> m a
err' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
tshow) forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToSources a =>
Variant
-> Locale
-> (Text -> Bool)
-> a
-> Either ParseError [Reference (Many Inline)]
readBibtexString Variant
Bibtex Locale
locale Text -> Bool
idpred
    BibFormat
Format_biblatex ->
      forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m Text
toTextM String
fp ByteString
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall {a}. Text -> m a
err' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
tshow) forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToSources a =>
Variant
-> Locale
-> (Text -> Bool)
-> a
-> Either ParseError [Reference (Many Inline)]
readBibtexString Variant
Biblatex Locale
locale Text -> Bool
idpred
    BibFormat
Format_json ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall {a}. Text -> m a
err' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
             (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
idpred forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemId -> Text
unItemId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reference a -> ItemId
referenceId)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ByteString -> Either String [Reference (Many Inline)]
cslJsonToReferences forall a b. (a -> b) -> a -> b
$ ByteString
raw
    BibFormat
Format_yaml -> do
      [MetaValue]
rs <- forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ReaderOptions -> Maybe String -> ByteString -> m [MetaValue]
yamlToRefs Text -> Bool
idpred
              forall a. Default a => a
def{ readerExtensions :: Extensions
readerExtensions = Extensions
pandocExtensions }
              (Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mbfp)
              ByteString
raw
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe (Reference (Many Inline))
metaValueToReference [MetaValue]
rs
    BibFormat
Format_ris -> do
      Pandoc Meta
meta [Block]
_ <- forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m Text
toTextM String
fp ByteString
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readRIS forall a. Default a => a
def
      case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"references" Meta
meta of
        Just (MetaList [MetaValue]
rs) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe (Reference (Many Inline))
metaValueToReference [MetaValue]
rs
        Maybe MetaValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []

-- assumes we walk in same order as query
insertResolvedCitations :: Inline -> State [Inlines] Inline
insertResolvedCitations :: Inline -> State [Many Inline] Inline
insertResolvedCitations (Cite [Citation]
cs [Inline]
ils) = do
  [Many Inline]
resolved <- forall s (m :: * -> *). MonadState s m => m s
get
  case [Many Inline]
resolved of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
ils)
    (Many Inline
x:[Many Inline]
xs) -> do
      forall s (m :: * -> *). MonadState s m => s -> m ()
put [Many Inline]
xs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Citation] -> [Inline] -> Inline
Cite [Citation]
cs (forall a. Many a -> [a]
B.toList Many Inline
x)
insertResolvedCitations Inline
x = 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 (Many Inline)]
getCitations Locale
locale Map Text ItemId
otherIdsMap = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Seq (Citation (Many Inline))
getCitation
 where
  getCitation :: Inline -> Seq (Citation (Many Inline))
getCitation (Cite [Citation]
cs [Inline]
_fallback) = forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$
    Citeproc.Citation { citationId :: Maybe Text
Citeproc.citationId = forall a. Maybe a
Nothing
                      , citationNoteNumber :: Maybe Int
Citeproc.citationNoteNumber =
                          case [Citation]
cs of
                            []    -> forall a. Maybe a
Nothing
                            (Pandoc.Citation{ citationNoteNum :: Citation -> Int
Pandoc.citationNoteNum = Int
n }:
                               [Citation]
_) | Int
n forall a. Ord a => a -> a -> Bool
> Int
0     -> forall a. a -> Maybe a
Just Int
n
                                  | Bool
otherwise -> forall a. Maybe a
Nothing
                      , citationItems :: [CitationItem (Many Inline)]
Citeproc.citationItems =
                           Locale
-> Map Text ItemId -> [Citation] -> [CitationItem (Many Inline)]
fromPandocCitations Locale
locale Map Text ItemId
otherIdsMap [Citation]
cs
                      }
  getCitation Inline
_ = forall a. Monoid a => a
mempty

fromPandocCitations :: Locale
                    -> M.Map Text ItemId
                    -> [Pandoc.Citation]
                    -> [CitationItem Inlines]
fromPandocCitations :: Locale
-> Map Text ItemId -> [Citation] -> [CitationItem (Many Inline)]
fromPandocCitations Locale
locale Map Text ItemId
otherIdsMap = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Citation -> [CitationItem (Many Inline)]
go
 where
  locmap :: LocatorMap
locmap = Locale -> LocatorMap
toLocatorMap Locale
locale
  go :: Citation -> [CitationItem (Many Inline)]
go Citation
c =
    let (Maybe LocatorInfo
mblocinfo, [Inline]
suffix) = LocatorMap -> [Inline] -> (Maybe LocatorInfo, [Inline])
parseLocator LocatorMap
locmap (Citation -> [Inline]
citationSuffix Citation
c)
        cit :: CitationItem (Many Inline)
cit = CitationItem
               { citationItemId :: ItemId
citationItemId = forall a. a -> Maybe a -> a
fromMaybe
                   (Text -> ItemId
ItemId forall a b. (a -> b) -> a -> b
$ Citation -> Text
Pandoc.citationId Citation
c)
                   (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 = LocatorInfo -> Text
locatorLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocatorInfo
mblocinfo
               , citationItemLocator :: Maybe Text
citationItemLocator = LocatorInfo -> Text
locatorLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocatorInfo
mblocinfo
               , citationItemType :: CitationItemType
citationItemType = CitationItemType
NormalCite
               , citationItemPrefix :: Maybe (Many Inline)
citationItemPrefix = case Citation -> [Inline]
citationPrefix Citation
c of
                                        [] -> forall a. Maybe a
Nothing
                                        [Inline]
ils -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Many a
B.fromList [Inline]
ils forall a. Semigroup a => a -> a -> a
<>
                                                      Many Inline
B.space
               , citationItemSuffix :: Maybe (Many Inline)
citationItemSuffix = case [Inline]
suffix of
                                        [] -> forall a. Maybe a
Nothing
                                        [Inline]
ils -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Many a
B.fromList [Inline]
ils
               , citationItemData :: Maybe (Reference (Many Inline))
citationItemData = forall a. Maybe a
Nothing }
     in if Citation -> Text
Pandoc.citationId Citation
c forall a. Eq a => a -> a -> Bool
== Text
"*"
           then []
           else
             case Citation -> CitationMode
citationMode Citation
c of
                  CitationMode
AuthorInText   -> [ CitationItem (Many Inline)
cit{ citationItemType :: CitationItemType
citationItemType = CitationItemType
AuthorOnly
                                         , citationItemSuffix :: Maybe (Many Inline)
citationItemSuffix = forall a. Maybe a
Nothing }
                                    , CitationItem (Many Inline)
cit{ citationItemType :: CitationItemType
citationItemType =
                                              CitationItemType
Citeproc.SuppressAuthor
                                         , citationItemPrefix :: Maybe (Many Inline)
citationItemPrefix = forall a. Maybe a
Nothing } ]
                  CitationMode
NormalCitation -> [ CitationItem (Many Inline)
cit ]
                  CitationMode
Pandoc.SuppressAuthor
                                 -> [ CitationItem (Many Inline)
cit{ citationItemType :: CitationItemType
citationItemType =
                                              CitationItemType
Citeproc.SuppressAuthor } ]



data BibFormat =
    Format_biblatex
  | Format_bibtex
  | Format_json
  | Format_yaml
  | Format_ris
  deriving (Int -> BibFormat -> ShowS
[BibFormat] -> ShowS
BibFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BibFormat] -> ShowS
$cshowList :: [BibFormat] -> ShowS
show :: BibFormat -> String
$cshow :: BibFormat -> String
showsPrec :: Int -> BibFormat -> ShowS
$cshowsPrec :: Int -> BibFormat -> ShowS
Show, BibFormat -> BibFormat -> Bool
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
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
Ord)

getBibliographyFormat :: FilePath -> Maybe MimeType -> Maybe BibFormat
getBibliographyFormat :: String -> Maybe Text -> Maybe BibFormat
getBibliographyFormat String
fp Maybe Text
mbmime = do
  let ext :: String
ext = ShowS
takeExtension String
fp
  case String
ext of
    String
".biblatex" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_biblatex
    String
".bibtex"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_bibtex
    String
".bib"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_biblatex
    String
".json"     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_json
    String
".yaml"     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
    String
".yml"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
    String
".ris"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_ris
    String
_ -> do
      Text
mime <- Maybe Text
mbmime
      case (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
';') Text
mime of
            Text
"application/x-bibtex" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_biblatex
            Text
"application/x-reseach-info-systems" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_ris
            Text
"application/vnd.citationstyles.csl+json" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_json
            Text
"application/json" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_json
            Text
"application/x-yaml" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
            Text
"text/x-yaml" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
            Text
"text/yaml" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
            Text
_ -> forall a. Maybe a
Nothing

isNote :: Inline -> Bool
isNote :: Inline -> Bool
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

movePunctInsideQuotes :: Locale -> [Inline] -> [Inline]
movePunctInsideQuotes :: Locale -> [Inline] -> [Inline]
movePunctInsideQuotes Locale
locale
  | Locale -> Maybe Bool
localePunctuationInQuote Locale
locale forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
    = forall a. Many a -> [a]
B.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => a -> a
movePunctuationInsideQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Many a
B.fromList
  | Bool
otherwise
    = forall a. a -> a
id

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 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 forall a b. (a -> b) -> a -> b
$ 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 forall a. a -> [a] -> [a]
: Inline
x forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
ys
                   else Locale -> [Inline] -> [Inline]
movePunctInsideQuotes Locale
locale
                        [Inline
q , Text -> Inline
Str Text
spunct , Inline
x] forall a. [a] -> [a] -> [a]
++ Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale
                        (forall a. Many a -> [a]
B.toList
                          (forall a. CiteprocOutput a => (Char -> Bool) -> a -> a
dropTextWhile Char -> Bool
isPunctuation (forall a. [a] -> Many a
B.fromList [Inline]
ys)))
           else Inline
q forall a. a -> [a] -> [a]
: Inline
x 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils)
   , Inline -> Bool
isNote (forall a. [a] -> a
last [Inline]
ils)
   , [Inline] -> Bool
startWithPunct [Inline]
ys
   , Bool
moveNotes
   = let s :: Text
s = 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 (Locale -> [Inline] -> [Inline]
movePunctInsideQuotes Locale
locale forall a b. (a -> b) -> a -> b
$
                    forall a. [a] -> [a]
init [Inline]
ils
                    forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
spunct | Bool -> Bool
not (Bool -> [Inline] -> Bool
endWithPunct Bool
False (forall a. [a] -> [a]
init [Inline]
ils))]
                    forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [Inline]
ils]) forall a. a -> [a] -> [a]
:
         Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale
           (forall a. Many a -> [a]
B.toList (forall a. CiteprocOutput a => (Char -> Bool) -> a -> a
dropTextWhile Char -> Bool
isPunctuation (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 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 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` (forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils)
  = [Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
ils 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 forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
xs
mvPunct Bool
_ Locale
_ [] = []

endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct Bool
_ [] = Bool
False
endWithPunct Bool
onlyFinal xs :: [Inline]
xs@(Inline
_:[Inline]
_) =
  case forall a. [a] -> [a]
reverse (Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ 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 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 (forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils) of
    Just (Char
c,Text
_) -> Char
c 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 (forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish (MetaBlocks [Plain [Inline]
ils]) = Text -> Bool
isYesValue (Text -> Text
T.toLower (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] -> [Block] -> Pandoc -> Pandoc
insertRefs :: [(Text, Text)] -> [Text] -> [Block] -> Pandoc -> Pandoc
insertRefs [(Text, Text)]
_ [Text]
_ [] Pandoc
d = Pandoc
d
insertRefs [(Text, Text)]
refkvs [Text]
refclasses [Block]
refs (Pandoc Meta
meta [Block]
bs) =
  if Meta -> Bool
isRefRemove Meta
meta
     then Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs
     else case forall s a. State s a -> s -> (a, s)
runState (forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Block -> State Bool Block
go (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs)) Bool
False of
               (Pandoc
d', Bool
True) -> Pandoc
d'
               (Pandoc Meta
meta' [Block]
bs', Bool
False)
                 -> Meta -> [Block] -> Pandoc
Pandoc Meta
meta' forall a b. (a -> b) -> a -> b
$
                    case Meta -> Maybe [Inline]
refTitle Meta
meta of
                      Maybe [Inline]
Nothing ->
                        case forall a. [a] -> [a]
reverse [Block]
bs' of
                          Header Int
lev (Text
id',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ys : [Block]
xs ->
                            forall a. [a] -> [a]
reverse [Block]
xs forall a. [a] -> [a] -> [a]
++
                            [Int -> Attr -> [Inline] -> Block
Header Int
lev (Text
id',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' forall a. [a] -> [a] -> [a]
++ [Block
refDiv]
                      Just [Inline]
ils -> [Block]
bs' 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" forall a. a -> [a] -> [a]
: [a
c | a
c <- [a]
cs, a
c forall a. Eq a => a -> a -> Bool
/= a
"unnumbered"]
   go :: Block -> State Bool Block
   go :: Block -> State Bool Block
go (Div (Text
"refs",[Text]
cs,[(Text, Text)]
kvs) [Block]
xs) = do
     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' = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ [Text]
cs forall a. [a] -> [a] -> [a]
++ [Text]
refclasses
     let kvs' :: [(Text, Text)]
kvs' = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
kvs forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
refkvs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div (Text
"refs",[Text]
cs',[(Text, Text)]
kvs') ([Block]
xs forall a. [a] -> [a] -> [a]
++ [Block]
refs)
   go Block
x = 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)           -> forall a. a -> Maybe a
Just [Text -> Inline
Str Text
s]
    Just (MetaInlines [Inline]
ils)        -> forall a. a -> Maybe a
Just [Inline]
ils
    Just (MetaBlocks [Plain [Inline]
ils]) -> forall a. a -> Maybe a
Just [Inline]
ils
    Just (MetaBlocks [Para [Inline]
ils])  -> forall a. a -> Maybe a
Just [Inline]
ils
    Maybe MetaValue
_                             -> forall a. Maybe a
Nothing

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

legacyDateRanges :: Reference Inlines -> Reference Inlines
legacyDateRanges :: Reference (Many Inline) -> Reference (Many Inline)
legacyDateRanges Reference (Many Inline)
ref =
  Reference (Many Inline)
ref{ referenceVariables :: Map Variable (Val (Many Inline))
referenceVariables = forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {a}. Val a -> Val a
go forall a b. (a -> b) -> a -> b
$ forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference (Many Inline)
ref }
 where
  go :: Val a -> Val a
go (DateVal Date
d)
    | 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 forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
y) of
                   Just Date
d' -> forall a. Date -> Val a
DateVal Date
d'
                   Maybe Date
Nothing -> forall a. Date -> Val a
DateVal Date
d
        [Text]
_ -> forall a. Date -> Val a
DateVal Date
d
  go Val a
x = Val a
x

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

-- Here we take the Spans with class csl-note that are left
-- after deNote has removed nested ones, and convert them
-- into real notes.
addNote :: Inline -> Inline
addNote :: Inline -> Inline
addNote (Span (Text
"",[Text
"csl-note"],[]) [Inline]
ils) =
  [Block] -> Inline
Note [[Inline] -> Block
Para forall a b. (a -> b) -> a -> b
$
         forall a. Many a -> [a]
B.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => Maybe Lang -> TextCase -> a -> a
addTextCase forall a. Maybe a
Nothing TextCase
CapitalizeFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$ [Inline]
ils]
addNote Inline
x = Inline
x

-- Here we handle citation notes that occur inside footnotes
-- or other citation notes, in a note style.  We don't want
-- notes inside notes, so we convert these to parenthesized
-- or comma-separated citations.
deNote :: Inline -> Inline
deNote :: Inline -> Inline
deNote (Note [Block]
bs) =
  case [Block]
bs of
    [Para (cit :: Inline
cit@(Cite (Citation
c:[Citation]
_) [Inline]
_) : [Inline]
ils)]
       | Citation -> CitationMode
citationMode Citation
c forall a. Eq a => a -> a -> Bool
/= CitationMode
AuthorInText ->
         -- if citation is first in note, no need to parenthesize.
         [Block] -> Inline
Note [[Inline] -> Block
Para (forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNotes forall a b. (a -> b) -> a -> b
$ Inline
cit forall a. a -> [a] -> [a]
: forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
addParens [Inline]
ils)]
    [Block]
_ -> [Block] -> Inline
Note (forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
addParens forall a b. (a -> b) -> a -> b
$ [Block]
bs)

 where
  addParens :: [Inline] -> [Inline]
addParens [] = []
  addParens (Cite (Citation
c:[Citation]
cs) [Inline]
ils : [Inline]
zs)
    | Citation -> CitationMode
citationMode Citation
c forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText
      = [Citation] -> [Inline] -> Inline
Cite (Citation
cforall a. a -> [a] -> [a]
:[Citation]
cs) (Bool -> [Inline] -> [Inline]
addCommas ([Inline] -> Bool
needsPeriod [Inline]
zs) [Inline]
ils) forall a. a -> [a] -> [a]
:
        [Inline] -> [Inline]
addParens [Inline]
zs
    | Bool
otherwise
      = [Citation] -> [Inline] -> Inline
Cite (Citation
cforall a. a -> [a] -> [a]
:[Citation]
cs) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
noteInParens [Inline]
ils) forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
addParens [Inline]
zs
  addParens (Inline
x:[Inline]
xs) = Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
addParens [Inline]
xs

  removeNotes :: Inline -> Inline
removeNotes (Span (Text
"",[Text
"csl-note"],[]) [Inline]
ils) = Attr -> [Inline] -> Inline
Span (Text
"",[],[]) [Inline]
ils
  removeNotes Inline
x = Inline
x

  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 (Span (Text
"",[Text
"csl-note"],[]) [Inline]
ils)
       = Inline
Space forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
"(" forall a. a -> [a] -> [a]
:
         [Inline] -> [Inline]
removeFinalPeriod [Inline]
ils forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
")"]
  noteInParens Inline
x = [Inline
x]

  -- We want to add a comma before a CSL note citation, but not
  -- before the author name, and not before the first citation
  -- if it doesn't begin with an author name.
  addCommas :: Bool -> [Inline] -> [Inline]
addCommas = Bool -> Bool -> [Inline] -> [Inline]
addCommas' Bool
True -- boolean == "at beginning"

  addCommas' :: Bool -> Bool -> [Inline] -> [Inline]
addCommas' Bool
_ Bool
_ [] = []
  addCommas' Bool
atBeginning Bool
needsPer
    (Span (Text
"",[Text
"csl-note"],[]) [Inline]
ils : [Inline]
rest)
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils)
       = (if Bool
atBeginning then forall a. a -> a
id else ([Text -> Inline
Str Text
"," , Inline
Space] forall a. [a] -> [a] -> [a]
++)) forall a b. (a -> b) -> a -> b
$
         (if Bool
needsPer then [Inline]
ils else [Inline] -> [Inline]
removeFinalPeriod [Inline]
ils) forall a. [a] -> [a] -> [a]
++
         Bool -> Bool -> [Inline] -> [Inline]
addCommas' Bool
False Bool
needsPer [Inline]
rest
  addCommas' Bool
_ Bool
needsPer (Inline
il : [Inline]
rest) = Inline
il forall a. a -> [a] -> [a]
: Bool -> Bool -> [Inline] -> [Inline]
addCommas' Bool
False Bool
needsPer [Inline]
rest

deNote Inline
x = Inline
x

-- 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 forall a. [a] -> Maybe a
lastMay [Inline]
ils of
    Just (Span Attr
attr [Inline]
ils')
      -> forall a. [a] -> [a]
initSafe [Inline]
ils forall a. [a] -> [a] -> [a]
++ [Attr -> [Inline] -> Inline
Span Attr
attr ([Inline] -> [Inline]
removeFinalPeriod [Inline]
ils')]
    Just (Emph [Inline]
ils')
      -> forall a. [a] -> [a]
initSafe [Inline]
ils forall a. [a] -> [a] -> [a]
++ [[Inline] -> Inline
Emph ([Inline] -> [Inline]
removeFinalPeriod [Inline]
ils')]
    Just (Strong [Inline]
ils')
      -> forall a. [a] -> [a]
initSafe [Inline]
ils forall a. [a] -> [a] -> [a]
++ [[Inline] -> Inline
Strong ([Inline] -> [Inline]
removeFinalPeriod [Inline]
ils')]
    Just (SmallCaps [Inline]
ils')
      -> forall a. [a] -> [a]
initSafe [Inline]
ils 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 forall a. Eq a => a -> a -> Bool
== Text
"." -> forall a. [a] -> [a]
initSafe [Inline]
ils forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str (Int -> Text -> Text
T.dropEnd Int
1 Text
t)]
      | forall {a}. (Eq a, IsString a) => a -> Bool
isRightQuote (Int -> Text -> Text
T.takeEnd Int
1 Text
t)
        -> [Inline] -> [Inline]
removeFinalPeriod
             (forall a. [a] -> [a]
initSafe [Inline]
ils forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
tInit | Bool -> Bool
not (Text -> Bool
T.null Text
tInit)]) 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 :: forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Lang)
bcp47LangToIETF Text
bcplang =
  case Text -> Either String Lang
parseLang Text
bcplang of
    Left String
_ -> do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
InvalidLang Text
bcplang
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Right Lang
lang -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Lang
lang