{-# 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 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
noPrintedFormWarnings }
 where
  rCitations :: [a]
rCitations = (Output a -> a) -> [Output a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ( a -> a
trimR
                   (a -> a) -> (Output a -> a) -> Output a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Locale -> a -> a
forall a. CiteprocOutput a => Locale -> a -> a
localizeQuotes Locale
locale
                   (a -> a) -> (Output a -> a) -> Output a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
movePunct
                   (a -> a) -> (Output a -> a) -> Output a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CiteprocOptions -> Output a -> a
forall a. CiteprocOutput a => CiteprocOptions -> Output a -> a
renderOutput CiteprocOptions
opts
                   ) [Output a]
citationOs
  rBibliography :: [(Text, a)]
rBibliography = ((Text, Output a) -> (Text, a))
-> [(Text, Output a)] -> [(Text, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Output a -> a) -> (Text, Output a) -> (Text, a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second
                         ( a -> a
trimR
                         (a -> a) -> (Output a -> a) -> Output a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Locale -> a -> a
forall a. CiteprocOutput a => Locale -> a -> a
localizeQuotes Locale
locale
                         (a -> a) -> (Output a -> a) -> Output a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
movePunct
                         (a -> a) -> (Output a -> a) -> Output a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CiteprocOptions -> Output a -> a
forall a. CiteprocOutput a => CiteprocOptions -> Output a -> a
renderOutput CiteprocOptions
opts{ linkCitations = False } ))
                      [(Text, Output a)]
bibliographyOs
  locale :: Locale
locale = Maybe Lang -> Style a -> Locale
forall a. Maybe Lang -> Style a -> Locale
mergeLocales Maybe Lang
mblang Style a
style
  trimR :: a -> a
trimR = (Char -> Bool) -> a -> a
forall a. CiteprocOutput a => (Char -> Bool) -> a -> a
dropTextWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
  movePunct :: a -> a
movePunct = case Locale -> Maybe Bool
localePunctuationInQuote Locale
locale of
                Just Bool
True -> a -> a
forall a. CiteprocOutput a => a -> a
movePunctuationInsideQuotes
                Maybe Bool
_         -> a -> a
forall a. a -> a
id
  ([Output a]
citationOs, [(Text, Output a)]
bibliographyOs, [Text]
warnings) =
    Style a
-> Maybe Lang
-> [Reference a]
-> [Citation a]
-> ([Output a], [(Text, Output a)], [Text])
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 = Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Set Text] -> Set Text
forall a. Monoid a => [a] -> a
mconcat ([Set Text] -> Set Text) -> [Set Text] -> Set Text
forall a b. (a -> b) -> a -> b
$
                           (Citation a -> a -> Set Text) -> [Citation a] -> [a] -> [Set Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Citation a -> a -> Set Text
forall {a} {a}. (Eq a, Monoid a) => Citation a -> a -> Set Text
npfCitation [Citation a]
citations [a]
rCitations [Set Text] -> [Set Text] -> [Set Text]
forall a. [a] -> [a] -> [a]
++
                           ((Text, a) -> Set Text) -> [(Text, a)] -> [Set Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, a) -> Set Text
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty
       then a -> Set a
forall a. a -> Set a
Set.singleton (a -> Set a) -> a -> Set a
forall a b. (a -> b) -> a -> b
$ a
"Bibliography entry with no printed form: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
                               a
ident
       else Set a
forall a. Monoid a => a
mempty
  npfCitation :: Citation a -> a -> Set Text
npfCitation Citation a
citation a
res =
    if a
res a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty
       then Text -> Set Text
forall a. a -> Set a
Set.singleton (Text -> Set Text) -> Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Text
"Citation with no printed form: "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                Text -> [Text] -> Text
T.intercalate Text
","
                                ((CitationItem a -> Text) -> [CitationItem a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId -> Text
unItemId (ItemId -> Text)
-> (CitationItem a -> ItemId) -> CitationItem a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId)
                                  (Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation))
       else Set Text
forall a. Monoid a => a
mempty