{-# LANGUAGE OverloadedStrings #-}
-- | Process citations using the formatting instructions encoded
-- in a CSL stylesheet.  The library targets version 1.0.1 of the
-- CSL spec: https://docs.citationstyles.org/en/stable/specification.html
module Citeproc
       ( module Citeproc.Types
       , module Citeproc.Style
       , module Citeproc.Locale
       , citeproc
       , Result(..)
       ) where
import Data.Bifunctor (second)
import qualified Data.Text as T
import qualified Data.Set as Set
import Citeproc.Types
import Citeproc.Style
import Citeproc.Locale
import Citeproc.Eval

-- | Process a list of 'Citation's, producing formatted citations
-- and a bibliography according to the rules of a CSL 'Style'.
-- If a 'Lang' is specified, override the style's default locale.
-- To obtain a 'Style' from an XML stylesheet, use
-- 'parseStyle' from "Citeproc.Style".
citeproc :: CiteprocOutput a
         => CiteprocOptions    -- ^ Rendering options
         -> Style a            -- ^ Parsed CSL style
         -> Maybe Lang         -- ^ Overrides default locale for style
         -> [Reference a]      -- ^ List of references (bibliographic data)
         -> [Citation a]       -- ^ List of citations to process
         -> Result a
citeproc :: forall a.
CiteprocOutput a =>
CiteprocOptions
-> Style a
-> Maybe Lang
-> [Reference a]
-> [Citation a]
-> Result a
citeproc CiteprocOptions
opts Style a
style Maybe Lang
mblang [Reference a]
refs [Citation a]
citations =
  Result{ resultCitations :: [a]
resultCitations = [a]
rCitations
        , resultBibliography :: [(Text, a)]
resultBibliography = [(Text, a)]
rBibliography
        , resultWarnings :: [Text]
resultWarnings = [Text]
warnings forall a. [a] -> [a] -> [a]
++ [Text]
noPrintedFormWarnings }
 where
  rCitations :: [a]
rCitations = forall a b. (a -> b) -> [a] -> [b]
map ( a -> a
trimR
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => Locale -> a -> a
localizeQuotes Locale
locale
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
movePunct
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => CiteprocOptions -> Output a -> a
renderOutput CiteprocOptions
opts
                   ) [Output a]
citationOs
  rBibliography :: [(Text, a)]
rBibliography = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second
                         ( a -> a
trimR
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => Locale -> a -> a
localizeQuotes Locale
locale
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
movePunct
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => CiteprocOptions -> Output a -> a
renderOutput CiteprocOptions
opts{ linkCitations :: Bool
linkCitations = Bool
False } ))
                      [(Text, Output a)]
bibliographyOs
  locale :: Locale
locale = forall a. Maybe Lang -> Style a -> Locale
mergeLocales Maybe Lang
mblang Style a
style
  trimR :: a -> a
trimR = forall a. CiteprocOutput a => (Char -> Bool) -> a -> a
dropTextWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
' ')
  movePunct :: a -> a
movePunct = case Locale -> Maybe Bool
localePunctuationInQuote Locale
locale of
                Just Bool
True -> forall a. CiteprocOutput a => a -> a
movePunctuationInsideQuotes
                Maybe Bool
_         -> forall a. a -> a
id
  ([Output a]
citationOs, [(Text, Output a)]
bibliographyOs, [Text]
warnings) =
    forall a.
CiteprocOutput a =>
Style a
-> Maybe Lang
-> [Reference a]
-> [Citation a]
-> ([Output a], [(Text, Output a)], [Text])
evalStyle Style a
style Maybe Lang
mblang [Reference a]
refs [Citation a]
citations
  noPrintedFormWarnings :: [Text]
noPrintedFormWarnings = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
                           forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {a}. (Eq a, Monoid a) => Citation a -> a -> Set Text
npfCitation [Citation a]
citations [a]
rCitations forall a. [a] -> [a] -> [a]
++
                           forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}.
(Monoid a, IsString a, Ord a, Eq a, Semigroup a) =>
(a, a) -> Set a
npfBibentry [(Text, a)]
rBibliography
  npfBibentry :: (a, a) -> Set a
npfBibentry (a
ident, a
out) =
    if a
out forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty
       then forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ a
"Bibliography entry with no printed form: " forall a. Semigroup a => a -> a -> a
<>
                               a
ident
       else forall a. Monoid a => a
mempty
  npfCitation :: Citation a -> a -> Set Text
npfCitation Citation a
citation a
res =
    if a
res forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty
       then forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ Text
"Citation with no printed form: "  forall a. Semigroup a => a -> a -> a
<>
                                Text -> [Text] -> Text
T.intercalate Text
","
                                (forall a b. (a -> b) -> [a] -> [b]
map (ItemId -> Text
unItemId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CitationItem a -> ItemId
citationItemId)
                                  (forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation))
       else forall a. Monoid a => a
mempty