{-# 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)
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 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 :: forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
processCitations (Pandoc Meta
meta [Block]
bs) = do
Style (Many Inline)
style <- Pandoc -> m (Style (Many Inline))
forall (m :: * -> *).
PandocMonad m =>
Pandoc -> m (Style (Many Inline))
getStyle (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs)
Maybe Lang
mblang <- Meta -> m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Meta -> m (Maybe Lang)
getCiteprocLang Meta
meta
let locale :: Locale
locale = Maybe Lang -> Style (Many Inline) -> 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 <- (Reference (Many Inline) -> Reference (Many Inline))
-> [Reference (Many Inline)] -> [Reference (Many Inline)]
forall a b. (a -> b) -> [a] -> [b]
map ((Inline -> Inline)
-> Reference (Many Inline) -> Reference (Many Inline)
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
addQuoteSpan) ([Reference (Many Inline)] -> [Reference (Many Inline)])
-> m [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Maybe Locale -> Pandoc -> m [Reference (Many Inline)]
forall (m :: * -> *).
PandocMonad m =>
Maybe Locale -> Pandoc -> m [Reference (Many Inline)]
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 (Many Inline) -> Map Text ItemId -> Map Text ItemId)
-> Map Text ItemId -> [Reference (Many Inline)] -> Map Text ItemId
forall a b. (a -> b -> b) -> b -> [a] -> b
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 (Text -> [Text])
-> (Val (Many Inline) -> Text) -> Val (Many Inline) -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val (Many Inline) -> Text
extractText (Val (Many Inline) -> [Text])
-> Maybe (Val (Many Inline)) -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Variable
-> Map Variable (Val (Many Inline)) -> Maybe (Val (Many Inline))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Variable
"other-ids"
(Reference (Many Inline) -> Map Variable (Val (Many Inline))
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference (Many Inline)
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 a b. (a -> b -> b) -> b -> [a] -> b
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 (Many Inline) -> ItemId
forall a. Reference a -> ItemId
referenceId Reference (Many Inline)
ref)) Map Text ItemId
m [Text]
ids)
Map Text ItemId
forall k a. Map k a
M.empty [Reference (Many Inline)]
refs
let meta' :: Meta
meta' = Text -> 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 (Pandoc -> [Citation (Many Inline)])
-> Pandoc -> [Citation (Many Inline)]
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 linkBib :: Bool
linkBib = 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
"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 = CiteprocOptions
-> Style (Many Inline)
-> Maybe Lang
-> [Reference (Many Inline)]
-> [Citation (Many Inline)]
-> Result (Many Inline)
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
(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 (Many Inline) -> [Text]
forall a. Result a -> [Text]
resultWarnings Result (Many Inline)
result)
let sopts :: StyleOptions
sopts = Style (Many Inline) -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style (Many Inline)
style
let classes :: [Text]
classes = Text
"references" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
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, Many Inline) -> Blocks)
-> [(Text, Many Inline)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
ident, Many Inline
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)
-> (Many Inline -> Blocks) -> Many Inline -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Blocks
B.para (Many Inline -> Blocks)
-> (Many Inline -> Many Inline) -> Many Inline -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Many Inline -> Many Inline
insertSpace (Many Inline -> Blocks) -> Many Inline -> Blocks
forall a b. (a -> b) -> a -> b
$ Many Inline
out)
(Result (Many Inline) -> [(Text, Many Inline)]
forall a. Result a -> [(Text, a)]
resultBibliography Result (Many Inline)
result)
let moveNotes :: Bool
moveNotes = Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
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 = Result (Many Inline) -> [Many Inline]
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' =
(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
forall b. ToMetaValue b => Text -> b -> Pandoc -> Pandoc
setMeta Text
"nocite") Maybe MetaValue
metanocites (Pandoc -> Pandoc)
-> ([Many Inline] -> Pandoc) -> [Many Inline] -> 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 (Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale) (Pandoc -> Pandoc)
-> ([Many Inline] -> Pandoc) -> [Many Inline] -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if StyleOptions -> Bool
styleIsNoteStyle StyleOptions
sopts
then (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
addNote (Pandoc -> Pandoc) -> (Pandoc -> Pandoc) -> Pandoc -> 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
else Pandoc -> Pandoc
forall a. a -> a
id) (Pandoc -> Pandoc)
-> ([Many Inline] -> Pandoc) -> [Many Inline] -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
State [Many Inline] Pandoc -> [Many Inline] -> Pandoc
forall s a. State s a -> s -> a
evalState ((Inline -> StateT [Many Inline] Identity Inline)
-> Pandoc -> State [Many Inline] Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> Pandoc -> m Pandoc
walkM Inline -> StateT [Many Inline] Identity Inline
insertResolvedCitations (Pandoc -> State [Many Inline] Pandoc)
-> Pandoc -> State [Many Inline] Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta' [Block]
bs)
([Many Inline] -> Pandoc) -> [Many Inline] -> Pandoc
forall a b. (a -> b) -> a -> b
$ [Many Inline]
cits
Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeQuoteSpan
(Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> [Text] -> [Block] -> Pandoc -> Pandoc
insertRefs [(Text, Text)]
refkvs [Text]
classes (Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bibs)
(Pandoc -> Pandoc) -> Pandoc -> Pandoc
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
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 Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall a. Maybe a -> Maybe a -> Maybe a
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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 a. a -> m a
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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 a. a -> m a
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 a. PandocError -> m a
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 a. a -> m a
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
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 a. f a -> (PandocError -> f a) -> f a
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 (Many Inline))
styleRes <- (Text -> m Text)
-> Text -> m (Either CiteprocError (Style (Many Inline)))
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 (Many Inline))
styleRes of
Left CiteprocError
err -> PandocError -> m (Style (Many Inline))
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Style (Many Inline)))
-> PandocError -> m (Style (Many Inline))
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 (Many Inline)
style -> Style (Many Inline) -> m (Style (Many Inline))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Style (Many Inline)
style{ styleAbbreviations :: Maybe Abbreviations
styleAbbreviations = Maybe Abbreviations
mbAbbrevs }
getCiteprocLang :: PandocMonad m => Meta -> m (Maybe Lang)
getCiteprocLang :: forall (m :: * -> *). PandocMonad m => Meta -> m (Maybe Lang)
getCiteprocLang 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 a. a -> m a
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 a. Maybe a -> Maybe a -> Maybe a
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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText)
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 -> Locale -> m Locale
forall a. a -> m a
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)
getCiteprocLang Meta
meta
case Maybe Lang
mblang of
Just Lang
lang -> Locale -> m Locale
forall a. a -> m a
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 a. a -> m a
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 c. Monoid c => (Inline -> c) -> MetaValue -> c
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 c. Monoid c => (Inline -> c) -> Pandoc -> c
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 (Many Inline)]
inlineRefs = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"references" Meta
meta of
Just (MetaList [MetaValue]
rs) ->
(Reference (Many Inline) -> Bool)
-> [Reference (Many Inline)] -> [Reference (Many Inline)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
idpred (Text -> Bool)
-> (Reference (Many Inline) -> Text)
-> Reference (Many Inline)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemId -> Text
unItemId (ItemId -> Text)
-> (Reference (Many Inline) -> ItemId)
-> Reference (Many Inline)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference (Many Inline) -> ItemId
forall a. Reference a -> ItemId
referenceId)
([Reference (Many Inline)] -> [Reference (Many Inline)])
-> [Reference (Many Inline)] -> [Reference (Many Inline)]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Maybe (Reference (Many Inline)))
-> [MetaValue] -> [Reference (Many Inline)]
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) ->
[[Reference (Many Inline)]] -> [Reference (Many Inline)]
forall a. Monoid a => [a] -> a
mconcat ([[Reference (Many Inline)]] -> [Reference (Many Inline)])
-> m [[Reference (Many Inline)]] -> m [Reference (Many Inline)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Text -> m [Reference (Many Inline)])
-> [Text] -> m [[Reference (Many Inline)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Locale -> (Text -> Bool) -> Text -> m [Reference (Many Inline)]
forall (m :: * -> *).
PandocMonad m =>
Locale -> (Text -> Bool) -> Text -> m [Reference (Many Inline)]
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 (Many Inline)]
forall (m :: * -> *).
PandocMonad m =>
Locale -> (Text -> Bool) -> Text -> m [Reference (Many Inline)]
getRefsFromBib Locale
locale Text -> Bool
idpred Text
fp
Maybe Text
Nothing -> [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Maybe MetaValue
Nothing -> [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reference (Many Inline)] -> m [Reference (Many Inline)])
-> [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a b. (a -> b) -> a -> b
$ (Reference (Many Inline) -> Reference (Many Inline))
-> [Reference (Many Inline)] -> [Reference (Many Inline)]
forall a b. (a -> b) -> [a] -> [b]
map Reference (Many Inline) -> Reference (Many Inline)
legacyDateRanges ([Reference (Many Inline)]
externalRefs [Reference (Many Inline)]
-> [Reference (Many Inline)] -> [Reference (Many Inline)]
forall a. [a] -> [a] -> [a]
++ [Reference (Many Inline)]
inlineRefs)
insertSpace :: Inlines -> Inlines
insertSpace :: Many Inline -> Many Inline
insertSpace Many Inline
ils =
case Seq Inline -> ViewL Inline
forall a. Seq a -> ViewL a
Seq.viewl (Many Inline -> Seq Inline
forall a. Many a -> Seq a
unMany Many Inline
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 -> Many Inline
forall a. Seq a -> Many a
Many (Seq Inline -> Many Inline) -> Seq Inline -> Many Inline
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
_ -> 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) <- Text -> m (ByteString, Maybe Text)
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 -> Locale
-> BibFormat
-> (Text -> Bool)
-> Maybe Text
-> ByteString
-> m [Reference (Many Inline)]
forall (m :: * -> *).
PandocMonad m =>
Locale
-> BibFormat
-> (Text -> Bool)
-> Maybe Text
-> ByteString
-> m [Reference (Many Inline)]
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 (Many Inline)]
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m [Reference (Many Inline)])
-> PandocError -> m [Reference (Many Inline)]
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 :: 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' = PandocError -> m a
forall a. 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 (Many Inline)])
-> ([Reference (Many Inline)] -> m [Reference (Many Inline)])
-> Either ParseError [Reference (Many Inline)]
-> m [Reference (Many Inline)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> m [Reference (Many Inline)]
forall {a}. Text -> m a
err' (Text -> m [Reference (Many Inline)])
-> (ParseError -> Text)
-> ParseError
-> m [Reference (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Text
forall a. Show a => a -> Text
tshow) [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError [Reference (Many Inline)]
-> m [Reference (Many Inline)])
-> (ByteString -> Either ParseError [Reference (Many Inline)])
-> ByteString
-> m [Reference (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Variant
-> Locale
-> (Text -> Bool)
-> Text
-> Either ParseError [Reference (Many Inline)]
forall a.
ToSources a =>
Variant
-> Locale
-> (Text -> Bool)
-> a
-> Either ParseError [Reference (Many Inline)]
readBibtexString Variant
Bibtex Locale
locale Text -> Bool
idpred (Text -> Either ParseError [Reference (Many Inline)])
-> (ByteString -> Text)
-> ByteString
-> Either ParseError [Reference (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
UTF8.toText (ByteString -> m [Reference (Many Inline)])
-> ByteString -> m [Reference (Many Inline)]
forall a b. (a -> b) -> a -> b
$ ByteString
raw
BibFormat
Format_biblatex ->
(ParseError -> m [Reference (Many Inline)])
-> ([Reference (Many Inline)] -> m [Reference (Many Inline)])
-> Either ParseError [Reference (Many Inline)]
-> m [Reference (Many Inline)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> m [Reference (Many Inline)]
forall {a}. Text -> m a
err' (Text -> m [Reference (Many Inline)])
-> (ParseError -> Text)
-> ParseError
-> m [Reference (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Text
forall a. Show a => a -> Text
tshow) [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError [Reference (Many Inline)]
-> m [Reference (Many Inline)])
-> (ByteString -> Either ParseError [Reference (Many Inline)])
-> ByteString
-> m [Reference (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Variant
-> Locale
-> (Text -> Bool)
-> Text
-> Either ParseError [Reference (Many Inline)]
forall a.
ToSources a =>
Variant
-> Locale
-> (Text -> Bool)
-> a
-> Either ParseError [Reference (Many Inline)]
readBibtexString Variant
Biblatex Locale
locale Text -> Bool
idpred (Text -> Either ParseError [Reference (Many Inline)])
-> (ByteString -> Text)
-> ByteString
-> Either ParseError [Reference (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
UTF8.toText (ByteString -> m [Reference (Many Inline)])
-> ByteString -> m [Reference (Many Inline)]
forall a b. (a -> b) -> a -> b
$ ByteString
raw
BibFormat
Format_json ->
(String -> m [Reference (Many Inline)])
-> ([Reference (Many Inline)] -> m [Reference (Many Inline)])
-> Either String [Reference (Many Inline)]
-> m [Reference (Many Inline)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> m [Reference (Many Inline)]
forall {a}. Text -> m a
err' (Text -> m [Reference (Many Inline)])
-> (String -> Text) -> String -> m [Reference (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
([Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reference (Many Inline)] -> m [Reference (Many Inline)])
-> ([Reference (Many Inline)] -> [Reference (Many Inline)])
-> [Reference (Many Inline)]
-> m [Reference (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference (Many Inline) -> Bool)
-> [Reference (Many Inline)] -> [Reference (Many Inline)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
idpred (Text -> Bool)
-> (Reference (Many Inline) -> Text)
-> Reference (Many Inline)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemId -> Text
unItemId (ItemId -> Text)
-> (Reference (Many Inline) -> ItemId)
-> Reference (Many Inline)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference (Many Inline) -> ItemId
forall a. Reference a -> ItemId
referenceId)) (Either String [Reference (Many Inline)]
-> m [Reference (Many Inline)])
-> (ByteString -> Either String [Reference (Many Inline)])
-> ByteString
-> m [Reference (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ByteString -> Either String [Reference (Many Inline)]
cslJsonToReferences (ByteString -> m [Reference (Many Inline)])
-> ByteString -> m [Reference (Many Inline)]
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
raw
[Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reference (Many Inline)] -> m [Reference (Many Inline)])
-> [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Maybe (Reference (Many Inline)))
-> [MetaValue] -> [Reference (Many Inline)]
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]
_ <- ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readRIS ReaderOptions
forall a. Default a => a
def (ByteString -> Text
UTF8.toText ByteString
raw)
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"references" Meta
meta of
Just (MetaList [MetaValue]
rs) -> [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reference (Many Inline)] -> m [Reference (Many Inline)])
-> [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Maybe (Reference (Many Inline)))
-> [MetaValue] -> [Reference (Many Inline)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe (Reference (Many Inline))
metaValueToReference [MetaValue]
rs
Maybe MetaValue
_ -> [Reference (Many Inline)] -> m [Reference (Many Inline)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
insertResolvedCitations :: Inline -> State [Inlines] Inline
insertResolvedCitations :: Inline -> StateT [Many Inline] Identity Inline
insertResolvedCitations (Cite [Citation]
cs [Inline]
ils) = do
[Many Inline]
resolved <- StateT [Many Inline] Identity [Many Inline]
forall s (m :: * -> *). MonadState s m => m s
get
case [Many Inline]
resolved of
[] -> Inline -> StateT [Many Inline] Identity Inline
forall a. a -> StateT [Many Inline] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
ils)
(Many Inline
x:[Many Inline]
xs) -> do
[Many Inline] -> StateT [Many Inline] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Many Inline]
xs
Inline -> StateT [Many Inline] Identity Inline
forall a. a -> StateT [Many Inline] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT [Many Inline] Identity Inline)
-> Inline -> StateT [Many Inline] Identity Inline
forall a b. (a -> b) -> a -> b
$ [Citation] -> [Inline] -> Inline
Cite [Citation]
cs (Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList Many Inline
x)
insertResolvedCitations Inline
x = Inline -> StateT [Many Inline] Identity Inline
forall a. a -> StateT [Many Inline] Identity a
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 = Seq (Citation (Many Inline)) -> [Citation (Many Inline)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq (Citation (Many Inline)) -> [Citation (Many Inline)])
-> (Pandoc -> Seq (Citation (Many Inline)))
-> Pandoc
-> [Citation (Many Inline)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Seq (Citation (Many Inline)))
-> Pandoc -> Seq (Citation (Many Inline))
forall c. Monoid c => (Inline -> c) -> Pandoc -> 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) = Citation (Many Inline) -> Seq (Citation (Many Inline))
forall a. a -> Seq a
Seq.singleton (Citation (Many Inline) -> Seq (Citation (Many Inline)))
-> Citation (Many Inline) -> Seq (Citation (Many Inline))
forall a b. (a -> b) -> a -> b
$
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 (Many Inline)]
Citeproc.citationItems =
Locale
-> Map Text ItemId -> [Citation] -> [CitationItem (Many Inline)]
fromPandocCitations Locale
locale Map Text ItemId
otherIdsMap [Citation]
cs
}
getCitation Inline
_ = Seq (Citation (Many 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 = (Citation -> [CitationItem (Many Inline)])
-> [Citation] -> [CitationItem (Many Inline)]
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 = 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 = LocatorInfo -> Text
locatorLabel (LocatorInfo -> Text) -> Maybe LocatorInfo -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocatorInfo
mblocinfo
, citationItemLocator :: Maybe Text
citationItemLocator = LocatorInfo -> Text
locatorLoc (LocatorInfo -> Text) -> Maybe LocatorInfo -> Maybe Text
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
[] -> Maybe (Many Inline)
forall a. Maybe a
Nothing
[Inline]
ils -> Many Inline -> Maybe (Many Inline)
forall a. a -> Maybe a
Just (Many Inline -> Maybe (Many Inline))
-> Many Inline -> Maybe (Many Inline)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList [Inline]
ils Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<>
Many Inline
B.space
, citationItemSuffix :: Maybe (Many Inline)
citationItemSuffix = case [Inline]
suffix of
[] -> Maybe (Many Inline)
forall a. Maybe a
Nothing
[Inline]
ils -> Many Inline -> Maybe (Many Inline)
forall a. a -> Maybe a
Just (Many Inline -> Maybe (Many Inline))
-> Many Inline -> Maybe (Many Inline)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList [Inline]
ils
, citationItemData :: Maybe (Reference (Many Inline))
citationItemData = Maybe (Reference (Many Inline))
forall a. Maybe a
Nothing }
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 (Many Inline)
cit{ citationItemType :: CitationItemType
citationItemType = CitationItemType
AuthorOnly
, citationItemSuffix :: Maybe (Many Inline)
citationItemSuffix = Maybe (Many Inline)
forall a. Maybe a
Nothing }
, CitationItem (Many Inline)
cit{ citationItemType :: CitationItemType
citationItemType =
CitationItemType
Citeproc.SuppressAuthor
, citationItemPrefix :: Maybe (Many Inline)
citationItemPrefix = Maybe (Many Inline)
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 -> 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
$cshowsPrec :: Int -> BibFormat -> String -> String
showsPrec :: Int -> BibFormat -> String -> String
$cshow :: BibFormat -> String
show :: BibFormat -> String
$cshowList :: [BibFormat] -> String -> String
showList :: [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
$c== :: BibFormat -> BibFormat -> Bool
== :: BibFormat -> BibFormat -> Bool
$c/= :: BibFormat -> BibFormat -> Bool
/= :: 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
$ccompare :: BibFormat -> BibFormat -> Ordering
compare :: BibFormat -> BibFormat -> Ordering
$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
>= :: BibFormat -> BibFormat -> Bool
$cmax :: BibFormat -> BibFormat -> BibFormat
max :: BibFormat -> BibFormat -> BibFormat
$cmin :: BibFormat -> BibFormat -> BibFormat
min :: BibFormat -> BibFormat -> BibFormat
Ord)
getBibliographyFormat :: FilePath -> Maybe MimeType -> Maybe BibFormat
getBibliographyFormat :: String -> Maybe Text -> Maybe BibFormat
getBibliographyFormat String
fp Maybe Text
mbmime = do
let ext :: String
ext = String -> String
takeExtension String
fp
case String
ext of
String
".biblatex" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_biblatex
String
".bibtex" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_bibtex
String
".bib" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_biblatex
String
".json" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_json
String
".yaml" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
String
".yml" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
String
".ris" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';') Text
mime of
Text
"application/x-bibtex" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_biblatex
Text
"application/x-reseach-info-systems" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_ris
Text
"application/vnd.citationstyles.csl+json" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_json
Text
"application/json" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_json
Text
"application/x-yaml" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
Text
"text/x-yaml" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
Text
"text/yaml" -> BibFormat -> Maybe BibFormat
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BibFormat
Format_yaml
Text
_ -> Maybe BibFormat
forall a. Maybe a
Nothing
isNote :: Inline -> Bool
isNote :: Inline -> Bool
isNote (Cite [Citation]
_ [Note [Block]
_]) = Bool
True
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 Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
= Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline])
-> ([Inline] -> Many Inline) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
forall a. CiteprocOutput a => a -> a
movePunctuationInsideQuotes (Many Inline -> Many Inline)
-> ([Inline] -> Many Inline) -> [Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList
| Bool
otherwise
= [Inline] -> [Inline]
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 Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale [Inline]
xs
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 Locale -> [Inline] -> [Inline]
movePunctInsideQuotes Locale
locale
[Inline
q , Text -> Inline
Str Text
spunct , Inline
x] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale
(Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList
((Char -> Bool) -> Many Inline -> Many Inline
forall a. CiteprocOutput a => (Char -> Bool) -> a -> a
dropTextWhile Char -> Bool
isPunctuation ([Inline] -> Many Inline
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
mvPunct Bool
moveNotes Locale
locale (Cite [Citation]
cs [Inline]
ils : [Inline]
ys)
| Bool -> Bool
not ([Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils)
, Inline -> Bool
isNote ([Inline] -> Inline
forall a. HasCallStack => [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 (Locale -> [Inline] -> [Inline]
movePunctInsideQuotes Locale
locale ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$
[Inline] -> [Inline]
forall a. HasCallStack => [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. HasCallStack => [a] -> [a]
init [Inline]
ils))]
[Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Inline
forall a. HasCallStack => [a] -> a
last [Inline]
ils]) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
Bool -> Locale -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Locale
locale
(Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList ((Char -> Bool) -> Many Inline -> Many Inline
forall a. CiteprocOutput a => (Char -> Bool) -> a -> a
dropTextWhile Char -> Bool
isPunctuation ([Inline] -> Many Inline
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
_ [] = []
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
(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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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
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 State Bool Pandoc -> Bool -> (Pandoc, Bool)
forall s a. State s a -> s -> (a, s)
runState ((Block -> StateT Bool Identity Block)
-> Pandoc -> State Bool Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Block -> m Block) -> Pandoc -> m Pandoc
walkM Block -> StateT Bool Identity 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' ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$
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
let cs' :: [Text]
cs' = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
cs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
refclasses
let kvs' :: [(Text, Text)]
kvs' = [(Text, Text)] -> [(Text, Text)]
forall a. Ord a => [a] -> [a]
nubOrd ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
kvs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
refkvs
Block -> StateT Bool Identity Block
forall a. a -> StateT Bool Identity a
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 a. a -> StateT Bool Identity a
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 (Many Inline) -> Reference (Many Inline)
legacyDateRanges Reference (Many Inline)
ref =
Reference (Many Inline)
ref{ referenceVariables :: Map Variable (Val (Many Inline))
referenceVariables = (Val (Many Inline) -> Val (Many Inline))
-> Map Variable (Val (Many Inline))
-> Map Variable (Val (Many Inline))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Val (Many Inline) -> Val (Many Inline)
forall {a}. Val a -> Val a
go (Map Variable (Val (Many Inline))
-> Map Variable (Val (Many Inline)))
-> Map Variable (Val (Many Inline))
-> Map Variable (Val (Many Inline))
forall a b. (a -> b) -> a -> b
$ Reference (Many Inline) -> Map Variable (Val (Many Inline))
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference (Many Inline)
ref }
where
go :: Val a -> Val a
go (DateVal Date
d)
| [DateParts] -> Bool
forall a. [a] -> 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 HasCallStack => Text -> Text -> [Text]
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
extractText :: Val Inlines -> Text
(TextVal Text
x) = Text
x
extractText (FancyVal Many Inline
x) = Many Inline -> Text
forall a. CiteprocOutput a => a -> Text
toText Many Inline
x
extractText (NumVal Int
n) = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
extractText Val (Many Inline)
_ = Text
forall a. Monoid a => a
mempty
addNote :: Inline -> Inline
addNote :: Inline -> Inline
addNote (Span (Text
"",[Text
"csl-note"],[]) [Inline]
ils) =
[Block] -> Inline
Note [[Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$
Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline])
-> ([Inline] -> Many Inline) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Lang -> TextCase -> Many Inline -> Many Inline
forall a. CiteprocOutput a => Maybe Lang -> TextCase -> a -> a
addTextCase Maybe Lang
forall a. Maybe a
Nothing TextCase
CapitalizeFirst (Many Inline -> Many Inline)
-> ([Inline] -> Many Inline) -> [Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline]
ils]
addNote Inline
x = Inline
x
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 CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
/= CitationMode
AuthorInText ->
[Block] -> Inline
Note [[Inline] -> Block
Para ((Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNotes ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Inline
cit Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
addParens [Inline]
ils)]
[Block]
_ -> [Block] -> Inline
Note ((Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNotes ([Block] -> [Block]) -> ([Block] -> [Block]) -> [Block] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> [Inline]) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
addParens ([Block] -> [Block]) -> [Block] -> [Block]
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 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) (Bool -> [Inline] -> [Inline]
addCommas ([Inline] -> Bool
needsPeriod [Inline]
zs) [Inline]
ils) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
[Inline] -> [Inline]
addParens [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]
addParens [Inline]
zs
addParens (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
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 Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
"(" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
[Inline] -> [Inline]
removeFinalPeriod [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
")"]
noteInParens Inline
x = [Inline
x]
addCommas :: Bool -> [Inline] -> [Inline]
addCommas = Bool -> Bool -> [Inline] -> [Inline]
addCommas' Bool
True
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 ([Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils)
= (if Bool
atBeginning then [Inline] -> [Inline]
forall a. a -> a
id else ([Text -> Inline
Str Text
"," , Inline
Space] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++)) ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$
(if Bool
needsPer then [Inline]
ils else [Inline] -> [Inline]
removeFinalPeriod [Inline]
ils) [Inline] -> [Inline] -> [Inline]
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 Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Bool -> [Inline] -> [Inline]
addCommas' Bool
False Bool
needsPer [Inline]
rest
deNote Inline
x = Inline
x
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 :: forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Lang)
bcp47LangToIETF Text
bcplang =
case Text -> Either String Lang
parseLang Text
bcplang of
Left String
_ -> 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 a. a -> m a
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 a. a -> m a
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
lang