{-# LANGUAGE StrictData #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Citeproc.Eval
  ( evalStyle )
where
import Citeproc.Types
import Citeproc.Style (mergeLocales)
import qualified Citeproc.Unicode as Unicode
import Control.Monad.Trans.RWS.CPS
import Data.Containers.ListUtils (nubOrdOn, nubOrd)
import Safe (headMay, headDef, lastMay, initSafe, tailSafe, maximumMay)
import Data.Maybe
import Control.Monad (foldM, foldM_, zipWithM, when, unless)
import qualified Data.Map as M
import qualified Data.Set as Set
import Data.Coerce (coerce)
import Data.List (find, intersperse, sortBy, sortOn, groupBy, foldl', transpose,
                  sort, (\\))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Char (isSpace, isDigit, isUpper, isLower, isLetter,
                  ord, chr)
import Text.Printf (printf)
import Control.Applicative
import Data.Generics.Uniplate.Operations (universe, transform)

-- import Debug.Trace (trace)
-- traceShowIdLabeled :: Show a => String -> a -> a
-- traceShowIdLabeled label x =
--   trace (label ++ ": " ++ show x) x
-- import Text.Show.Pretty (ppShow)
-- ppTrace :: Show a => a -> a
-- ppTrace x = trace (ppShow x) x

data Context a =
  Context
  { forall a. Context a -> Locale
contextLocale              :: Locale
  , forall a. Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate             :: [SortKeyValue] -> [SortKeyValue] -> Ordering
  , forall a. Context a -> Maybe Abbreviations
contextAbbreviations       :: Maybe Abbreviations
  , forall a. Context a -> StyleOptions
contextStyleOptions        :: StyleOptions
  , forall a. Context a -> Maybe Text
contextLocator             :: Maybe Text
  , forall a. Context a -> Maybe Text
contextLabel               :: Maybe Text
  , forall a. Context a -> [Position]
contextPosition            :: [Position]
  , forall a. Context a -> Bool
contextInSubstitute        :: Bool
  , forall a. Context a -> Bool
contextInSortKey           :: Bool
  , forall a. Context a -> Bool
contextInBibliography      :: Bool
  , forall a. Context a -> Maybe NamesFormat
contextSubstituteNamesForm :: Maybe NamesFormat
  }

-- used internally for group elements, which
-- are skipped if (a) the group calls a variable
-- but (b) all of the variables called are empty.
data VarCount =
  VarCount
  { VarCount -> Int
variablesAccessed :: Int
  , VarCount -> Int
variablesNonempty :: Int
  } deriving (Int -> VarCount -> ShowS
[VarCount] -> ShowS
VarCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarCount] -> ShowS
$cshowList :: [VarCount] -> ShowS
show :: VarCount -> String
$cshow :: VarCount -> String
showsPrec :: Int -> VarCount -> ShowS
$cshowsPrec :: Int -> VarCount -> ShowS
Show)

data EvalState a =
  EvalState
  { forall a. EvalState a -> VarCount
stateVarCount       :: VarCount
  , forall a.
EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap   :: M.Map ItemId (Int, Maybe Int, Int,
                                          Bool, Maybe Text, Maybe Text)
                        -- (citegroup, noteNum, posInGroup,
                        --      aloneInCitation, label, locator)
  , forall a. EvalState a -> Map Int (Set ItemId)
stateNoteMap        :: M.Map Int (Set.Set ItemId) -- ids cited in note
  , forall a. EvalState a -> ReferenceMap a
stateRefMap         :: ReferenceMap a
  , forall a. EvalState a -> Reference a
stateReference      :: Reference a
  , forall a. EvalState a -> Bool
stateUsedYearSuffix :: Bool
  , forall a. EvalState a -> Bool
stateUsedIdentifier :: Bool
  -- ^ tracks whether an identifier (DOI,PMCID,PMID,URL) has yet been used
  , forall a. EvalState a -> Bool
stateUsedTitle      :: Bool
  -- ^ tracks whether the item title has yet been used
  } deriving (Int -> EvalState a -> ShowS
forall a. Show a => Int -> EvalState a -> ShowS
forall a. Show a => [EvalState a] -> ShowS
forall a. Show a => EvalState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalState a] -> ShowS
$cshowList :: forall a. Show a => [EvalState a] -> ShowS
show :: EvalState a -> String
$cshow :: forall a. Show a => EvalState a -> String
showsPrec :: Int -> EvalState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EvalState a -> ShowS
Show)


type Eval a = RWS (Context a) (Set.Set Text) (EvalState a)

updateVarCount :: Int -> Int -> Eval a ()
updateVarCount :: forall a. Int -> Int -> Eval a ()
updateVarCount Int
total' Int
nonempty' =
  forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
    let VarCount{ variablesAccessed :: VarCount -> Int
variablesAccessed = Int
total
                , variablesNonempty :: VarCount -> Int
variablesNonempty = Int
nonempty } = forall a. EvalState a -> VarCount
stateVarCount EvalState a
st
     in EvalState a
st{ stateVarCount :: VarCount
stateVarCount =
              VarCount { variablesAccessed :: Int
variablesAccessed = Int
total forall a. Num a => a -> a -> a
+ Int
total',
                         variablesNonempty :: Int
variablesNonempty = Int
nonempty forall a. Num a => a -> a -> a
+ Int
nonempty' } }

evalStyle  :: CiteprocOutput a
           => Style a          -- ^ Parsed CSL style.
           -> Maybe Lang       -- ^ Override style default locale.
           -> [Reference a]    -- ^ List of references (bibliographic data).
           -> [Citation a]     -- ^ List of citations.
           -> ([Output a], [(Text, Output a)], [Text])
                       -- ^ (citations, (id, bibentry) pairs, warnings)
evalStyle :: 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 =
  ([Output a]
citationOs, [(Text, Output a)]
bibliographyOs, forall a. Set a -> [a]
Set.toList Set Text
warnings)
 where
  refs'' :: [Reference a]
refs'' = [Reference a]
refs' forall a. [a] -> [a] -> [a]
++ forall a. [Citation a] -> [Reference a]
extractItemData [Citation a]
citations
  ([Reference a]
refs, ReferenceMap a
refmap) = forall a. [Reference a] -> ([Reference a], ReferenceMap a)
makeReferenceMap [Reference a]
refs''

  (([Output a]
citationOs, [(Text, Output a)]
bibliographyOs), Set Text
warnings) = forall w r s a. Monoid w => RWS r w s a -> r -> s -> (a, w)
evalRWS RWST
  (Context a)
  (Set Text)
  (EvalState a)
  Identity
  ([Output a], [(Text, Output a)])
go
     Context
      { contextLocale :: Locale
contextLocale              = forall a. Maybe Lang -> Style a -> Locale
mergeLocales Maybe Lang
mblang Style a
style
      , contextCollate :: [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate             = \[SortKeyValue]
xs [SortKeyValue]
ys ->
                                       (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues (Maybe Lang -> Text -> Text -> Ordering
Unicode.comp Maybe Lang
mblang)
                                       [SortKeyValue]
xs [SortKeyValue]
ys
      , contextAbbreviations :: Maybe Abbreviations
contextAbbreviations       = forall a. Style a -> Maybe Abbreviations
styleAbbreviations Style a
style
      , contextStyleOptions :: StyleOptions
contextStyleOptions        = forall a. Style a -> StyleOptions
styleOptions Style a
style
      , contextLocator :: Maybe Text
contextLocator             = forall a. Maybe a
Nothing
      , contextLabel :: Maybe Text
contextLabel               = forall a. Maybe a
Nothing
      , contextPosition :: [Position]
contextPosition            = []
      , contextInSubstitute :: Bool
contextInSubstitute        = Bool
False
      , contextInSortKey :: Bool
contextInSortKey           = Bool
False
      , contextInBibliography :: Bool
contextInBibliography      = Bool
False
      , contextSubstituteNamesForm :: Maybe NamesFormat
contextSubstituteNamesForm = forall a. Maybe a
Nothing
      }
      EvalState
      { stateVarCount :: VarCount
stateVarCount = Int -> Int -> VarCount
VarCount Int
0 Int
0
      , stateLastCitedMap :: Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap = forall a. Monoid a => a
mempty
      , stateNoteMap :: Map Int (Set ItemId)
stateNoteMap = forall a. Monoid a => a
mempty
      , stateRefMap :: ReferenceMap a
stateRefMap = ReferenceMap a
refmap
      , stateReference :: Reference a
stateReference = forall a.
ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
Reference forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Maybe a
Nothing forall a. Monoid a => a
mempty
      , stateUsedYearSuffix :: Bool
stateUsedYearSuffix = Bool
False
      , stateUsedIdentifier :: Bool
stateUsedIdentifier = Bool
False
      , stateUsedTitle :: Bool
stateUsedTitle = Bool
False
      }

  assignCitationNumbers :: [ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers [ItemId]
sortedIds =
    forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
              EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                     (\Map ItemId (Reference a)
m (ItemId
citeId, Int
num) ->
                         forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\Reference a
ref ->
                           Reference a
ref{ referenceVariables :: Map Variable (Val a)
referenceVariables =
                                 forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Variable
"citation-number"
                                    (forall a. Int -> Val a
NumVal Int
num) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Variable
"citation-key"
                                     (forall a. Text -> Val a
TextVal (ItemId -> Text
unItemId ItemId
citeId)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (forall {a}. a -> Maybe a -> Maybe a
addIfMissing (forall a. Reference a -> Val a
citationLabel Reference a
ref))
                                    Variable
"citation-label"
                                 forall a b. (a -> b) -> a -> b
$ forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference a
ref
                              }) ItemId
citeId Map ItemId (Reference a)
m)
                     (forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st))
                     (forall a b. [a] -> [b] -> [(a, b)]
zip [ItemId]
sortedIds [Int
1..]) }

  addIfMissing :: a -> Maybe a -> Maybe a
addIfMissing a
x Maybe a
Nothing  = forall a. a -> Maybe a
Just a
x
  addIfMissing a
_ (Just a
x) = forall a. a -> Maybe a
Just a
x

  go :: RWST
  (Context a)
  (Set Text)
  (EvalState a)
  Identity
  ([Output a], [(Text, Output a)])
go = do
      -- list of citationItemIds that are actually cited
      let citationOrder :: Map ItemId Int
citationOrder = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip
            (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map forall a. CitationItem a -> ItemId
citationItemId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Citation a -> [CitationItem a]
citationItems) [Citation a]
citations)
            [(Int
1 :: Int)..]
      let citeIds :: Set ItemId
citeIds = forall k a. Map k a -> Set k
M.keysSet Map ItemId Int
citationOrder
      let sortedCiteIds :: [ItemId]
sortedCiteIds = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn
              (forall a. a -> Maybe a -> a
fromMaybe forall a. Bounded a => a
maxBound forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map ItemId Int
citationOrder))
              (forall a b. (a -> b) -> [a] -> [b]
map forall a. Reference a -> ItemId
referenceId [Reference a]
refs)
      let layoutOpts :: LayoutOptions
layoutOpts = forall a. Layout a -> LayoutOptions
layoutOptions forall a b. (a -> b) -> a -> b
$ forall a. Style a -> Layout a
styleCitation Style a
style
      let mbcgDelim :: Maybe Text
mbcgDelim =
            case StyleOptions -> Maybe Text
styleCiteGroupDelimiter (forall a. Style a -> StyleOptions
styleOptions Style a
style) of
              Just Text
x -> forall a. a -> Maybe a
Just Text
x
              Maybe Text
Nothing
                -- grouping is activated whenever there is
                -- collapsing; this is the default
                -- cite-group-delimiter
                | forall a. Maybe a -> Bool
isJust (LayoutOptions -> Maybe Collapsing
layoutCollapse LayoutOptions
layoutOpts) -> forall a. a -> Maybe a
Just Text
", "
                | Bool
otherwise -> forall a. Maybe a
Nothing

      forall {m :: * -> *} {r} {w} {a}.
Monad m =>
[ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers [ItemId]
sortedCiteIds
      -- sorting of bibliography, insertion of citation-number
      [SortKeyValue] -> [SortKeyValue] -> Ordering
collate <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate

      ([Citation a]
bibCitations, Map ItemId [SortKeyValue]
bibSortKeyMap) <-
        case forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
          Maybe (Layout a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Monoid a => a
mempty)
          Just Layout a
biblayout -> do
            Map ItemId [SortKeyValue]
bibSortKeyMap <- forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                      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
                          ((\ItemId
citeId ->
                             (ItemId
citeId,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
CiteprocOutput a =>
Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys Layout a
biblayout ItemId
citeId)
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reference a -> ItemId
referenceId)
                          [Reference a]
refs
            let sortedIds :: [ItemId]
sortedIds =
                  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Layout a -> [SortKey a]
layoutSortKeys Layout a
biblayout)
                     then [ItemId]
sortedCiteIds
                     else forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
                       (\ItemId
x ItemId
y -> [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
                                  (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ItemId
x Map ItemId [SortKeyValue]
bibSortKeyMap)
                                  (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ItemId
y Map ItemId [SortKeyValue]
bibSortKeyMap))
                            (forall a b. (a -> b) -> [a] -> [b]
map forall a. Reference a -> ItemId
referenceId [Reference a]
refs)
            forall {m :: * -> *} {r} {w} {a}.
Monad m =>
[ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers forall a b. (a -> b) -> a -> b
$
              case forall a. Layout a -> [SortKey a]
layoutSortKeys Layout a
biblayout of
                (SortKeyVariable SortDirection
Descending Variable
"citation-number":[SortKey a]
_)
                  -> forall a. [a] -> [a]
reverse [ItemId]
sortedIds
                (SortKeyMacro SortDirection
Descending
                  (Element (ENumber Variable
"citation-number" NumberForm
_) Formatting
_:[Element a]
_) : [SortKey a]
_)
                  -> forall a. [a] -> [a]
reverse [ItemId]
sortedIds
                (SortKeyMacro SortDirection
Descending
                  (Element (EText (TextVariable VariableForm
_ Variable
"citation-number")) Formatting
_:[Element a]
_): [SortKey a]
_)
                  -> forall a. [a] -> [a]
reverse [ItemId]
sortedIds
                [SortKey a]
_ -> [ItemId]
sortedIds
            let bibCitations :: [Citation a]
bibCitations = forall a b. (a -> b) -> [a] -> [b]
map (\ItemId
ident ->
                  forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ItemId -> Text
unItemId ItemId
ident) forall a. Maybe a
Nothing
                   [forall a.
ItemId
-> Maybe Text
-> Maybe Text
-> CitationItemType
-> Maybe a
-> Maybe a
-> Maybe (Reference a)
-> CitationItem a
CitationItem ItemId
ident forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                      CitationItemType
NormalCite forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing]) [ItemId]
sortedIds
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall {a}. [Citation a]
bibCitations, Map ItemId [SortKeyValue]
bibSortKeyMap)
      -- styling of citations
      Map ItemId [SortKeyValue]
sortKeyMap <-
        forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Map ItemId [SortKeyValue]
m ItemId
citeId -> do
                  [SortKeyValue]
sk <- forall a.
CiteprocOutput a =>
Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys (forall a. Style a -> Layout a
styleCitation Style a
style) ItemId
citeId
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ItemId
citeId [SortKeyValue]
sk Map ItemId [SortKeyValue]
m)
               forall k a. Map k a
M.empty
               Set ItemId
citeIds
      -- We can't just sort all the citations, because
      -- this can make a hash out of prefixes and suffixes.
      -- See e.g. pandoc-citeproc issue #292.
      -- we need to first break into groups so that any
      -- suffix ends a group and any prefix begins a group;
      -- then sort the groups; then combine again:
      let canGroup :: CitationItem a -> CitationItem a -> Bool
canGroup CitationItem a
i1 CitationItem a
i2
           =   forall a. Maybe a -> Bool
isNothing (forall a. CitationItem a -> Maybe a
citationItemSuffix CitationItem a
i1) Bool -> Bool -> Bool
&&
               forall a. Maybe a -> Bool
isNothing (forall a. CitationItem a -> Maybe a
citationItemPrefix CitationItem a
i2)
      let sortCitationItems :: Citation a -> Citation a
sortCitationItems Citation a
citation' =
            Citation a
citation'{ citationItems :: [CitationItem a]
citationItems =
                          forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                           (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
                             (\CitationItem a
item1 CitationItem a
item2 ->
                               [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
                                (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
                                   (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item1) Map ItemId [SortKeyValue]
sortKeyMap)
                                (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
                                   (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item2) Map ItemId [SortKeyValue]
sortKeyMap)))
                        forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy forall {a} {a}. CitationItem a -> CitationItem a -> Bool
canGroup
                        forall a b. (a -> b) -> a -> b
$ forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation' }
      let citCitations :: [Citation a]
citCitations = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Citation a -> Citation a
sortCitationItems [Citation a]
citations
      [Output a]
cs <- forall a.
CiteprocOutput a =>
Style a
-> Map ItemId [SortKeyValue] -> [Citation a] -> Eval a [Output a]
disambiguateCitations Style a
style Map ItemId [SortKeyValue]
bibSortKeyMap [Citation a]
citCitations
      let cs' :: [Output a]
cs' = case Maybe Text
mbcgDelim of
                   Maybe Text
Nothing -> [Output a]
cs
                   Just Text
citeGroupDelim -> forall a b. (a -> b) -> [a] -> [b]
map
                      (forall a.
CiteprocOutput a =>
Text
-> Maybe Text
-> Maybe Text
-> Maybe Collapsing
-> Output a
-> Output a
groupAndCollapseCitations Text
citeGroupDelim
                       (LayoutOptions -> Maybe Text
layoutYearSuffixDelimiter LayoutOptions
layoutOpts)
                       (LayoutOptions -> Maybe Text
layoutAfterCollapseDelimiter LayoutOptions
layoutOpts)
                       (LayoutOptions -> Maybe Collapsing
layoutCollapse LayoutOptions
layoutOpts))
                      [Output a]
cs

      let removeIfEqual :: Output a -> Output a -> Output a
removeIfEqual Output a
x Output a
y
           | Output a
x forall a. Eq a => a -> a -> Bool
== Output a
y    = forall a. Output a
NullOutput
           | Bool
otherwise = Output a
y
      let removeNamesIfSuppressAuthor :: Output a -> Output a
removeNamesIfSuppressAuthor
           (Tagged (TagItem CitationItemType
SuppressAuthor ItemId
cid') Output a
x)
             = let y :: Output a
y = forall a. Output a -> Output a
getAuthors Output a
x
                in forall a. Tag -> Output a -> Output a
Tagged (CitationItemType -> ItemId -> Tag
TagItem CitationItemType
SuppressAuthor ItemId
cid')
                     (forall on. Uniplate on => (on -> on) -> on -> on
transform (forall {a}. Eq a => Output a -> Output a -> Output a
removeIfEqual Output a
y) Output a
x)
          removeNamesIfSuppressAuthor Output a
x = Output a
x

      -- we need to do this after disambiguation and collapsing
      let handleSuppressAuthors :: Output a -> Output a
handleSuppressAuthors = forall on. Uniplate on => (on -> on) -> on -> on
transform forall {a}. Eq a => Output a -> Output a
removeNamesIfSuppressAuthor

      let isNoteCitation :: Bool
isNoteCitation = StyleOptions -> Bool
styleIsNoteStyle (forall a. Style a -> StyleOptions
styleOptions Style a
style)

      -- if we have an author-only citation at the beginning
      -- separate it out:
      let handleAuthorOnly :: Output a -> Output a
handleAuthorOnly Output a
formattedCit =
            case Output a
formattedCit of
              Formatted Formatting
f
                (x :: Output a
x@(Tagged (TagItem CitationItemType
AuthorOnly ItemId
_) Output a
_):[Output a]
xs)
                  | Bool
isNoteCitation
                    -> forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty
                        (Output a
x forall a. a -> [a] -> [a]
: [forall a. Output a -> Output a
InNote (forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
xs) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs)])
                  | Bool
otherwise
                    -> forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty
                        (Output a
x forall a. a -> [a] -> [a]
:
                         if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs
                            then []
                            else [forall a. a -> Output a
Literal (forall a. CiteprocOutput a => Text -> a
fromText Text
" "),
                                  forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
xs])
              Formatted Formatting
f
                (Formatted Formatting
f'
                  (x :: Output a
x@(Tagged (TagItem CitationItemType
AuthorOnly ItemId
_) Output a
_):[Output a]
xs) : [Output a]
ys)
                  | Bool
isNoteCitation
                    -> forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty
                        (Output a
x forall a. a -> [a] -> [a]
:
                         if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
ys
                            then []
                            else [forall a. Output a -> Output a
InNote (forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f
                                           (forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f' [Output a]
xs forall a. a -> [a] -> [a]
: [Output a]
ys))])
                  | Bool
otherwise
                    -> forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty
                        (Output a
x forall a. a -> [a] -> [a]
:
                         if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
ys
                            then []
                            else [forall a. a -> Output a
Literal (forall a. CiteprocOutput a => Text -> a
fromText Text
" "),
                                  forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f (forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f' [Output a]
xs forall a. a -> [a] -> [a]
: [Output a]
ys)])
              Output a
_ | Bool
isNoteCitation -> forall a. Output a -> Output a
InNote Output a
formattedCit
                | Bool
otherwise      -> Output a
formattedCit

      let cs'' :: [Output a]
cs'' = forall a b. (a -> b) -> [a] -> [b]
map (Output a -> Output a
handleSuppressAuthors forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. CiteprocOutput a => Output a -> Output a
handleAuthorOnly) [Output a]
cs'

      -- styling of bibliography (this needs to go here to take account
      -- of year suffixes added in disambiguation)
      [Output a]
bs <- case forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
               Just Layout a
biblayout
                 -> forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
local (\Context a
context ->
                             Context a
context{ contextInBibliography :: Bool
contextInBibliography = Bool
True }) forall a b. (a -> b) -> a -> b
$
                    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
CiteprocOutput a =>
Layout a -> (Int, Citation a) -> Eval a (Output a)
evalLayout Layout a
biblayout) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Citation a]
bibCitations)
                    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Output a]
bs ->
                      case StyleOptions -> Maybe SubsequentAuthorSubstitute
styleSubsequentAuthorSubstitute
                            (forall a. Style a -> StyleOptions
styleOptions Style a
style) of
                        Maybe SubsequentAuthorSubstitute
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
bs
                        Just SubsequentAuthorSubstitute
subs -> forall a.
CiteprocOutput a =>
SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
subsequentAuthorSubstitutes SubsequentAuthorSubstitute
subs [Output a]
bs
               Maybe (Layout a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
      forall (m :: * -> *) a. Monad m => a -> m a
return ([Output a]
cs'', case forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
                     Maybe (Layout a)
Nothing -> []
                     Just Layout a
_  ->
                       forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Citation a -> Maybe Text
citationId) [Citation a]
bibCitations) [Output a]
bs)

extractItemData :: [Citation a] -> [Reference a]
extractItemData :: forall a. [Citation a] -> [Reference a]
extractItemData = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. CitationItem a -> Maybe (Reference a)
citationItemData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Citation a -> [CitationItem a]
citationItems)

subsequentAuthorSubstitutes :: CiteprocOutput a
                            => SubsequentAuthorSubstitute
                            -> [Output a]
                            -> Eval a [Output a]
subsequentAuthorSubstitutes :: forall a.
CiteprocOutput a =>
SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
subsequentAuthorSubstitutes (SubsequentAuthorSubstitute Text
t SubsequentAuthorSubstituteRule
rule) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. CiteprocOutput a => [Output a] -> [Output a]
groupCitesByNames
 where
  groupCitesByNames :: [Output a] -> [Output a]
groupCitesByNames [] = []
  groupCitesByNames (Output a
x:[Output a]
xs) =
    let xnames :: ([Name], Output a)
xnames = forall a. a -> Maybe a -> a
fromMaybe ([],forall a. Output a
NullOutput) forall a b. (a -> b) -> a -> b
$ forall {a}. Output a -> Maybe ([Name], Output a)
getNames Output a
x
        samenames :: [Output a]
samenames = forall a.
CiteprocOutput a =>
SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
rule (forall a. CiteprocOutput a => Text -> a
fromText Text
t) ([Name], Output a)
xnames [Output a]
xs
        rest :: [Output a]
rest = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
samenames) [Output a]
xs
    in  (Output a
x forall a. a -> [a] -> [a]
: [Output a]
samenames) forall a. [a] -> [a] -> [a]
++ [Output a] -> [Output a]
groupCitesByNames [Output a]
rest
  getNames :: Output a -> Maybe ([Name], Output a)
getNames (Formatted Formatting
_ (Output a
x:[Output a]
_)) =
    case [([Name]
ns,Output a
r) | (Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
r) <- forall on. Uniplate on => on -> [on]
universe Output a
x] of
      (([Name]
ns,Output a
r) : [([Name], Output a)]
_) -> forall a. a -> Maybe a
Just ([Name]
ns,Output a
r)
      []           -> forall a. Maybe a
Nothing
  getNames Output a
_ = forall a. Maybe a
Nothing

replaceMatch :: CiteprocOutput a
             => SubsequentAuthorSubstituteRule
             -> a
             -> ([Name], Output a)
             -> [Output a]
             -> [Output a]
replaceMatch :: forall a.
CiteprocOutput a =>
SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
_ a
_ ([Name], Output a)
_ [] = []
replaceMatch SubsequentAuthorSubstituteRule
rule a
replacement ([Name]
names, Output a
raw) (Output a
z:[Output a]
zs) =
  case Output a -> Maybe (Output a)
go Output a
z of
    Maybe (Output a)
Nothing -> []
    Just Output a
z' -> Output a
z' forall a. a -> [a] -> [a]
: forall a.
CiteprocOutput a =>
SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
rule a
replacement ([Name]
names, Output a
raw) [Output a]
zs
 where
  go :: Output a -> Maybe (Output a)
go (Tagged t :: Tag
t@TagItem{} Output a
y) =
    forall a. Tag -> Output a -> Output a
Tagged Tag
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output a -> Maybe (Output a)
go Output a
y
  go (Formatted Formatting
f (Output a
y:[Output a]
ys)) =
    forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: [Output a]
ys) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output a -> Maybe (Output a)
go Output a
y
  go y :: Output a
y@(Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
r) =
    case (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names then SubsequentAuthorSubstituteRule
CompleteAll else SubsequentAuthorSubstituteRule
rule) of
        SubsequentAuthorSubstituteRule
CompleteAll ->
          if [Name]
ns forall a. Eq a => a -> a -> Bool
== [Name]
names Bool -> Bool -> Bool
&& (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) Bool -> Bool -> Bool
|| Output a
r forall a. Eq a => a -> a -> Bool
== Output a
raw)
             then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Output a -> Output a
replaceAll Output a
y
             else forall a. Maybe a
Nothing
        SubsequentAuthorSubstituteRule
CompleteEach ->
          if [Name]
ns forall a. Eq a => a -> a -> Bool
== [Name]
names
             then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
replaceEach Output a
y
             else forall a. Maybe a
Nothing
        SubsequentAuthorSubstituteRule
PartialEach ->
          case forall {a} {a}. (Eq a, Num a) => [a] -> [a] -> a
numberOfMatches [Name]
ns [Name]
names of
            Int
num | Int
num forall a. Ord a => a -> a -> Bool
>= Int
1 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall on. Uniplate on => (on -> on) -> on -> on
transform (Int -> Output a -> Output a
replaceFirst Int
num) Output a
y
            Int
_ -> forall a. Maybe a
Nothing
        SubsequentAuthorSubstituteRule
PartialFirst ->
          case forall {a} {a}. (Eq a, Num a) => [a] -> [a] -> a
numberOfMatches [Name]
ns [Name]
names of
            Int
num | Int
num forall a. Ord a => a -> a -> Bool
>= (Int
1 :: Int) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall on. Uniplate on => (on -> on) -> on -> on
transform (Int -> Output a -> Output a
replaceFirst Int
1) Output a
y
            Int
_ -> forall a. Maybe a
Nothing
  go Output a
_ = forall a. Maybe a
Nothing
  replaceAll :: Output a -> Output a
replaceAll (Tagged (TagNames Variable
t' NamesFormat
nf [Name]
ns') Output a
x)
     = forall a. Tag -> Output a -> Output a
Tagged (Variable -> NamesFormat -> [Name] -> Tag
TagNames Variable
t' NamesFormat
nf [Name]
ns') forall a b. (a -> b) -> a -> b
$
       -- removeName will leave label "ed."
       -- which we want, but it will also leave the substituted
       -- title when there is no name, which we do not want.
       -- So, if ns' is null, then we just remove everything.
       if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ns'
          then forall a. a -> Output a
Literal a
replacement
          else
            case forall on. Uniplate on => (on -> on) -> on -> on
transform forall a. Output a -> Output a
removeName Output a
x of
              Formatted Formatting
f' [Output a]
xs -> forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f' (forall a. a -> Output a
Literal a
replacement forall a. a -> [a] -> [a]
: [Output a]
xs)
              Output a
_               -> forall a. a -> Output a
Literal a
replacement
  replaceAll Output a
x = Output a
x
  removeName :: Output a -> Output a
removeName (Tagged (TagName Name
_) Output a
_) = forall a. Output a
NullOutput
  removeName Output a
x = Output a
x
  replaceEach :: Output a -> Output a
replaceEach (Tagged (TagName Name
n) Output a
_)
    | Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
names
     = forall a. Tag -> Output a -> Output a
Tagged (Name -> Tag
TagName Name
n) (forall a. a -> Output a
Literal a
replacement)
  replaceEach Output a
x = Output a
x
  replaceFirst :: Int -> Output a -> Output a
replaceFirst Int
num x :: Output a
x@(Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns') Output a
_)
    = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall on. Uniplate on => (on -> on) -> on -> on
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Output a -> Output a
replaceName) Output a
x forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
num [Name]
ns'
  replaceFirst Int
_num Output a
x = Output a
x
  replaceName :: Name -> Output a -> Output a
replaceName Name
name (Tagged (TagName Name
n) Output a
_)
    | Name
n forall a. Eq a => a -> a -> Bool
== Name
name = forall a. Tag -> Output a -> Output a
Tagged (Name -> Tag
TagName Name
n) (forall a. a -> Output a
Literal a
replacement)
  replaceName Name
_ Output a
x = Output a
x
  numberOfMatches :: [a] -> [a] -> a
numberOfMatches (a
a:[a]
as) (a
b:[a]
bs)
    | a
a forall a. Eq a => a -> a -> Bool
== a
b    = a
1 forall a. Num a => a -> a -> a
+ [a] -> [a] -> a
numberOfMatches [a]
as [a]
bs
    | Bool
otherwise = a
0
  numberOfMatches [a]
_ [a]
_ = a
0

--
-- Disambiguation
--

data DisambData =
  DisambData
  { DisambData -> ItemId
ddItem       :: ItemId
  , DisambData -> [Name]
ddNames      :: [Name]
  , DisambData -> [Date]
ddDates      :: [Date]
  , DisambData -> Text
ddRendered   :: Text
  } deriving (DisambData -> DisambData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisambData -> DisambData -> Bool
$c/= :: DisambData -> DisambData -> Bool
== :: DisambData -> DisambData -> Bool
$c== :: DisambData -> DisambData -> Bool
Eq, Eq DisambData
DisambData -> DisambData -> Bool
DisambData -> DisambData -> Ordering
DisambData -> DisambData -> DisambData
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 :: DisambData -> DisambData -> DisambData
$cmin :: DisambData -> DisambData -> DisambData
max :: DisambData -> DisambData -> DisambData
$cmax :: DisambData -> DisambData -> DisambData
>= :: DisambData -> DisambData -> Bool
$c>= :: DisambData -> DisambData -> Bool
> :: DisambData -> DisambData -> Bool
$c> :: DisambData -> DisambData -> Bool
<= :: DisambData -> DisambData -> Bool
$c<= :: DisambData -> DisambData -> Bool
< :: DisambData -> DisambData -> Bool
$c< :: DisambData -> DisambData -> Bool
compare :: DisambData -> DisambData -> Ordering
$ccompare :: DisambData -> DisambData -> Ordering
Ord, Int -> DisambData -> ShowS
[DisambData] -> ShowS
DisambData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisambData] -> ShowS
$cshowList :: [DisambData] -> ShowS
show :: DisambData -> String
$cshow :: DisambData -> String
showsPrec :: Int -> DisambData -> ShowS
$cshowsPrec :: Int -> DisambData -> ShowS
Show)

disambiguateCitations :: forall a . CiteprocOutput a
                      => Style a
                      -> M.Map ItemId [SortKeyValue]
                      -> [Citation a]
                      -> Eval a [Output a]
disambiguateCitations :: forall a.
CiteprocOutput a =>
Style a
-> Map ItemId [SortKeyValue] -> [Citation a] -> Eval a [Output a]
disambiguateCitations Style a
style Map ItemId [SortKeyValue]
bibSortKeyMap [Citation a]
citations = do
  Map ItemId (Reference a)
refs <- forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> ReferenceMap a
stateRefMap
  let refIds :: [ItemId]
refIds = forall k a. Map k a -> [k]
M.keys Map ItemId (Reference a)
refs
  let ghostItems :: [ItemId]
ghostItems = [ ItemId
ident
                   | ItemId
ident <- [ItemId]
refIds
                   ]
                   -- we add additional references for EVERY citation,
                   -- even those we have already, to handle cases like #116

  -- for purposes of disambiguation, we remove prefixes and
  -- suffixes and locators, and we convert author-in-text to normal citation.
  let removeAffix :: CitationItem a -> CitationItem a
removeAffix CitationItem a
item = CitationItem a
item{ citationItemLabel :: Maybe Text
citationItemLabel = forall a. Maybe a
Nothing
                             , citationItemLocator :: Maybe Text
citationItemLocator = forall a. Maybe a
Nothing
                             , citationItemPrefix :: Maybe a
citationItemPrefix = forall a. Maybe a
Nothing
                             , citationItemSuffix :: Maybe a
citationItemSuffix = forall a. Maybe a
Nothing }
  let cleanCitation :: Citation a -> Citation a
cleanCitation (Citation Maybe Text
a Maybe Int
b (CitationItem a
i1:CitationItem a
i2:[CitationItem a]
is))
       | forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
i1 forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly
       , forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
i2 forall a. Eq a => a -> a -> Bool
== CitationItemType
SuppressAuthor
        = forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation Maybe Text
a Maybe Int
b
            (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. CitationItem a -> CitationItem a
removeAffix (CitationItem a
i2{ citationItemType :: CitationItemType
citationItemType = CitationItemType
NormalCite }forall a. a -> [a] -> [a]
:[CitationItem a]
is))
      cleanCitation (Citation Maybe Text
a Maybe Int
b [CitationItem a]
is)
        = forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation Maybe Text
a Maybe Int
b (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. CitationItem a -> CitationItem a
removeAffix [CitationItem a]
is)

  -- note that citations must go first, and order must be preserved:
  -- we use a "basic item" that strips off prefixes, suffixes, locators
  let citations' :: [Citation a]
citations' = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Citation a -> Citation a
cleanCitation [Citation a]
citations forall a. [a] -> [a] -> [a]
++
                   [forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a b. (a -> b) -> [a] -> [b]
map forall a. ItemId -> CitationItem a
basicItem [ItemId]
ghostItems)]
  [Output a]
allCites <- [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
citations'

  Maybe Lang
mblang <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Maybe Lang
localeLanguage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> Locale
contextLocale)
  StyleOptions
styleOpts <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> StyleOptions
contextStyleOptions
  let strategy :: DisambiguationStrategy
strategy = StyleOptions -> DisambiguationStrategy
styleDisambiguation StyleOptions
styleOpts
  let allNameGroups :: [[Name]]
allNameGroups = [[Name]
ns | Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
_ <-
                              forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall on. Uniplate on => on -> [on]
universe [Output a]
allCites]
  let allNames :: [Name]
allNames = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
allNameGroups
  let primaryNames :: [Name]
primaryNames = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
take Int
1) [[Name]]
allNameGroups
  [Output a]
allCites' <-
    case DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy of
         Maybe GivenNameDisambiguationRule
Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
allCites
         Just GivenNameDisambiguationRule
ByCite -> forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
allCites -- do this later
         Just GivenNameDisambiguationRule
rule   -> do -- disambiguate names, not just citations
           let relevantNames :: [Name]
relevantNames =
                 case GivenNameDisambiguationRule
rule of
                   GivenNameDisambiguationRule
PrimaryNameWithInitials -> [Name]
primaryNames
                   GivenNameDisambiguationRule
PrimaryName -> [Name]
primaryNames
                   GivenNameDisambiguationRule
_ -> [Name]
allNames
           let familyNames :: [Text]
familyNames = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Name -> Maybe Text
nameFamily [Name]
relevantNames
           let grps :: [[Name]]
grps = forall a b. (a -> b) -> [a] -> [b]
map (\Text
name ->
                             [Name
v | Name
v <- [Name]
relevantNames
                                , Name -> Maybe Text
nameFamily Name
v forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
name])
                          [Text]
familyNames
           let toHint :: [Name] -> Name -> Maybe NameHints
toHint [Name]
names Name
name =
                  if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Lang -> Name -> Name -> Bool
initialsMatch Maybe Lang
mblang Name
name) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Name
name) [Name]
names)
                     then
                       case GivenNameDisambiguationRule
rule of
                         GivenNameDisambiguationRule
AllNamesWithInitials    -> forall a. Maybe a
Nothing
                         GivenNameDisambiguationRule
PrimaryNameWithInitials -> forall a. Maybe a
Nothing
                         GivenNameDisambiguationRule
PrimaryName             -> forall a. a -> Maybe a
Just NameHints
AddGivenNameIfPrimary
                         GivenNameDisambiguationRule
_                       -> forall a. a -> Maybe a
Just NameHints
AddGivenName
                     else
                       case GivenNameDisambiguationRule
rule of
                         GivenNameDisambiguationRule
PrimaryNameWithInitials -> forall a. a -> Maybe a
Just NameHints
AddInitialsIfPrimary
                         GivenNameDisambiguationRule
PrimaryName             -> forall a. a -> Maybe a
Just NameHints
AddInitialsIfPrimary
                         GivenNameDisambiguationRule
_                       -> forall a. a -> Maybe a
Just NameHints
AddInitials
           let namesMap :: Map Name NameHints
namesMap = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map
                  (\[Name]
names -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
names forall a. Ord a => a -> a -> Bool
> Int
1
                                 then forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                                    (\Name
name ->
                                        case [Name] -> Name -> Maybe NameHints
toHint [Name]
names Name
name of
                                          Just NameHints
x -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name NameHints
x
                                          Maybe NameHints
Nothing -> forall a. a -> a
id)
                                    forall a. Monoid a => a
mempty
                                    [Name]
names
                                 else forall a. Monoid a => a
mempty) [[Name]]
grps
           -- use this same names map for every citation
           forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
              EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap forall a b. (a -> b) -> a -> b
$
                   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                     (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
                       (\DisambiguationData
d -> DisambiguationData
d{ disambNameMap :: Map Name NameHints
disambNameMap = Map Name NameHints
namesMap })))
                     (forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap forall a b. (a -> b) -> a -> b
$ forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st)
                     [ItemId]
refIds }
           -- redo citations
           [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
citations'

  case forall a. CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities [Output a]
allCites' of
    []          -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [[DisambData]]
ambiguities -> Maybe Lang
-> DisambiguationStrategy
-> [Citation a]
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
analyzeAmbiguities Maybe Lang
mblang DisambiguationStrategy
strategy [Citation a]
citations' [[DisambData]]
ambiguities
  [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
citations

 where

  renderCitations :: [Citation a] -> Eval a [Output a]
  renderCitations :: [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
cs =
    forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST (\Context a
ctx EvalState a
st -> (Context a
ctx,
                          EvalState a
st { stateLastCitedMap :: Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap = forall a. Monoid a => a
mempty
                             , stateNoteMap :: Map Int (Set ItemId)
stateNoteMap = forall a. Monoid a => a
mempty })) forall a b. (a -> b) -> a -> b
$
     forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
CiteprocOutput a =>
Layout a -> (Int, Citation a) -> Eval a (Output a)
evalLayout (forall a. Style a -> Layout a
styleCitation Style a
style)) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Citation a]
cs)

  refreshAmbiguities :: [Citation a] -> Eval a [[DisambData]]
  refreshAmbiguities :: [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Citation a] -> Eval a [Output a]
renderCitations

  analyzeAmbiguities :: Maybe Lang
                     -> DisambiguationStrategy
                     -> [Citation a]
                     -> [[DisambData]]
                     -> Eval a ()
  analyzeAmbiguities :: Maybe Lang
-> DisambiguationStrategy
-> [Citation a]
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
analyzeAmbiguities Maybe Lang
mblang DisambiguationStrategy
strategy [Citation a]
cs [[DisambData]]
ambiguities = do
    -- add names to et al.
    forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
ambiguities
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[[DisambData]]
as ->
           (if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DisambData]]
as) Bool -> Bool -> Bool
&& DisambiguationStrategy -> Bool
disambiguateAddNames DisambiguationStrategy
strategy
               then do
                 forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a.
Maybe Lang
-> Maybe GivenNameDisambiguationRule -> [DisambData] -> Eval a ()
tryAddNames Maybe Lang
mblang (DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy)) [[DisambData]]
as
                 [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities [Citation a]
cs
               else
                 forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
as))
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[[DisambData]]
as ->
           (case DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy of
                  Just GivenNameDisambiguationRule
ByCite | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DisambData]]
as) -> do
                     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. Maybe Lang -> [DisambData] -> Eval a ()
tryAddGivenNames Maybe Lang
mblang) [[DisambData]]
as
                     [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities [Citation a]
cs
                  Maybe GivenNameDisambiguationRule
_           -> forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
as))
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[[DisambData]]
as ->
           (if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DisambData]]
as) Bool -> Bool -> Bool
&& DisambiguationStrategy -> Bool
disambiguateAddYearSuffix DisambiguationStrategy
strategy
               then do
                 forall a. Map ItemId [SortKeyValue] -> [[DisambData]] -> Eval a ()
addYearSuffixes Map ItemId [SortKeyValue]
bibSortKeyMap [[DisambData]]
as
                 [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities [Citation a]
cs
               else forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
as))
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. [DisambData] -> Eval a ()
tryDisambiguateCondition

basicItem :: ItemId -> CitationItem a
basicItem :: forall a. ItemId -> CitationItem a
basicItem ItemId
iid = CitationItem
  { citationItemId :: ItemId
citationItemId      = ItemId
iid
  , citationItemLabel :: Maybe Text
citationItemLabel   = forall a. Maybe a
Nothing
  , citationItemLocator :: Maybe Text
citationItemLocator = forall a. Maybe a
Nothing
  , citationItemType :: CitationItemType
citationItemType    = CitationItemType
NormalCite
  , citationItemPrefix :: Maybe a
citationItemPrefix  = forall a. Maybe a
Nothing
  , citationItemSuffix :: Maybe a
citationItemSuffix  = forall a. Maybe a
Nothing
  , citationItemData :: Maybe (Reference a)
citationItemData    = forall a. Maybe a
Nothing
  }

isDisambiguated :: Maybe Lang
                -> Maybe GivenNameDisambiguationRule
                -> Int -- et al min
                -> [DisambData]
                -> DisambData
                -> Bool
isDisambiguated :: Maybe Lang
-> Maybe GivenNameDisambiguationRule
-> Int
-> [DisambData]
-> DisambData
-> Bool
isDisambiguated Maybe Lang
mblang Maybe GivenNameDisambiguationRule
mbrule Int
etAlMin [DisambData]
xs DisambData
x =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\DisambData
y -> DisambData
x forall a. Eq a => a -> a -> Bool
== DisambData
y Bool -> Bool -> Bool
|| DisambData -> [Name]
disambiguatedName DisambData
y forall a. Eq a => a -> a -> Bool
/= DisambData -> [Name]
disambiguatedName DisambData
x) [DisambData]
xs
 where
  disambiguatedName :: DisambData -> [Name]
disambiguatedName = [Name] -> [Name]
nameParts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
etAlMin forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> [Name]
ddNames
  nameParts :: [Name] -> [Name]
nameParts =
    case Maybe GivenNameDisambiguationRule
mbrule of
      Just GivenNameDisambiguationRule
AllNames -> forall a. a -> a
id
      Just GivenNameDisambiguationRule
AllNamesWithInitials ->
           forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven :: Maybe Text
nameGiven = Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
""
                                            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe Text
nameGiven Name
name })
      Just GivenNameDisambiguationRule
PrimaryName ->
        \case
          [] -> []
          (Name
z:[Name]
zs) -> Name
z forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven :: Maybe Text
nameGiven = forall a. Maybe a
Nothing }) [Name]
zs
      Just GivenNameDisambiguationRule
PrimaryNameWithInitials ->
        \case
          [] -> []
          (Name
z:[Name]
zs) -> Name
z{ nameGiven :: Maybe Text
nameGiven =
                     Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe Text
nameGiven Name
z } forall a. a -> [a] -> [a]
:
                     forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven :: Maybe Text
nameGiven = forall a. Maybe a
Nothing }) [Name]
zs
      Just GivenNameDisambiguationRule
ByCite -> forall a. a -> a
id -- hints will be added later
      Maybe GivenNameDisambiguationRule
_ -> forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven :: Maybe Text
nameGiven = forall a. Maybe a
Nothing })

tryAddNames :: Maybe Lang
            -> Maybe GivenNameDisambiguationRule
            -> [DisambData]
            -> Eval a ()
tryAddNames :: forall a.
Maybe Lang
-> Maybe GivenNameDisambiguationRule -> [DisambData] -> Eval a ()
tryAddNames Maybe Lang
mblang Maybe GivenNameDisambiguationRule
mbrule [DisambData]
bs =
                     (case Maybe GivenNameDisambiguationRule
mbrule of
                          Just GivenNameDisambiguationRule
ByCite -> [DisambData]
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. Maybe Lang -> [DisambData] -> Eval a ()
tryAddGivenNames Maybe Lang
mblang [DisambData]
bs
                          Maybe GivenNameDisambiguationRule
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [DisambData]
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {r} {w} {a}.
Monad m =>
Int -> [DisambData] -> RWST r w (EvalState a) m ()
go Int
1
                        -- if ByCite, we want to make sure that
                        -- tryAddGivenNames is still applied, as
                        -- calculation of "add names" assumes this.
 where
   maxnames :: [DisambData] -> Int
maxnames = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Maybe a
maximumMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> [Name]
ddNames)
   go :: Int -> [DisambData] -> RWST r w (EvalState a) m ()
go Int
n [DisambData]
as
     | Int
n forall a. Ord a => a -> a -> Bool
> [DisambData] -> Int
maxnames [DisambData]
as = forall (m :: * -> *) a. Monad m => a -> m a
return ()
     | Bool
otherwise = do
         let ds :: [DisambData]
ds = forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Lang
-> Maybe GivenNameDisambiguationRule
-> Int
-> [DisambData]
-> DisambData
-> Bool
isDisambiguated Maybe Lang
mblang Maybe GivenNameDisambiguationRule
mbrule Int
n [DisambData]
as) [DisambData]
as
         if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DisambData]
ds
            then Int -> [DisambData] -> RWST r w (EvalState a) m ()
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) [DisambData]
as
            else do
              forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
                EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap
                      forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a.
Maybe Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setEtAlNames (forall a. a -> Maybe a
Just Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> ItemId
ddItem)
                        (forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap forall a b. (a -> b) -> a -> b
$ forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st) [DisambData]
as }
              Int -> [DisambData] -> RWST r w (EvalState a) m ()
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) ([DisambData]
as forall a. Eq a => [a] -> [a] -> [a]
\\ [DisambData]
ds)

tryAddGivenNames :: Maybe Lang
                 -> [DisambData]
                 -> Eval a ()
tryAddGivenNames :: forall a. Maybe Lang -> [DisambData] -> Eval a ()
tryAddGivenNames Maybe Lang
mblang [DisambData]
as = do
  let correspondingNames :: [[(ItemId, Name)]]
correspondingNames =
         forall a b. (a -> b) -> [a] -> [b]
map (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map DisambData -> ItemId
ddItem [DisambData]
as)) forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DisambData -> [Name]
ddNames [DisambData]
as
      go :: [DisambData]
-> [(ItemId, Name)]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
go [] [(ItemId, Name)]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
      go ([DisambData]
as' :: [DisambData]) ([(ItemId, Name)]
ns :: [(ItemId, Name)]) = do
        Set ItemId
hintedIds <- forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes 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 a.
Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint Maybe Lang
mblang (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(ItemId, Name)]
ns)) [(ItemId, Name)]
ns
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\DisambData
x -> DisambData -> ItemId
ddItem DisambData
x forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set ItemId
hintedIds) [DisambData]
as'
  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ forall {a}.
[DisambData]
-> [(ItemId, Name)]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
go [DisambData]
as [[(ItemId, Name)]]
correspondingNames

addYearSuffixes :: M.Map ItemId [SortKeyValue]
                -> [[DisambData]]
                -> Eval a ()
addYearSuffixes :: forall a. Map ItemId [SortKeyValue] -> [[DisambData]] -> Eval a ()
addYearSuffixes Map ItemId [SortKeyValue]
bibSortKeyMap' [[DisambData]]
as = do
  let allitems :: [DisambData]
allitems = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[DisambData]]
as
  [SortKeyValue] -> [SortKeyValue] -> Ordering
collate <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate
  let companions :: DisambData -> [DisambData]
companions DisambData
a =
        forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
        (\DisambData
item1 DisambData
item2 ->
          [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
            (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (DisambData -> ItemId
ddItem DisambData
item1) Map ItemId [SortKeyValue]
bibSortKeyMap')
            (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (DisambData -> ItemId
ddItem DisambData
item2) Map ItemId [SortKeyValue]
bibSortKeyMap'))
        (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [DisambData]
x | [DisambData]
x <- [[DisambData]]
as, DisambData
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DisambData]
x ])
  let groups :: Set [DisambData]
groups = forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map DisambData -> [DisambData]
companions forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [DisambData]
allitems
  let addYearSuffix :: ItemId -> Int -> RWST r w (EvalState a) m ()
addYearSuffix ItemId
item Int
suff =
        forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
          EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap
               forall a b. (a -> b) -> a -> b
$ forall a.
Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setYearSuffix Int
suff ItemId
item
               forall a b. (a -> b) -> a -> b
$ forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap
               forall a b. (a -> b) -> a -> b
$ forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st }
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[DisambData]
xs -> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall {m :: * -> *} {r} {w} {a}.
Monad m =>
ItemId -> Int -> RWST r w (EvalState a) m ()
addYearSuffix (forall a b. (a -> b) -> [a] -> [b]
map DisambData -> ItemId
ddItem [DisambData]
xs) [Int
1..]) Set [DisambData]
groups

tryDisambiguateCondition :: [DisambData] -> Eval a ()
tryDisambiguateCondition :: forall a. [DisambData] -> Eval a ()
tryDisambiguateCondition [DisambData]
as =
  case [DisambData]
as of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [DisambData]
xs -> forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
            EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap
                forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a.
Bool
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setDisambCondition Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> ItemId
ddItem)
                  (forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st))
                  [DisambData]
xs }

alterReferenceDisambiguation :: (DisambiguationData -> DisambiguationData)
                             -> Reference a
                             -> Reference a
alterReferenceDisambiguation :: forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation DisambiguationData -> DisambiguationData
f Reference a
r =
      Reference a
r{ referenceDisambiguation :: Maybe DisambiguationData
referenceDisambiguation = DisambiguationData -> DisambiguationData
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           case forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation Reference a
r of
             Maybe DisambiguationData
Nothing -> forall a. a -> Maybe a
Just
               DisambiguationData
                 { disambYearSuffix :: Maybe Int
disambYearSuffix  = forall a. Maybe a
Nothing
                 , disambNameMap :: Map Name NameHints
disambNameMap     = forall a. Monoid a => a
mempty
                 , disambEtAlNames :: Maybe Int
disambEtAlNames   = forall a. Maybe a
Nothing
                 , disambCondition :: Bool
disambCondition   = Bool
False
               }
             Just DisambiguationData
x  -> forall a. a -> Maybe a
Just DisambiguationData
x }

initialsMatch :: Maybe Lang -> Name -> Name -> Bool
initialsMatch :: Maybe Lang -> Name -> Name -> Bool
initialsMatch Maybe Lang
mblang Name
x Name
y =
  case (Name -> Maybe Text
nameGiven Name
x, Name -> Maybe Text
nameGiven Name
y) of
    (Just Text
x', Just Text
y') ->
      Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
"" Text
x' forall a. Eq a => a -> a -> Bool
==
        Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
"" Text
y'
    (Maybe Text, Maybe Text)
_ -> Bool
False

addNameHint :: Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint :: forall a.
Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint Maybe Lang
mblang [Name]
names (ItemId
item, Name
name) = do
  let familyMatches :: [Name]
familyMatches = [Name
n | Name
n <- [Name]
names
                         , Name
n forall a. Eq a => a -> a -> Bool
/= Name
name
                         , Name -> Maybe Text
nameFamily Name
n forall a. Eq a => a -> a -> Bool
== Name -> Maybe Text
nameFamily Name
name]
  case [Name]
familyMatches of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    [Name]
_  -> do
      let hint :: NameHints
hint = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Lang -> Name -> Name -> Bool
initialsMatch Maybe Lang
mblang Name
name) [Name]
familyMatches
                    then NameHints
AddGivenName
                    else NameHints
AddInitials
      forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
        EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap
            forall a b. (a -> b) -> a -> b
$ forall a.
NameHints
-> Name
-> ItemId
-> Map ItemId (Reference a)
-> Map ItemId (Reference a)
setNameHint NameHints
hint Name
name ItemId
item
            forall a b. (a -> b) -> a -> b
$ forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st) }
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ItemId
item

setNameHint :: NameHints -> Name -> ItemId
            -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setNameHint :: forall a.
NameHints
-> Name
-> ItemId
-> Map ItemId (Reference a)
-> Map ItemId (Reference a)
setNameHint NameHints
hint Name
name = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       (forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambNameMap :: Map Name NameHints
disambNameMap =
                     forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name NameHints
hint
                     (DisambiguationData -> Map Name NameHints
disambNameMap DisambiguationData
d) }))

setEtAlNames :: Maybe Int -> ItemId
             -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setEtAlNames :: forall a.
Maybe Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setEtAlNames Maybe Int
x = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       (forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambEtAlNames :: Maybe Int
disambEtAlNames = Maybe Int
x }))

setYearSuffix :: Int -> ItemId
              -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setYearSuffix :: forall a.
Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setYearSuffix Int
x = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       (forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambYearSuffix :: Maybe Int
disambYearSuffix = forall a. a -> Maybe a
Just Int
x }))

setDisambCondition :: Bool -> ItemId
                   -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setDisambCondition :: forall a.
Bool
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setDisambCondition Bool
x = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       (forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambCondition :: Bool
disambCondition = Bool
x }))

getAmbiguities :: CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities :: forall a. CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities =
        forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
           (\[DisambData]
zs ->
               case [DisambData]
zs of
                 []     -> forall a. Maybe a
Nothing
                 [DisambData
_]    -> forall a. Maybe a
Nothing
                 (DisambData
z:[DisambData]
_) ->
                   case DisambData -> Text
ddRendered DisambData
z of
                     Text
"" -> forall a. Maybe a
Nothing
                     Text
_  -> case forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn DisambData -> ItemId
ddItem [DisambData]
zs of
                             ys :: [DisambData]
ys@(DisambData
_:DisambData
_:[DisambData]
_) -> forall a. a -> Maybe a
Just [DisambData]
ys -- > 1 ambiguous entry
                             [DisambData]
_          -> forall a. Maybe a
Nothing)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\DisambData
x DisambData
y -> DisambData -> Text
ddRendered DisambData
x forall a. Eq a => a -> a -> Bool
== DisambData -> Text
ddRendered DisambData
y)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn DisambData -> Text
ddRendered
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. CiteprocOutput a => (ItemId, Output a) -> DisambData
toDisambData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Output a] -> [(ItemId, Output a)]
extractTagItems

extractTagItems :: [Output a] -> [(ItemId, Output a)]
extractTagItems :: forall a. [Output a] -> [(ItemId, Output a)]
extractTagItems [Output a]
xs =
  [(ItemId
iid, Output a
x) | Tagged (TagItem CitationItemType
NormalCite ItemId
iid) Output a
x <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall on. Uniplate on => on -> [on]
universe [Output a]
xs
            , Bool -> Bool
not (forall {a}. Output a -> Bool
hasIbid Output a
x)]
 where -- we don't want two "ibid" entries to be treated as ambiguous.
  hasIbid :: Output a -> Bool
hasIbid Output a
x = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ Term
trm | Tagged (TagTerm Term
trm) Output a
_ <- forall on. Uniplate on => on -> [on]
universe Output a
x
                               , Term -> Text
termName Term
trm forall a. Eq a => a -> a -> Bool
== Text
"ibid" ]


toDisambData :: CiteprocOutput a => (ItemId, Output a) -> DisambData
toDisambData :: forall a. CiteprocOutput a => (ItemId, Output a) -> DisambData
toDisambData (ItemId
iid, Output a
x) =
  let xs :: [Output a]
xs = forall on. Uniplate on => on -> [on]
universe Output a
x
      ns' :: [Name]
ns' = forall a. [Output a] -> [Name]
getNames [Output a]
xs
      ds' :: [Date]
ds' = forall a. [Output a] -> [Date]
getDates [Output a]
xs
      t :: Text
t   = forall a. CiteprocOutput a => Output a -> Text
outputToText Output a
x
   in DisambData { ddItem :: ItemId
ddItem = ItemId
iid
                 , ddNames :: [Name]
ddNames = [Name]
ns'
                 , ddDates :: [Date]
ddDates = [Date]
ds'
                 , ddRendered :: Text
ddRendered = Text
t }
 where
  getNames :: [Output a] -> [Name]
  getNames :: forall a. [Output a] -> [Name]
getNames (Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
_ : [Output a]
xs)
                  = [Name]
ns forall a. [a] -> [a] -> [a]
++ forall a. [Output a] -> [Name]
getNames [Output a]
xs
  getNames (Output a
_ : [Output a]
xs)   = forall a. [Output a] -> [Name]
getNames [Output a]
xs
  getNames []         = []

  getDates :: [Output a] -> [Date]
  getDates :: forall a. [Output a] -> [Date]
getDates (Tagged (TagDate Date
d) Output a
_ : [Output a]
xs)
                  = Date
d forall a. a -> [a] -> [a]
: forall a. [Output a] -> [Date]
getDates [Output a]
xs
  getDates (Output a
_ : [Output a]
xs)   = forall a. [Output a] -> [Date]
getDates [Output a]
xs
  getDates []         = []


--
-- Grouping and collapsing
--

groupAndCollapseCitations :: forall a . CiteprocOutput a
                          => Text
                          -> Maybe Text
                          -> Maybe Text
                          -> Maybe Collapsing
                          -> Output a
                          -> Output a
groupAndCollapseCitations :: forall a.
CiteprocOutput a =>
Text
-> Maybe Text
-> Maybe Text
-> Maybe Collapsing
-> Output a
-> Output a
groupAndCollapseCitations Text
citeGroupDelim Maybe Text
yearSuffixDelim Maybe Text
afterCollapseDelim
  Maybe Collapsing
collapsing (Formatted Formatting
f [Output a]
xs) =
   case Maybe Collapsing
collapsing of
      Just Collapsing
CollapseCitationNumber ->
        forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. Maybe a
Nothing } forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Output a] -> [Output a] -> [Output a]
collapseRange []
                  (forall a. Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive Output a -> Output a -> Bool
isAdjacentCitationNumber [Output a]
xs)
      Just Collapsing
collapseType ->
          forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. Maybe a
Nothing } forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Collapsing -> [Output a] -> [Output a] -> [Output a]
collapseGroup Collapsing
collapseType) [] ((Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
sameNames [Output a]
xs)
      Maybe Collapsing
Nothing ->
          forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f forall a b. (a -> b) -> a -> b
$
             forall a b. (a -> b) -> [a] -> [b]
map (forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. a -> Maybe a
Just Text
citeGroupDelim })
                 ((Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
sameNames [Output a]
xs)
 where
  --   Note that we cannot assume we've sorted by name,
  --   so we can't just use Data.ListgroupBy.  We also
  --   take care not to move anything past a prefix or suffix.
  groupWith :: (Output a -> Output a -> Bool)
            -> [Output a]
            -> [[Output a]]
  groupWith :: (Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
_ [] = []
  groupWith Output a -> Output a -> Bool
isMatched (Output a
z:[Output a]
zs)
   | Output a -> Bool
hasSuffix Output a
z = [Output a
z] forall a. a -> [a] -> [a]
: (Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
isMatched [Output a]
zs
   | Bool
otherwise =  -- we allow a prefix on first item in collapsed group
    case forall a. (a -> Bool) -> [a] -> ([a], [a])
span Output a -> Bool
hasNoPrefixOrSuffix [Output a]
zs of
      ([],[Output a]
ys) -> [Output a
z] forall a. a -> [a] -> [a]
: (Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
isMatched [Output a]
ys
      ([Output a]
ws,[Output a]
ys) ->
        (Output a
z forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (Output a -> Output a -> Bool
isMatched Output a
z) [Output a]
ws) forall a. a -> [a] -> [a]
:
          (Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
isMatched (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output a -> Output a -> Bool
isMatched Output a
z) [Output a]
ws forall a. [a] -> [a] -> [a]
++ [Output a]
ys)

  hasNoPrefixOrSuffix :: Output a -> Bool
  hasNoPrefixOrSuffix :: Output a -> Bool
hasNoPrefixOrSuffix Output a
x = Bool -> Bool
not (Output a -> Bool
hasPrefix Output a
x) Bool -> Bool -> Bool
&& Bool -> Bool
not (Output a -> Bool
hasSuffix Output a
x)

  hasPrefix :: Output a -> Bool
  hasPrefix :: Output a -> Bool
hasPrefix Output a
x = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a
y | y :: Output a
y@(Tagged Tag
TagPrefix Output a
_) <- forall on. Uniplate on => on -> [on]
universe Output a
x]

  hasSuffix :: Output a -> Bool
  hasSuffix :: Output a -> Bool
hasSuffix Output a
x = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a
y | y :: Output a
y@(Tagged Tag
TagSuffix Output a
_) <- forall on. Uniplate on => on -> [on]
universe Output a
x]

  collapseRange :: [Output a] -> [Output a] -> [Output a]
  collapseRange :: [Output a] -> [Output a] -> [Output a]
collapseRange [Output a]
ys [Output a]
zs
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
ys forall a. Ord a => a -> a -> Bool
>= Int
3
    , Just Output a
yhead <- forall a. [a] -> Maybe a
headMay [Output a]
ys
    , Just Output a
ylast <- forall a. [a] -> Maybe a
lastMay [Output a]
ys
      = forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
enDash }
                  [Output a
yhead, Output a
ylast] forall a. a -> [a] -> [a]
:
                  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
zs
                     then []
                     else forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Output a
NullOutput forall a. CiteprocOutput a => Text -> Output a
literal Maybe Text
afterCollapseDelim forall a. a -> [a] -> [a]
: [Output a]
zs
  collapseRange [Output a]
ys [Output a]
zs =
    forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Formatting -> Maybe Text
formatDelimiter Formatting
f } [Output a]
ys forall a. a -> [a] -> [a]
:
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
zs
         then []
         else forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Output a
NullOutput forall a. CiteprocOutput a => Text -> Output a
literal (Formatting -> Maybe Text
formatDelimiter Formatting
f) forall a. a -> [a] -> [a]
: [Output a]
zs

  collapseGroup :: Collapsing -> [Output a] -> [Output a] -> [Output a]
  collapseGroup :: Collapsing -> [Output a] -> [Output a] -> [Output a]
collapseGroup Collapsing
_ [] [Output a]
zs = [Output a]
zs
  collapseGroup Collapsing
collapseType (Output a
y:[Output a]
ys) [Output a]
zs =
    let ys' :: [Output a]
ys' = Output a
y forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall on. Uniplate on => (on -> on) -> on -> on
transform forall a. Output a -> Output a
removeNames) [Output a]
ys
        ws :: [Output a]
ws = Collapsing -> [Output a] -> [Output a]
collapseYearSuffix Collapsing
collapseType [Output a]
ys'
        noCollapse :: Bool
noCollapse = [Output a]
ws forall a. Eq a => a -> a -> Bool
== Output a
yforall a. a -> [a] -> [a]
:[Output a]
ys
        noYearSuffixCollapse :: Bool
noYearSuffixCollapse = [Output a]
ws forall a. Eq a => a -> a -> Bool
== [Output a]
ys'
        hasLocator :: Output a -> Bool
hasLocator Output a
u = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a
x | x :: Output a
x@(Tagged Tag
TagLocator Output a
_) <- forall on. Uniplate on => on -> [on]
universe Output a
u]
        anyHasLocator :: Bool
anyHasLocator = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {a}. Output a -> Bool
hasLocator [Output a]
ws
        -- https://github.com/citation-style-language/test-suite/issues/36 :
        flippedAfterCollapseDelim :: Bool
flippedAfterCollapseDelim = Collapsing
collapseType forall a. Eq a => a -> a -> Bool
== Collapsing
CollapseYear
        addCGDelim :: Output a -> [Output a] -> [Output a]
addCGDelim Output a
u [] = [Output a
u]
        addCGDelim Output a
u [Output a]
us =
          forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatSuffix :: Maybe Text
formatSuffix =
                              if Bool
noCollapse Bool -> Bool -> Bool
|| Bool
noYearSuffixCollapse Bool -> Bool -> Bool
&&
                                 Bool -> Bool
not (Bool
flippedAfterCollapseDelim Bool -> Bool -> Bool
&&
                                      Bool
anyHasLocator)
                                 then forall a. a -> Maybe a
Just Text
citeGroupDelim
                                 else Maybe Text
afterCollapseDelim forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                      Formatting -> Maybe Text
formatDelimiter Formatting
f } [Output a
u] forall a. a -> [a] -> [a]
: [Output a]
us
     in forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. Maybe a
Nothing
                        , formatSuffix :: Maybe Text
formatSuffix =
                            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
zs
                               then forall a. Maybe a
Nothing
                               else if Bool
noCollapse Bool -> Bool -> Bool
&&
                                          Bool -> Bool
not Bool
flippedAfterCollapseDelim
                                       then Formatting -> Maybe Text
formatDelimiter Formatting
f
                                       else Maybe Text
afterCollapseDelim forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                            Formatting -> Maybe Text
formatDelimiter Formatting
f }
                               (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Output a -> [Output a] -> [Output a]
addCGDelim [] [Output a]
ws) forall a. a -> [a] -> [a]
: [Output a]
zs
  collapseRanges :: [Output a] -> [Output a]
collapseRanges = forall a b. (a -> b) -> [a] -> [b]
map [Output a] -> Output a
rangifyGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive forall {a} {a}. Output a -> Output a -> Bool
isSuccessive
  isSuccessive :: Output a -> Output a -> Bool
isSuccessive Output a
x Output a
y
    = case ([Int
c | Tagged (TagYearSuffix Int
c) Output a
_ <- forall on. Uniplate on => on -> [on]
universe Output a
x],
            [Int
d | Tagged (TagYearSuffix Int
d) Output a
_ <- forall on. Uniplate on => on -> [on]
universe Output a
y]) of
        ([Int
c],[Int
d]) -> Int
d forall a. Eq a => a -> a -> Bool
== Int
c forall a. Num a => a -> a -> a
+ Int
1
        ([Int], [Int])
_   -> Bool
False

  rangifyGroup :: [Output a] -> Output a
  rangifyGroup :: [Output a] -> Output a
rangifyGroup [Output a]
zs
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
zs forall a. Ord a => a -> a -> Bool
>= Int
3
    , Just Output a
zhead <- forall a. [a] -> Maybe a
headMay [Output a]
zs
    , Just Output a
zlast <- forall a. [a] -> Maybe a
lastMay [Output a]
zs
    = forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. a -> Maybe a
Just (Char -> Text
T.singleton Char
enDash) }
                [Output a
zhead, Output a
zlast]
  rangifyGroup [Output a
z] = Output a
z
  rangifyGroup [Output a]
zs = forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
yearSuffixDelim
                                    } [Output a]
zs

  yearSuffixGroup :: Bool -> [Output a] -> Output a
  yearSuffixGroup :: Bool -> [Output a] -> Output a
yearSuffixGroup Bool
_ [Output a
x] = Output a
x
  yearSuffixGroup Bool
useRanges [Output a]
zs  =
    forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
yearSuffixDelim }
      forall a b. (a -> b) -> a -> b
$ if Bool
useRanges then [Output a] -> [Output a]
collapseRanges [Output a]
zs else [Output a]
zs

  collapseYearSuffix :: Collapsing -> [Output a] -> [Output a]
  collapseYearSuffix :: Collapsing -> [Output a] -> [Output a]
collapseYearSuffix Collapsing
CollapseYearSuffix [Output a]
zs =
    forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Bool -> [Output a] -> Output a
yearSuffixGroup Bool
False [Output a]
cur forall a. a -> [a] -> [a]
: [Output a]
items
   where
     ([Output a]
cur, [Output a]
items) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool
-> ([Output a], [Output a]) -> Output a -> ([Output a], [Output a])
goYearSuffix Bool
False) ([], []) [Output a]
zs
  collapseYearSuffix Collapsing
CollapseYearSuffixRanged [Output a]
zs =
    forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Bool -> [Output a] -> Output a
yearSuffixGroup Bool
True [Output a]
cur forall a. a -> [a] -> [a]
: [Output a]
items
   where
     ([Output a]
cur, [Output a]
items) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool
-> ([Output a], [Output a]) -> Output a -> ([Output a], [Output a])
goYearSuffix Bool
True) ([], []) [Output a]
zs
  collapseYearSuffix Collapsing
_ [Output a]
zs = [Output a]
zs

  getDates :: Output a -> [Date]
  getDates :: Output a -> [Date]
getDates Output a
x = [Date
d | Tagged (TagDate Date
d) Output a
_ <- forall on. Uniplate on => on -> [on]
universe Output a
x]

  getYears :: Output a -> [[Maybe Int]]
  getYears :: Output a -> [[Maybe Int]]
getYears Output a
x = [forall a b. (a -> b) -> [a] -> [b]
map (\case
                        DateParts (Int
y:[Int]
_) -> forall a. a -> Maybe a
Just Int
y
                        DateParts
_               -> forall a. Maybe a
Nothing) (Date -> [DateParts]
dateParts Date
d)
                | Date
d <- Output a -> [Date]
getDates Output a
x
                , forall a. Maybe a -> Bool
isNothing (Date -> Maybe Text
dateLiteral Date
d)]

  goYearSuffix :: Bool -> ([Output a], [Output a]) -> Output a
               -> ([Output a], [Output a])
  goYearSuffix :: Bool
-> ([Output a], [Output a]) -> Output a -> ([Output a], [Output a])
goYearSuffix Bool
useRanges ([Output a]
cur, [Output a]
items) Output a
item =
    case [Output a]
cur of
      []     -> ([Output a
item], [Output a]
items)
      (Output a
z:[Output a]
zs)
        | Output a -> [[Maybe Int]]
getYears Output a
z forall a. Eq a => a -> a -> Bool
== Output a -> [[Maybe Int]]
getYears Output a
item
          -> (Output a
zforall a. a -> [a] -> [a]
:[Output a]
zs forall a. [a] -> [a] -> [a]
++ [forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
removeYear Output a
item], [Output a]
items)
        | Bool
otherwise -> ([Output a
item], Bool -> [Output a] -> Output a
yearSuffixGroup Bool
useRanges (Output a
zforall a. a -> [a] -> [a]
:[Output a]
zs) forall a. a -> [a] -> [a]
: [Output a]
items)

  removeYear :: Output a -> Output a
  removeYear :: Output a -> Output a
removeYear (Tagged (TagDate Date
d) Output a
x) =
    forall a. Tag -> Output a -> Output a
Tagged (Date -> Tag
TagDate Date
d) (Output a -> Output a
extractYearSuffix Output a
x)
  removeYear Output a
x = Output a
x

  extractYearSuffix :: Output a -> Output a
  extractYearSuffix :: Output a -> Output a
extractYearSuffix Output a
x =
    case [Output a
z | z :: Output a
z@(Tagged (TagYearSuffix Int
_) Output a
_) <- forall on. Uniplate on => on -> [on]
universe Output a
x] of
      (Output a
y:[Output a]
_) -> Output a
y
      [Output a]
_     -> forall a. Output a
NullOutput

  isAdjacentCitationNumber :: Output a -> Output a -> Bool
  isAdjacentCitationNumber :: Output a -> Output a -> Bool
isAdjacentCitationNumber
     (Tagged (TagItem CitationItemType
_ ItemId
_)
       (Formatted Formatting
_f1 [Tagged (TagCitationNumber Int
n1) Output a
_xs1]))
     (Tagged (TagItem CitationItemType
_ ItemId
_)
       (Formatted Formatting
_f2 [Tagged (TagCitationNumber Int
n2) Output a
_xs2]))
    = Int
n2 forall a. Eq a => a -> a -> Bool
== Int
n1 forall a. Num a => a -> a -> a
+ Int
1
  isAdjacentCitationNumber
     (Tagged (TagItem CitationItemType
_ ItemId
_) (Tagged (TagCitationNumber Int
n1) Output a
_xs1))
     (Tagged (TagItem CitationItemType
_ ItemId
_) (Tagged (TagCitationNumber Int
n2) Output a
_xs2))
    = Int
n2 forall a. Eq a => a -> a -> Bool
== Int
n1 forall a. Num a => a -> a -> a
+ Int
1
  isAdjacentCitationNumber Output a
_ Output a
_ = Bool
False

  sameNames :: Output a -> Output a -> Bool
  sameNames :: Output a -> Output a -> Bool
sameNames Output a
x Output a
y =
    case (Output a -> Maybe (Output a)
extractTagged Output a
x, Output a -> Maybe (Output a)
extractTagged Output a
y) of
      (Just (Tagged (TagNames Variable
t1 NamesFormat
_nf1 [Name]
ns1) Output a
ws1),
       Just (Tagged (TagNames Variable
t2 NamesFormat
_nf2 [Name]
ns2) Output a
ws2))
        -> Variable
t1 forall a. Eq a => a -> a -> Bool
== Variable
t2 Bool -> Bool -> Bool
&& (if [Name]
ns1 forall a. Eq a => a -> a -> Bool
== [Name]
ns2
                           then Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ns1) Bool -> Bool -> Bool
|| Output a
ws1 forall a. Eq a => a -> a -> Bool
== Output a
ws2
                           else Output a
ws1 forall a. Eq a => a -> a -> Bool
== Output a
ws2)
      -- case where it's just a date with no name or anything;
      -- we treat this as same name e.g. (1955a,b)
      (Just (Tagged TagDate{} Output a
_), Just (Tagged TagDate{} Output a
_))
        -> Bool
True
          -- case where title is substituted
      (Maybe (Output a), Maybe (Output a))
_ -> Bool
False

  extractTagged :: Output a -> Maybe (Output a)
  extractTagged :: Output a -> Maybe (Output a)
extractTagged Output a
x =
    let items :: [Output a]
items = [Output a
y | y :: Output a
y@(Tagged (TagItem CitationItemType
ty ItemId
_) Output a
_) <- forall on. Uniplate on => on -> [on]
universe Output a
x
                   , CitationItemType
ty forall a. Eq a => a -> a -> Bool
/= CitationItemType
AuthorOnly]
        names :: [Output a]
names = [Output a
y | y :: Output a
y@(Tagged TagNames{} Output a
_) <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall on. Uniplate on => on -> [on]
universe [Output a]
items]
        dates :: [Output a]
dates = [Output a
y | y :: Output a
y@(Tagged TagDate{} Output a
_) <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall on. Uniplate on => on -> [on]
universe [Output a]
items]
    in  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
items
           then forall a. Maybe a
Nothing
           else forall a. [a] -> Maybe a
listToMaybe [Output a]
names forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. [a] -> Maybe a
listToMaybe [Output a]
dates

groupAndCollapseCitations Text
_ Maybe Text
_ Maybe Text
_ Maybe Collapsing
_ Output a
x = Output a
x

takeSeq :: Show a => (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq :: forall a. Show a => (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq a -> a -> Bool
isAdjacent (a
x1 : a
x2 : [a]
rest)
  | a -> a -> Bool
isAdjacent a
x1 a
x2 = (a
x1forall a. a -> [a] -> [a]
:[a]
ys, [a]
zs)
  where ([a]
ys, [a]
zs) = forall a. Show a => (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq a -> a -> Bool
isAdjacent (a
x2forall a. a -> [a] -> [a]
:[a]
rest)
takeSeq a -> a -> Bool
_ (a
y:[a]
ys) = ([a
y], [a]
ys)
takeSeq a -> a -> Bool
_ []     = ([], [])

groupSuccessive :: Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive :: forall a. Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive a -> a -> Bool
isAdjacent [a]
zs =
  case forall a. Show a => (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq a -> a -> Bool
isAdjacent [a]
zs of
    ([],[a]
_)  -> []
    ([a]
xs,[a]
ys) -> [a]
xs forall a. a -> [a] -> [a]
: forall a. Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive a -> a -> Bool
isAdjacent [a]
ys

--
-- Sorting
--

evalSortKeys :: CiteprocOutput a
             => Layout a
             -> ItemId
             -> Eval a [SortKeyValue]
evalSortKeys :: forall a.
CiteprocOutput a =>
Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys Layout a
layout ItemId
citeId =
  forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST (\Context a
ctx EvalState a
st -> (Context a
ctx{ contextInSortKey :: Bool
contextInSortKey = Bool
True }, EvalState a
st)) forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
CiteprocOutput a =>
ItemId -> SortKey a -> Eval a SortKeyValue
evalSortKey ItemId
citeId) (forall a. Layout a -> [SortKey a]
layoutSortKeys Layout a
layout)

evalSortKey :: CiteprocOutput a
            => ItemId
            -> SortKey a
            -> Eval a SortKeyValue
evalSortKey :: forall a.
CiteprocOutput a =>
ItemId -> SortKey a -> Eval a SortKeyValue
evalSortKey ItemId
citeId (SortKeyMacro SortDirection
sortdir [Element a]
elts) = do
  ReferenceMap a
refmap <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> ReferenceMap a
stateRefMap
  case forall a. ItemId -> ReferenceMap a -> Maybe (Reference a)
lookupReference ItemId
citeId ReferenceMap a
refmap of
    Maybe (Reference a)
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SortDirection -> Maybe [Text] -> SortKeyValue
SortKeyValue SortDirection
sortdir forall a. Maybe a
Nothing
    Just Reference a
ref -> do
        [Text]
k <- Text -> [Text]
normalizeSortKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              forall a. CiteprocOutput a => CiteprocOptions -> Output a -> a
renderOutput CiteprocOptions
defaultCiteprocOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Output a] -> Output a
grouped
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r' s r w a.
(r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a
withRWS forall {a}. a -> EvalState a -> (a, EvalState a)
newContext (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 a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement [Element a]
elts)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SortDirection -> Maybe [Text] -> SortKeyValue
SortKeyValue SortDirection
sortdir (forall a. a -> Maybe a
Just [Text]
k)
     where
      newContext :: a -> EvalState a -> (a, EvalState a)
newContext a
oldContext EvalState a
s =
        (a
oldContext, EvalState a
s{ stateReference :: Reference a
stateReference = Reference a
ref })
evalSortKey ItemId
citeId (SortKeyVariable SortDirection
sortdir Variable
var) = do
  ReferenceMap a
refmap <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> ReferenceMap a
stateRefMap
  SortDirection -> Maybe [Text] -> SortKeyValue
SortKeyValue SortDirection
sortdir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    case forall a. ItemId -> ReferenceMap a -> Maybe (Reference a)
lookupReference ItemId
citeId ReferenceMap a
refmap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
var of
      Maybe (Val a)
Nothing           -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just (TextVal Text
t)  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> [Text]
normalizeSortKey Text
t
      Just (NumVal  Int
i)  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%09d" Int
i]
      Just (FancyVal a
x) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> [Text]
normalizeSortKey forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => a -> Text
toText a
x
      Just (NamesVal [Name]
ns) ->
        forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
normalizeSortKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
T.unwords
             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 a. Name -> Eval a [Text]
getNamePartSortOrder [Name]
ns
      Just (DateVal Date
d)  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Date -> Text
dateToText Date
d]
      Just Val a
SubstitutedVal -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- Note: we do a case-insensitive sort (using toCaseFold):
normalizeSortKey :: Text -> [Text]
normalizeSortKey :: Text -> [Text]
normalizeSortKey = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isWordSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toCaseFold
 where
  isWordSep :: Char -> Bool
isWordSep Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'’' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
||
                Char
c forall a. Eq a => a -> a -> Bool
== Char
'ʾ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'ʿ' -- ayn/hamza in transliterated arabic

-- absence should sort AFTER all values
-- see sort_StatusFieldAscending.txt, sort_StatusFieldDescending.txt
compSortKeyValue :: (Text -> Text -> Ordering)
                 -> SortKeyValue
                 -> SortKeyValue
                 -> Ordering
compSortKeyValue :: (Text -> Text -> Ordering)
-> SortKeyValue -> SortKeyValue -> Ordering
compSortKeyValue Text -> Text -> Ordering
collate SortKeyValue
sk1 SortKeyValue
sk2 =
  case (SortKeyValue
sk1, SortKeyValue
sk2) of
    (SortKeyValue SortDirection
_ Maybe [Text]
Nothing, SortKeyValue SortDirection
_ Maybe [Text]
Nothing) -> Ordering
EQ
    (SortKeyValue SortDirection
_ Maybe [Text]
Nothing, SortKeyValue SortDirection
_ (Just [Text]
_)) -> Ordering
GT
    (SortKeyValue SortDirection
_ (Just [Text]
_), SortKeyValue SortDirection
_ Maybe [Text]
Nothing) -> Ordering
LT
    (SortKeyValue SortDirection
Ascending (Just [Text]
t1), SortKeyValue SortDirection
Ascending (Just [Text]
t2)) ->
      [Text] -> [Text] -> Ordering
collateKey [Text]
t1 [Text]
t2
    (SortKeyValue SortDirection
Descending (Just [Text]
t1), SortKeyValue SortDirection
Descending (Just [Text]
t2))->
      [Text] -> [Text] -> Ordering
collateKey [Text]
t2 [Text]
t1
    (SortKeyValue, SortKeyValue)
_ -> Ordering
EQ
 where
  collateKey :: [Text] -> [Text] -> Ordering
  collateKey :: [Text] -> [Text] -> Ordering
collateKey [] [] = Ordering
EQ
  collateKey [] (Text
_:[Text]
_) = Ordering
LT
  collateKey (Text
_:[Text]
_) [] = Ordering
GT
  collateKey (Text
x:[Text]
xs) (Text
y:[Text]
ys) =
    case Text -> Text -> Ordering
collate Text
x Text
y of
      Ordering
EQ -> [Text] -> [Text] -> Ordering
collateKey [Text]
xs [Text]
ys
      Ordering
GT -> Ordering
GT
      Ordering
LT -> Ordering
LT

compSortKeyValues :: (Text -> Text -> Ordering)
                  -> [SortKeyValue]
                  -> [SortKeyValue]
                  -> Ordering
compSortKeyValues :: (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues Text -> Text -> Ordering
_ [] [] = Ordering
EQ
compSortKeyValues Text -> Text -> Ordering
_ [] (SortKeyValue
_:[SortKeyValue]
_) = Ordering
LT
compSortKeyValues Text -> Text -> Ordering
_ (SortKeyValue
_:[SortKeyValue]
_) [] = Ordering
GT
compSortKeyValues Text -> Text -> Ordering
collate (SortKeyValue
x:[SortKeyValue]
xs) (SortKeyValue
y:[SortKeyValue]
ys) =
  case (Text -> Text -> Ordering)
-> SortKeyValue -> SortKeyValue -> Ordering
compSortKeyValue Text -> Text -> Ordering
collate SortKeyValue
x SortKeyValue
y of
    Ordering
EQ -> (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues Text -> Text -> Ordering
collate [SortKeyValue]
xs [SortKeyValue]
ys
    Ordering
GT -> Ordering
GT
    Ordering
LT -> Ordering
LT

-- Note!  This prints negative (BC) dates as N(999,999,999 + y)
-- and positive (AD) dates as Py so they sort properly.  (Note that
-- our unicode sorting ignores punctuation, so we use a letter
-- rather than -.) Do not use out of context of sort keys.
dateToText :: Date -> Text
dateToText :: Date -> Text
dateToText = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> String
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> [DateParts]
dateParts
 where
  go :: [Int] -> String
  go :: [Int] -> String
go [] = String
""
  go [Int
y] = Int -> String
toYear Int
y forall a. Semigroup a => a -> a -> a
<> String
"0000"
  go [Int
y,Int
m] = Int -> String
toYear Int
y forall a. Semigroup a => a -> a -> a
<> forall r. PrintfType r => String -> r
printf String
"%02d" Int
m forall a. Semigroup a => a -> a -> a
<> String
"00"
  go (Int
y:Int
m:Int
d:[Int]
_) = Int -> String
toYear Int
y forall a. Semigroup a => a -> a -> a
<> forall r. PrintfType r => String -> r
printf String
"%02d" Int
m forall a. Semigroup a => a -> a -> a
<> forall r. PrintfType r => String -> r
printf String
"%02d" Int
d
  toYear :: Int -> String
  toYear :: Int -> String
toYear Int
y
    | Int
y forall a. Ord a => a -> a -> Bool
< Int
0     = forall r. PrintfType r => String -> r
printf String
"N%09d" (Int
999999999 forall a. Num a => a -> a -> a
+ Int
y)
    | Bool
otherwise = forall r. PrintfType r => String -> r
printf String
"P%09d" Int
y


evalLayout :: CiteprocOutput a
            => Layout a
            -> (Int, Citation a)
            -> Eval a (Output a)
evalLayout :: forall a.
CiteprocOutput a =>
Layout a -> (Int, Citation a) -> Eval a (Output a)
evalLayout Layout a
layout (Int
citationGroupNumber, Citation a
citation) = do
  -- this is a hack to ensure that "ibid" detection will work
  -- correctly in a citation starting with an author-only:
  -- the combination AuthorOnly [SuppressAuthor] should not
  -- count against a later Ibid citation.
  let positionsInCitation :: [Int]
positionsInCitation =
        case forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation of
          (CitationItem a
c:[CitationItem a]
_) | forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
c forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly -> [Int
0..]
          [CitationItem a]
_ -> [Int
1..]

  [Output a]
items <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, CitationItem a) -> Eval a (Output a)
evalItem' (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
positionsInCitation (forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation))

  -- see display_SecondFieldAlignMigratePunctuation.txt
  let moveSuffixInsideDisplay :: [Output a] -> Maybe [Output a]
moveSuffixInsideDisplay [Output a]
zs =
        case (forall a. [a] -> Maybe a
lastMay [Output a]
zs, Formatting -> Maybe Text
formatSuffix Formatting
formatting) of
          (Just (Tagged (TagItem CitationItemType
ct ItemId
id') (Formatted Formatting
f [Output a]
ys)), Just Text
_) ->
            (\[Output a]
ys' -> forall a. [a] -> [a]
initSafe [Output a]
zs forall a. [a] -> [a] -> [a]
++
                      [forall a. Tag -> Output a -> Output a
Tagged (CitationItemType -> ItemId -> Tag
TagItem CitationItemType
ct ItemId
id') (forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f [Output a]
ys')]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        [Output a] -> Maybe [Output a]
moveSuffixInsideDisplay [Output a]
ys
          (Just (Formatted Formatting
f [Output a]
ys), Just Text
suff)
            | forall a. Maybe a -> Bool
isJust (Formatting -> Maybe DisplayStyle
formatDisplay Formatting
f) ->
                forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
initSafe [Output a]
zs forall a. [a] -> [a] -> [a]
++
                     [forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatSuffix :: Maybe Text
formatSuffix = forall a. a -> Maybe a
Just
                          (forall a. a -> Maybe a -> a
fromMaybe Text
"" (Formatting -> Maybe Text
formatSuffix Formatting
f) forall a. Semigroup a => a -> a -> a
<> Text
suff) } [Output a]
ys]
            | Bool
otherwise -> (\[Output a]
ys' -> forall a. [a] -> [a]
initSafe [Output a]
zs forall a. [a] -> [a] -> [a]
++ [forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f [Output a]
ys']) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             [Output a] -> Maybe [Output a]
moveSuffixInsideDisplay [Output a]
ys
          (Maybe (Output a), Maybe Text)
_ -> forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    case forall {a}. [Output a] -> Maybe [Output a]
moveSuffixInsideDisplay [Output a]
items of
      Maybe [Output a]
Nothing     -> forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a]
items
      Just [Output a]
items' -> forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting{ formatSuffix :: Maybe Text
formatSuffix = forall a. Maybe a
Nothing } [Output a]
items'
 where
  formatting :: Formatting
formatting = forall a. Layout a -> Formatting
layoutFormatting Layout a
layout

  secondFieldAlign :: [Output a] -> [Output a]
secondFieldAlign [Linked Text
t (Output a
x:[Output a]
xs)] =
    [Output a] -> [Output a]
secondFieldAlign [Output a
x, forall a. Text -> [Output a] -> Output a
Linked Text
t [Output a]
xs]
  secondFieldAlign (Output a
x:[Output a]
xs) =
    forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatDisplay :: Maybe DisplayStyle
formatDisplay = forall a. a -> Maybe a
Just DisplayStyle
DisplayLeftMargin } [Output a
x]
    forall a. a -> [a] -> [a]
: [forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatDisplay :: Maybe DisplayStyle
formatDisplay = forall a. a -> Maybe a
Just DisplayStyle
DisplayRightInline } [Output a]
xs]
  secondFieldAlign [] = []

  evalItem' :: (Int, CitationItem a) -> Eval a (Output a)
evalItem' (Int
positionInCitation :: Int, CitationItem a
item) = do
    Bool
isBibliography  <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInBibliography

    StyleOptions
styleOpts <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> StyleOptions
contextStyleOptions
    let isNote :: Bool
isNote = StyleOptions -> Bool
styleIsNoteStyle StyleOptions
styleOpts
    [Position]
position <- forall a.
Int -> Maybe Int -> CitationItem a -> Int -> Eval a [Position]
getPosition Int
citationGroupNumber (forall a. Citation a -> Maybe Int
citationNoteNumber Citation a
citation)
                     CitationItem a
item Int
positionInCitation

    [Output a]
xs <- forall a.
CiteprocOutput a =>
Layout a -> ([Position], CitationItem a) -> Eval a [Output a]
evalItem Layout a
layout ([Position]
position, CitationItem a
item)
    -- we only update the map in the citations section
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBibliography forall a b. (a -> b) -> a -> b
$ do
      forall a. Int -> Citation a -> CitationItem a -> Eval a ()
updateRefMap Int
citationGroupNumber Citation a
citation CitationItem a
item
      forall a. Int -> Int -> Citation a -> CitationItem a -> Eval a ()
updateLastCitedMap Int
citationGroupNumber Int
positionInCitation Citation a
citation CitationItem a
item

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\a
pref Output a
x -> forall a. Tag -> Output a -> Output a
Tagged Tag
TagPrefix (forall a. [Output a] -> Output a
grouped [forall a. a -> Output a
Literal a
pref, Output a
x]))
                (forall a. CitationItem a -> Maybe a
citationItemPrefix CitationItem a
item)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\a
suff Output a
x -> forall a. Tag -> Output a -> Output a
Tagged Tag
TagSuffix (forall a. [Output a] -> Output a
grouped [Output a
x, forall a. a -> Output a
Literal a
suff]))
                   (forall a. CitationItem a -> Maybe a
citationItemSuffix CitationItem a
item)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Output a
x -> case Output a
x of
                   Output a
NullOutput -> Output a
x
                   Output a
_          -> forall a. Tag -> Output a -> Output a
Tagged (CitationItemType -> ItemId -> Tag
TagItem (forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
item)
                                                  (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)) Output a
x)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
item forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly
              then (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Output a -> Output a
getAuthors forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty
              else forall a. a -> a
id)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (case forall a. CitationItem a -> Maybe a
citationItemPrefix CitationItem a
item of
             Just a
t | Bool
isNote
                    , Text
". " Text -> Text -> Bool
`T.isSuffixOf` forall a. CiteprocOutput a => a -> Text
toText a
t
                    , Text -> Text -> Int
T.count Text
" " (forall a. CiteprocOutput a => a -> Text
toText a
t) forall a. Ord a => a -> a -> Bool
> Int
1 -- exclude single word
                                 -> forall a. [Output a] -> [Output a]
capitalizeInitialTerm
             Maybe a
_                   -> forall a. a -> a
id)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isBibliography
              then
                case StyleOptions -> Maybe SecondFieldAlign
styleSecondFieldAlign StyleOptions
styleOpts of
                  Just SecondFieldAlign
SecondFieldAlignFlush  -> forall a. [Output a] -> [Output a]
secondFieldAlign
                  Just SecondFieldAlign
SecondFieldAlignMargin -> forall a. [Output a] -> [Output a]
secondFieldAlign -- TODO?
                  Maybe SecondFieldAlign
Nothing -> forall a. a -> a
id
              else forall a. a -> a
id)
        forall a b. (a -> b) -> a -> b
$ [Output a]
xs

evalItem :: CiteprocOutput a
         => Layout a -> ([Position], CitationItem a) -> Eval a [Output a]
evalItem :: forall a.
CiteprocOutput a =>
Layout a -> ([Position], CitationItem a) -> Eval a [Output a]
evalItem Layout a
layout ([Position]
position, CitationItem a
item) = do
  ReferenceMap a
refmap <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> ReferenceMap a
stateRefMap

  let addLangToFormatting :: Lang -> Output a -> Output a
addLangToFormatting Lang
lang (Formatted Formatting
f [Output a]
xs) =
        forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatLang :: Maybe Lang
formatLang = forall a. a -> Maybe a
Just Lang
lang } [Output a]
xs
      addLangToFormatting Lang
_ Output a
x = Output a
x

  case forall a. ItemId -> ReferenceMap a -> Maybe (Reference a)
lookupReference (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) ReferenceMap a
refmap of
    Just Reference a
ref -> forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST
      (\Context a
ctx EvalState a
st ->
       (Context a
ctx{ contextLocator :: Maybe Text
contextLocator = forall a. CitationItem a -> Maybe Text
citationItemLocator CitationItem a
item
           , contextLabel :: Maybe Text
contextLabel = forall a. CitationItem a -> Maybe Text
citationItemLabel CitationItem a
item
           , contextPosition :: [Position]
contextPosition = [Position]
position
           },
        EvalState a
st{ stateReference :: Reference a
stateReference = Reference a
ref
          , stateUsedYearSuffix :: Bool
stateUsedYearSuffix = Bool
False
          , stateUsedIdentifier :: Bool
stateUsedIdentifier = Bool
False
          , stateUsedTitle :: Bool
stateUsedTitle = Bool
False
          }))
        forall a b. (a -> b) -> a -> b
$ do [Output a]
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 a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement (forall a. Layout a -> [Element a]
layoutElements Layout a
layout)

             -- find identifiers that can be used to hyperlink the title
             let mbident :: Maybe Identifier
mbident =
                    forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall a. Maybe a
Nothing
                      [ Text -> Identifier
IdentDOI   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. CiteprocOutput a => Val a -> Maybe Text
valToText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"DOI" Reference a
ref)
                      , Text -> Identifier
IdentPMCID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. CiteprocOutput a => Val a -> Maybe Text
valToText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"PMCID" Reference a
ref)
                      , Text -> Identifier
IdentPMID  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. CiteprocOutput a => Val a -> Maybe Text
valToText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"PMID" Reference a
ref)
                      , Text -> Identifier
IdentURL   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. CiteprocOutput a => Val a -> Maybe Text
valToText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"URL" Reference a
ref)
                      ]
             let mburl :: Maybe Text
mburl = Identifier -> Text
identifierToURL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Identifier
mbident

             -- hyperlink any titles in the output
             let linkTitle :: Text -> Output a -> Output a
linkTitle Text
url (Tagged Tag
TagTitle Output a
x) = forall a. Text -> [Output a] -> Output a
Linked Text
url [forall a. Tag -> Output a -> Output a
Tagged Tag
TagTitle Output a
x]
                 linkTitle Text
_ Output a
x = Output a
x

             Bool
usedLink  <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> Bool
stateUsedIdentifier
             Bool
usedTitle <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> Bool
stateUsedTitle
             Bool
inBiblio  <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInBibliography

             -- when no links were rendered for a bibliography item, hyperlink
             -- the title, if it exists, otherwise hyperlink the whole item
             let xs' :: [Output a]
xs' =
                   if Bool
usedLink Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
inBiblio
                     then [Output a]
xs
                   else case Maybe Text
mburl of
                         Maybe Text
Nothing  -> [Output a]
xs
                         Just Text
url -> if Bool
usedTitle
                                        -- hyperlink the title
                                        then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall on. Uniplate on => (on -> on) -> on -> on
transform (forall {a}. Text -> Output a -> Output a
linkTitle Text
url)) [Output a]
xs
                                        -- hyperlink the entire bib item
                                        else [forall a. Text -> [Output a] -> Output a
Linked Text
url [Output a]
xs]

             let mblang :: Maybe Lang
mblang = forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"language" Reference a
ref
                          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. CiteprocOutput a => Val a -> Maybe Text
valToText
                          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 b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Lang
parseLang
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
               case Maybe Lang
mblang of
                 Maybe Lang
Nothing   -> [Output a]
xs'
                 Just Lang
lang -> forall a b. (a -> b) -> [a] -> [b]
map
                     (forall on. Uniplate on => (on -> on) -> on -> on
transform (forall {a}. Lang -> Output a -> Output a
addLangToFormatting Lang
lang)) [Output a]
xs'
    Maybe (Reference a)
Nothing -> do
      forall a. Text -> Eval a ()
warn forall a b. (a -> b) -> a -> b
$ Text
"citation " forall a. Semigroup a => a -> a -> a
<> ItemId -> Text
unItemId (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) forall a. Semigroup a => a -> a -> a
<>
             Text
" not found"
      forall (m :: * -> *) a. Monad m => a -> m a
return [forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => FontWeight -> a -> a
addFontWeight FontWeight
BoldWeight
         forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText forall a b. (a -> b) -> a -> b
$ ItemId -> Text
unItemId (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) forall a. Semigroup a => a -> a -> a
<> Text
"?"]



updateRefMap :: Int -> Citation a -> CitationItem a -> Eval a ()
updateRefMap :: forall a. Int -> Citation a -> CitationItem a -> Eval a ()
updateRefMap Int
citationGroupNumber Citation a
citation CitationItem a
item = do
  Bool
isNote <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Bool
styleIsNoteStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> StyleOptions
contextStyleOptions)
  Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
lastCitedMap <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a.
EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap
  let notenum :: Val a
notenum = forall a. Int -> Val a
NumVal forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Int
citationGroupNumber (forall a. Citation a -> Maybe Int
citationNoteNumber Citation a
citation)
  -- keep track of how many citations in each note.
  -- two citations from the same note don't count as "alone"
  -- for ibid purposes. See citation-style-language/documentation#121
  case forall a. Citation a -> Maybe Int
citationNoteNumber Citation a
citation of
    Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Int
n  -> forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
                   EvalState a
st{ stateNoteMap :: Map Int (Set ItemId)
stateNoteMap = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter
                        (forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                          (forall a. a -> Maybe a
Just (forall a. a -> Set a
Set.singleton (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)))
                          (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Set a
Set.insert (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)))
                        Int
n
                        (forall a. EvalState a -> Map Int (Set ItemId)
stateNoteMap EvalState a
st) }
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
lastCitedMap of
    Maybe (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
Nothing | Bool
isNote -> -- first citation
      forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
        EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap forall a b. (a -> b) -> a -> b
$
                forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\Reference a
ref -> Reference a
ref{ referenceVariables :: Map Variable (Val a)
referenceVariables =
                  forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Variable
"first-reference-note-number" forall {a}. Val a
notenum
                             (forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference a
ref)})
                  (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)
               (forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap forall a b. (a -> b) -> a -> b
$ forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st) }
    Maybe (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

updateLastCitedMap :: Int -> Int -> Citation a -> CitationItem a -> Eval a ()
updateLastCitedMap :: forall a. Int -> Int -> Citation a -> CitationItem a -> Eval a ()
updateLastCitedMap Int
citationGroupNumber Int
positionInCitation Citation a
citation CitationItem a
item = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
item forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
      EvalState a
st{ stateLastCitedMap :: Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap =
        forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)
          (Int
citationGroupNumber, forall a. Citation a -> Maybe Int
citationNoteNumber Citation a
citation,
           Int
positionInCitation,
           (case forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation of
              [CitationItem a
_]   -> Bool
True
              [CitationItem a
x,CitationItem a
y] -> forall a. CitationItem a -> ItemId
citationItemId CitationItem a
x forall a. Eq a => a -> a -> Bool
== forall a. CitationItem a -> ItemId
citationItemId CitationItem a
y
                      Bool -> Bool -> Bool
&& forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
x forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly
                      Bool -> Bool -> Bool
&& forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
y forall a. Eq a => a -> a -> Bool
== CitationItemType
SuppressAuthor
              [CitationItem a]
_     -> Bool
False),
           forall a. CitationItem a -> Maybe Text
citationItemLabel CitationItem a
item,
           forall a. CitationItem a -> Maybe Text
citationItemLocator CitationItem a
item)
        forall a b. (a -> b) -> a -> b
$ forall a.
EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap EvalState a
st }


-- | The first-occurring element tagged as Names will be
-- treated as the "author"; generally that is the author
-- but it might be the editor if it's an edited volume.
getAuthors :: Output a -> Output a
getAuthors :: forall a. Output a -> Output a
getAuthors Output a
x =
  forall a. a -> [a] -> a
headDef forall a. Output a
NullOutput [Output a
y | y :: Output a
y@(Tagged TagNames{} Output a
_) <- forall on. Uniplate on => on -> [on]
universe Output a
x]

removeNames :: Output a -> Output a
removeNames :: forall a. Output a -> Output a
removeNames (Tagged TagNames{} Output a
_) = forall a. Output a
NullOutput
removeNames Output a
x = Output a
x

capitalizeInitialTerm :: [Output a] -> [Output a]
capitalizeInitialTerm :: forall a. [Output a] -> [Output a]
capitalizeInitialTerm [] = []
capitalizeInitialTerm (Output a
z:[Output a]
zs) = forall a. Output a -> Output a
go Output a
z forall a. a -> [a] -> [a]
: [Output a]
zs
 where
  go :: Output a -> Output a
go (Tagged (TagTerm Term
t) Output a
x) =
    forall a. Tag -> Output a -> Output a
Tagged (Term -> Tag
TagTerm Term
t)
      (forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatTextCase :: Maybe TextCase
formatTextCase = forall a. a -> Maybe a
Just TextCase
CapitalizeFirst } [Output a
x])
  go (Formatted Formatting
f [Output a]
xs) = forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f (forall a. [Output a] -> [Output a]
capitalizeInitialTerm [Output a]
xs)
  go (Tagged Tag
tg Output a
x) = forall a. Tag -> Output a -> Output a
Tagged Tag
tg (Output a -> Output a
go Output a
x)
  go Output a
x = Output a
x

getPosition :: Int -> Maybe Int -> CitationItem a -> Int -> Eval a [Position]
getPosition :: forall a.
Int -> Maybe Int -> CitationItem a -> Int -> Eval a [Position]
getPosition Int
groupNum Maybe Int
mbNoteNum CitationItem a
item Int
posInGroup = do
  Bool
inBibliography <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInBibliography
  if Bool
inBibliography
     then forall (m :: * -> *) a. Monad m => a -> m a
return []
     else forall {a} {w} {a}.
RWST (Context a) w (EvalState a) Identity [Position]
getPosition'
 where
  getPosition' :: RWST (Context a) w (EvalState a) Identity [Position]
getPosition' = do
    Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
lastCitedMap <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a.
EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap
    Map Int (Set ItemId)
noteMap <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> Map Int (Set ItemId)
stateNoteMap
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
lastCitedMap of
      Maybe (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return [Position
FirstPosition]
      Just (Int
prevGroupNum, Maybe Int
mbPrevNoteNum,
             Int
prevPosInGroup, Bool
prevAloneInGroup,
             Maybe Text
prevLabel, Maybe Text
prevLoc) -> do
        Bool
isNote <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Bool
styleIsNoteStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> StyleOptions
contextStyleOptions)
        Int
nearNoteDistance <- forall a. a -> Maybe a -> a
fromMaybe Int
5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Maybe Int
styleNearNoteDistance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> StyleOptions
contextStyleOptions)
        let noteNum :: Int
noteNum = forall a. a -> Maybe a -> a
fromMaybe Int
groupNum Maybe Int
mbNoteNum
        let prevNoteNum :: Int
prevNoteNum = forall a. a -> Maybe a -> a
fromMaybe Int
prevGroupNum Maybe Int
mbPrevNoteNum
        let prevAloneInNote :: Bool
prevAloneInNote =
              case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
prevNoteNum Map Int (Set ItemId)
noteMap of
                Maybe (Set ItemId)
Nothing -> Bool
True
                Just Set ItemId
s  -> forall a. Set a -> Int
Set.size Set ItemId
s forall a. Ord a => a -> a -> Bool
<= Int
1
        let prevAlone :: Bool
prevAlone = Bool
prevAloneInGroup Bool -> Bool -> Bool
&& Bool
prevAloneInNote
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          (if Bool
isNote Bool -> Bool -> Bool
&& Int
noteNum forall a. Num a => a -> a -> a
- Int
prevNoteNum forall a. Ord a => a -> a -> Bool
< Int
nearNoteDistance
              then (Position
NearNote forall a. a -> [a] -> [a]
:)
              else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (if (Int
groupNum forall a. Eq a => a -> a -> Bool
== Int
prevGroupNum Bool -> Bool -> Bool
&&
               Int
posInGroup forall a. Eq a => a -> a -> Bool
== Int
prevPosInGroup forall a. Num a => a -> a -> a
+ Int
1) Bool -> Bool -> Bool
||
              (Int
groupNum forall a. Eq a => a -> a -> Bool
== Int
prevGroupNum forall a. Num a => a -> a -> a
+ Int
1 Bool -> Bool -> Bool
&&
                (((-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mbNoteNum forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
mbPrevNoteNum) forall a. Ord a => a -> a -> Bool
<= forall a. a -> Maybe a
Just Int
1) Bool -> Bool -> Bool
&&
               Int
posInGroup forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&&
               Bool
prevAlone)
               then case (Maybe Text
prevLoc, forall a. CitationItem a -> Maybe Text
citationItemLocator CitationItem a
item) of
                      (Maybe Text
Nothing, Just Text
_)
                        -> (Position
IbidWithLocator forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position
Ibid forall a. a -> [a] -> [a]
:)
                      (Maybe Text
Nothing, Maybe Text
Nothing) -> (Position
Ibid forall a. a -> [a] -> [a]
:)
                      (Just Text
_, Maybe Text
Nothing)   -> forall a. a -> a
id
                      (Just Text
l1, Just Text
l2)
                        | Text
l1 forall a. Eq a => a -> a -> Bool
== Text
l2
                        , forall a. CitationItem a -> Maybe Text
citationItemLabel CitationItem a
item forall a. Eq a => a -> a -> Bool
== Maybe Text
prevLabel
                          -> (Position
Ibid forall a. a -> [a] -> [a]
:)
                        | Bool
otherwise
                          -> (Position
IbidWithLocator forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position
Ibid forall a. a -> [a] -> [a]
:)
               else forall a. a -> a
id)
          forall a b. (a -> b) -> a -> b
$ [Position
Subsequent]

eElement :: CiteprocOutput a => Element a -> Eval a [Output a]
eElement :: forall a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement (Element ElementType a
etype Formatting
formatting) =
  case ElementType a
etype of
    EText TextType
textType ->
      (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
CiteprocOutput a =>
Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting Formatting
formatting (forall a. CiteprocOutput a => TextType -> Eval a (Output a)
eText TextType
textType)
    ENumber Variable
var NumberForm
nform ->
      (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
CiteprocOutput a =>
Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting Formatting
formatting (forall a.
CiteprocOutput a =>
Variable -> NumberForm -> Eval a (Output a)
eNumber Variable
var NumberForm
nform)
    EGroup Bool
isMacro [Element a]
els ->
      (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
CiteprocOutput a =>
Bool -> Formatting -> [Element a] -> Eval a (Output a)
eGroup Bool
isMacro Formatting
formatting [Element a]
els
    EChoose [(Match, [Condition], [Element a])]
chooseParts -> forall a.
CiteprocOutput a =>
[(Match, [Condition], [Element a])] -> Eval a [Output a]
eChoose [(Match, [Condition], [Element a])]
chooseParts
    ELabel Variable
var TermForm
termform Pluralize
pluralize ->
      (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
CiteprocOutput a =>
Variable
-> TermForm -> Pluralize -> Formatting -> Eval a (Output a)
eLabel Variable
var TermForm
termform Pluralize
pluralize Formatting
formatting
    EDate Variable
var DateType
dateType Maybe ShowDateParts
mbShowDateParts [DP]
dps ->
      (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
CiteprocOutput a =>
Variable
-> DateType
-> Maybe ShowDateParts
-> [DP]
-> Formatting
-> Eval a (Output a)
eDate Variable
var DateType
dateType Maybe ShowDateParts
mbShowDateParts [DP]
dps Formatting
formatting
    ENames [Variable]
vars NamesFormat
namesFormat [Element a]
subst ->
      (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
CiteprocOutput a =>
[Variable]
-> NamesFormat -> [Element a] -> Formatting -> Eval a (Output a)
eNames [Variable]
vars NamesFormat
namesFormat [Element a]
subst Formatting
formatting

withFormatting :: CiteprocOutput a
               => Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting :: forall a.
CiteprocOutput a =>
Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting (Formatting Maybe Lang
Nothing Maybe FontStyle
Nothing Maybe FontVariant
Nothing Maybe FontWeight
Nothing Maybe TextDecoration
Nothing Maybe VerticalAlign
Nothing
                           Maybe Text
Nothing Maybe Text
Nothing Maybe DisplayStyle
Nothing Maybe TextCase
Nothing Maybe Text
Nothing
                           Bool
False Bool
False Bool
False) Eval a (Output a)
p
                          = Eval a (Output a)
p
withFormatting Formatting
formatting Eval a (Output a)
p = do
  -- Title case conversion only affects English-language items.
  Maybe Lang
lang <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Maybe Lang
localeLanguage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> Locale
contextLocale)
  Reference a
ref <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> Reference a
stateReference
  let reflang :: Maybe Lang
reflang = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Variable
"language" (forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference a
ref) of
                  Just (TextVal Text
t)  ->
                    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Either String Lang
parseLang Text
t
                  Just (FancyVal a
x) ->
                    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Either String Lang
parseLang forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => a -> Text
toText a
x
                  Maybe (Val a)
_                 -> forall a. Maybe a
Nothing
  let mainLangIsEn :: Maybe Lang -> Bool
mainLangIsEn Maybe Lang
Nothing = Bool
False
      mainLangIsEn (Just Lang
l) = Lang -> Text
langLanguage Lang
l forall a. Eq a => a -> a -> Bool
== Text
"en"
  let isEnglish :: Bool
isEnglish = case Maybe Lang
reflang of
                    Just Lang
l  -> Maybe Lang -> Bool
mainLangIsEn (forall a. a -> Maybe a
Just Lang
l)
                    Maybe Lang
Nothing -> Maybe Lang -> Bool
mainLangIsEn Maybe Lang
lang
  let formatting' :: Formatting
formatting' = if Formatting -> Maybe TextCase
formatTextCase Formatting
formatting forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just TextCase
TitleCase Bool -> Bool -> Bool
&&
                       Bool -> Bool
not Bool
isEnglish
                       then Formatting
formatting{ formatTextCase :: Maybe TextCase
formatTextCase = forall a. Maybe a
Nothing }
                       else Formatting
formatting
  Output a
res <- Eval a (Output a)
p
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting' [Output a
res]

lookupTerm :: Term -> Eval a [(Term, Text)]
lookupTerm :: forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
term = do
  Map Text [(Term, Text)]
terms <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Map Text [(Term, Text)]
localeTerms forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> Locale
contextLocale)
  let term' :: Term
term' = if Term -> Text
termName Term
term forall a. Eq a => a -> a -> Bool
== Text
"sub verbo"
                 then Term
term{ termName :: Text
termName = Text
"sub-verbo" }
                 else Term
term
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Term -> Text
termName Term
term') Map Text [(Term, Text)]
terms of
     Just [(Term, Text)]
ts -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ (Term
term'',Text
t)
                         | (Term
term'',Text
t) <- [(Term, Text)]
ts
                         , Term
term' forall a. Ord a => a -> a -> Bool
<= Term
term''
                         ]
     Maybe [(Term, Text)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []

lookupTerm' :: CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' :: forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term = forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
term forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {a}.
CiteprocOutput a =>
[(a, Text)] -> Eval a (Output a)
f
 where
   f :: [(a, Text)] -> Eval a (Output a)
f []  =
     --  “verb-short” first falls back to “verb”, “symbol”
     --  first falls back to “short”, and “verb” and “short”
     --  both fall back to “long”.
     case Term -> TermForm
termForm Term
term of
       TermForm
VerbShort -> forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Verb }
       TermForm
Symbol    -> forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Short }
       TermForm
Verb      -> forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Long }
       TermForm
Short     -> forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Long }
       TermForm
_         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
   f ((a
_,Text
t):[(a, Text)]
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
t
                             then forall a. Output a
NullOutput
                             else forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText Text
t

pageRange :: CiteprocOutput a => Text -> Eval a (Output a)
pageRange :: forall a. CiteprocOutput a => Text -> Eval a (Output a)
pageRange Text
x = do
  Output a
pageDelim <- forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm'
                  Term
emptyTerm{ termName :: Text
termName = Text
"page-range-delimiter" }
  Maybe PageRangeFormat
mbPageRangeFormat <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Maybe PageRangeFormat
stylePageRangeFormat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> StyleOptions
contextStyleOptions)
  let ranges :: [Text]
ranges = forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy
               (\Char
c Char
d -> Bool -> Bool
not (Char
c forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'&' Bool -> Bool -> Bool
|| Char
d forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
d forall a. Eq a => a -> a -> Bool
== Char
'&'))
               Text
x
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. a -> Maybe a
Just Text
" " }
         forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a.
CiteprocOutput a =>
Maybe PageRangeFormat -> Output a -> Text -> Output a
formatPageRange Maybe PageRangeFormat
mbPageRangeFormat
            (case Output a
pageDelim of
               Output a
NullOutput -> forall a. CiteprocOutput a => Text -> Output a
literal forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
enDash
               Output a
delim      -> Output a
delim)) [Text]
ranges

enDash :: Char
enDash :: Char
enDash = Char
'\x2013'

formatPageRange :: CiteprocOutput a
                => Maybe PageRangeFormat
                -> Output a
                -> Text
                -> Output a
formatPageRange :: forall a.
CiteprocOutput a =>
Maybe PageRangeFormat -> Output a -> Text -> Output a
formatPageRange Maybe PageRangeFormat
_ Output a
_ Text
"&" = forall a. CiteprocOutput a => Text -> Output a
literal Text
"&"
formatPageRange Maybe PageRangeFormat
_ Output a
_ Text
"," = forall a. CiteprocOutput a => Text -> Output a
literal Text
","
formatPageRange Maybe PageRangeFormat
mbPageRangeFormat Output a
delim Text
t =
  let isDash :: Char -> Bool
isDash Char
'-' = Bool
True
      isDash Char
'\x2013' = Bool
True
      isDash Char
_ = Bool
False
      rangeParts :: [Text]
rangeParts = if Text
"\\-" Text -> Text -> Bool
`T.isInfixOf` Text
t
                      then [Text -> Text -> Text -> Text
T.replace Text
"\\-" Text
"-" Text
t]
                      else forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isDash Text
t
      inRange :: Text -> [Text] -> Output a
inRange Text
pref [Text]
xs
        | Text -> Bool
T.null Text
pref = forall a. [Output a] -> Output a
grouped (forall a. a -> [a] -> [a]
intersperse Output a
delim (forall a b. (a -> b) -> [a] -> [b]
map forall a. CiteprocOutput a => Text -> Output a
literal [Text]
xs))
        | Bool
otherwise = forall a. [Output a] -> Output a
grouped
            (forall a. CiteprocOutput a => Text -> Output a
literal Text
pref forall a. a -> [a] -> [a]
: forall a. a -> [a] -> [a]
intersperse Output a
delim (forall a b. (a -> b) -> [a] -> [b]
map forall a. CiteprocOutput a => Text -> Output a
literal [Text]
xs))
      changedDigits :: String -> String -> Int
changedDigits String
xs String
ys =
        forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Eq a => a -> a -> Bool
(==) (String
xs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
' ') String
ys
      minimal :: Int -> Text -> Text -> Text -> Output a
minimal Int
threshold Text
pref Text
x Text
y =
        case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
x Text
y of
             Just (Text
_comm, Text
restx, Text
resty) | Text -> Int
T.length Text
restx forall a. Eq a => a -> a -> Bool
== Text -> Int
T.length Text
resty ->
                 if Text -> Int
T.length Text
resty forall a. Ord a => a -> a -> Bool
< Int
threshold Bool -> Bool -> Bool
&& Text -> Int
T.length Text
y forall a. Ord a => a -> a -> Bool
>= Int
threshold
                    then Text -> [Text] -> Output a
inRange Text
pref [Text
x, Int -> Text -> Text
T.takeEnd Int
threshold Text
y]
                    else Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
resty]
             Maybe (Text, Text, Text)
_ -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y]
   in case [Text]
rangeParts of
        []     -> forall a. Output a
NullOutput
        [Text
w]    -> forall a. CiteprocOutput a => Text -> Output a
literal Text
w
        [Text
w,Text
v]
          | Maybe PageRangeFormat
Nothing <- Maybe PageRangeFormat
mbPageRangeFormat -> Text -> [Text] -> Output a
inRange forall a. Monoid a => a
mempty [Text
w,Text
v]
          | Just PageRangeFormat
fmt <- Maybe PageRangeFormat
mbPageRangeFormat -> do
            let wPrefix :: Text
wPrefix = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isDigit Text
w
            let vPrefix :: Text
vPrefix = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isDigit Text
v
            if Text
wPrefix forall a. Eq a => a -> a -> Bool
== Text
vPrefix
               then do
                 let pref :: Text
pref = Text
wPrefix
                 let x :: Text
x = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
wPrefix) Text
w
                 let y :: Text
y = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
vPrefix) Text
v
                 let xlen :: Int
xlen = Text -> Int
T.length Text
x
                 let ylen :: Int
ylen = Text -> Int
T.length Text
y
                 let y' :: Text
y'   = if Int
ylen forall a. Ord a => a -> a -> Bool
< Int
xlen
                               then Int -> Text -> Text
T.take (Int
xlen forall a. Num a => a -> a -> a
- Int
ylen) Text
x forall a. Semigroup a => a -> a -> a
<> Text
y
                               else Text
y
                 case PageRangeFormat
fmt of
                   PageRangeFormat
PageRangeChicago15
                       | Int
xlen forall a. Ord a => a -> a -> Bool
< Int
3  -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
                       | Text
"00" Text -> Text -> Bool
`T.isSuffixOf` Text
x -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
                       | Int -> Text -> Text
T.take Int
1 (Int -> Text -> Text
T.takeEnd Int
2 Text
x) forall a. Eq a => a -> a -> Bool
== Text
"0"
                       , Int -> Text -> Text
T.take Int
1 (Int -> Text -> Text
T.takeEnd Int
2 Text
y') forall a. Eq a => a -> a -> Bool
== Text
"0"
                         -> Int -> Text -> Text -> Text -> Output a
minimal Int
1 Text
pref Text
x Text
y'
                       | Int
xlen forall a. Eq a => a -> a -> Bool
== Int
4
                       , String -> String -> Int
changedDigits (Text -> String
T.unpack Text
x) (Text -> String
T.unpack Text
y') forall a. Ord a => a -> a -> Bool
>= Int
3
                         -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
                       | Bool
otherwise -> Int -> Text -> Text -> Text -> Output a
minimal Int
2 Text
pref Text
x Text
y'
                   PageRangeFormat
PageRangeChicago16
                       | Int
xlen forall a. Ord a => a -> a -> Bool
< Int
3  -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
                       | Text
"00" Text -> Text -> Bool
`T.isSuffixOf` Text
x -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
                       | Int -> Text -> Text
T.take Int
1 (Int -> Text -> Text
T.takeEnd Int
2 Text
x) forall a. Eq a => a -> a -> Bool
== Text
"0"
                       , Int -> Text -> Text
T.take Int
1 (Int -> Text -> Text
T.takeEnd Int
2 Text
y') forall a. Eq a => a -> a -> Bool
== Text
"0"
                         -> Int -> Text -> Text -> Text -> Output a
minimal Int
1 Text
pref Text
x Text
y'
                       | Bool
otherwise -> Int -> Text -> Text -> Text -> Output a
minimal Int
2 Text
pref Text
x Text
y'
                   PageRangeFormat
PageRangeExpanded ->
                       Text -> [Text] -> Output a
inRange forall a. Monoid a => a
mempty [Text
pref forall a. Semigroup a => a -> a -> a
<> Text
x, Text
pref forall a. Semigroup a => a -> a -> a
<> Text
y']
                   PageRangeFormat
PageRangeMinimal -> Int -> Text -> Text -> Text -> Output a
minimal Int
1 Text
pref Text
x Text
y'
                   PageRangeFormat
PageRangeMinimalTwo -> Int -> Text -> Text -> Text -> Output a
minimal Int
2 Text
pref Text
x Text
y'
               else Text -> [Text] -> Output a
inRange forall a. Monoid a => a
mempty [Text
w,Text
v]
        [Text]
_ -> forall a. CiteprocOutput a => Text -> Output a
literal Text
t

eText :: CiteprocOutput a => TextType -> Eval a (Output a)
eText :: forall a. CiteprocOutput a => TextType -> Eval a (Output a)
eText (TextVariable VariableForm
varForm Variable
v) = do
  Reference a
ref <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> Reference a
stateReference
  -- Note: we do book keeping on how many variables
  -- have been accessed and how many are nonempty,
  -- in order to properly handle the group element,
  -- which is implicitly conditional.
  case Variable
v of
    Variable
"id"   -> do
      forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall a. Reference a -> ItemId
referenceId Reference a
ref
    Variable
"type" -> do
      forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText  forall a b. (a -> b) -> a -> b
$ forall a. Reference a -> Text
referenceType Reference a
ref
    Variable
"locator" -> do
        let handleAmpersands :: Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
handleAmpersands (Just Text
t) | (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
==Char
'&') Text
t = do
              [(Term, Text)]
ts <- forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = Text
"and"
                                         , termForm :: TermForm
termForm = TermForm
Symbol }
              case [(Term, Text)]
ts of
                (Term
_,Text
x):[(Term, Text)]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
"&" Text
x Text
t)
                []      -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Text
t)
            handleAmpersands Maybe Text
x = forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
x

        Maybe Text
mbv <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Maybe Text
contextLocator forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}.
Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
handleAmpersands
        Maybe Text
mbl <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Maybe Text
contextLabel
        case Maybe Text
mbv of
          Just Text
x | forall a. Maybe a -> Bool
isNothing Maybe Text
mbl Bool -> Bool -> Bool
|| Maybe Text
mbl forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"page" -> do
                      forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
                      forall a. Tag -> Output a -> Output a
Tagged Tag
TagLocator forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CiteprocOutput a => Text -> Eval a (Output a)
pageRange Text
x
                 | Bool
otherwise -> do
                      forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Tag -> Output a -> Output a
Tagged Tag
TagLocator forall a b. (a -> b) -> a -> b
$
                                forall a.
CiteprocOutput a =>
Maybe PageRangeFormat -> Output a -> Text -> Output a
formatPageRange forall a. Maybe a
Nothing
                                (forall a. CiteprocOutput a => Text -> Output a
literal forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
enDash) Text
x
          Maybe Text
Nothing -> forall a. Output a
NullOutput forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
0

    Variable
"year-suffix" -> do
        Maybe DisambiguationData
disamb <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets (forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EvalState a -> Reference a
stateReference)
        case Maybe DisambiguationData
disamb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DisambiguationData -> Maybe Int
disambYearSuffix of
          Just Int
x ->
            -- we don't update var count here; this doesn't
            -- count as a variable
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Tag -> Output a -> Output a
Tagged (Int -> Tag
TagYearSuffix Int
x)
                            (forall a. a -> Output a
Literal (forall a. CiteprocOutput a => Text -> a
fromText (Int -> Text
showYearSuffix Int
x)))
          Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput

    Variable
"citation-number" -> do
        Maybe (Val a)
mbv <- forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
        case Maybe (Val a)
mbv of
          Just (NumVal Int
x)  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                              forall a. Tag -> Output a -> Output a
Tagged (Int -> Tag
TagCitationNumber Int
x) forall a b. (a -> b) -> a -> b
$
                              forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText (String -> Text
T.pack (forall a. Show a => a -> String
show Int
x))
          Maybe (Val a)
_ -> do
            forall a. Text -> Eval a ()
warn forall a b. (a -> b) -> a -> b
$ Text
"citation-number not defined for " forall a. Semigroup a => a -> a -> a
<>
                      coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Reference a -> ItemId
referenceId Reference a
ref)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput

    Variable
"citation-label" -> do  -- these need year suffix too
        Maybe (Val a)
mbv <- forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
        Maybe (Output a)
mbsuff <- forall a. CiteprocOutput a => Eval a (Maybe (Output a))
getYearSuffix
        case Maybe (Val a)
mbv of
          Just (TextVal Text
t)  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                                forall a. Tag -> Output a -> Output a
Tagged Tag
TagCitationLabel forall a b. (a -> b) -> a -> b
$
                                  forall a. [Output a] -> Output a
grouped forall a b. (a -> b) -> a -> b
$
                                  forall a. a -> Output a
Literal (forall a. CiteprocOutput a => Text -> a
fromText Text
t)
                                  forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList Maybe (Output a)
mbsuff
          Just (FancyVal a
x) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                                 forall a. Tag -> Output a -> Output a
Tagged Tag
TagCitationLabel forall a b. (a -> b) -> a -> b
$
                                  forall a. [Output a] -> Output a
grouped forall a b. (a -> b) -> a -> b
$
                                  forall a. a -> Output a
Literal a
x
                                  forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList Maybe (Output a)
mbsuff
          Maybe (Val a)
_ -> do
            forall a. Text -> Eval a ()
warn forall a b. (a -> b) -> a -> b
$ Text
"citation-label of unknown type for " forall a. Semigroup a => a -> a -> a
<>
                      coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Reference a -> ItemId
referenceId Reference a
ref)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput

    Variable
"DOI"   -> forall b.
CiteprocOutput b =>
(Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent Text -> Text
fixShortDOI Text -> Identifier
IdentDOI
    Variable
"PMCID" -> forall b.
CiteprocOutput b =>
(Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent forall a. a -> a
id Text -> Identifier
IdentPMCID
    Variable
"PMID"  -> forall b.
CiteprocOutput b =>
(Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent forall a. a -> a
id Text -> Identifier
IdentPMID
    Variable
"URL"   -> forall b.
CiteprocOutput b =>
(Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent forall a. a -> a
id Text -> Identifier
IdentURL

    Variable
_ -> do
        Maybe (Val a)
mbv <- if VariableForm
varForm forall a. Eq a => a -> a -> Bool
== VariableForm
ShortForm
                  then do
                    Maybe (Val a)
mbval <- forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable (Variable
v forall a. Semigroup a => a -> a -> a
<> Variable
"-short")
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
                    case Maybe (Val a)
mbval of
                      Maybe (Val a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                      Just Val a
val -> do
                        Maybe Abbreviations
mbAbbrevs <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Maybe Abbreviations
contextAbbreviations
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Val a
val
                               forall a b. (a -> b) -> a -> b
$ Maybe Abbreviations
mbAbbrevs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
CiteprocOutput a =>
Variable -> Val a -> Abbreviations -> Maybe (Val a)
lookupAbbreviation Variable
v Val a
val
                  else forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
        Output a
res <- case Maybe (Val a)
mbv of
                 Just (TextVal Text
x)
                   | Variable
v forall a. Eq a => a -> a -> Bool
== Variable
"page" -> forall a. CiteprocOutput a => Text -> Eval a (Output a)
pageRange Text
x
                   | Bool
otherwise   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText Text
x
                 Just (FancyVal a
x)
                   | Variable
v forall a. Eq a => a -> a -> Bool
== Variable
"page" -> forall a. CiteprocOutput a => Text -> Eval a (Output a)
pageRange (forall a. CiteprocOutput a => a -> Text
toText a
x)
                   | Bool
otherwise   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal a
x
                 Just (NumVal Int
x) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal
                                           forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText (String -> Text
T.pack (forall a. Show a => a -> String
show Int
x))
                 Maybe (Val a)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
        forall a. [Variable] -> Eval a ()
deleteSubstitutedVariables [Variable
v]
        if Variable
v forall a. Eq a => a -> a -> Bool
== Variable
"title" Bool -> Bool -> Bool
&& Output a
res forall a. Eq a => a -> a -> Bool
/= forall a. Output a
NullOutput
            then do
              forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify (\EvalState a
st -> EvalState a
st { stateUsedTitle :: Bool
stateUsedTitle = Bool
True })
              -- tag title so we can hyperlink it later
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Tag -> Output a -> Output a
Tagged Tag
TagTitle Output a
res
            else forall (m :: * -> *) a. Monad m => a -> m a
return Output a
res
    where
      handleIdent :: CiteprocOutput b => (Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
      handleIdent :: forall b.
CiteprocOutput b =>
(Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent Text -> Text
f Text -> Identifier
identConstr = do
        Maybe (Val b)
mbv <- forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
        forall a. [Variable] -> Eval a ()
deleteSubstitutedVariables [Variable
v]
        case Text -> Text
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. CiteprocOutput a => Val a -> Maybe Text
valToText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Val b)
mbv) of
          Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
          Just Text
t  -> do
            -- create link and remember that we've done so far
            forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify (\EvalState b
st -> EvalState b
st { stateUsedIdentifier :: Bool
stateUsedIdentifier = Bool
True })
            let url :: Text
url = Identifier -> Text
identifierToURL (Text -> Identifier
identConstr Text
t)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Text -> [Output a] -> Output a
Linked Text
url [forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText Text
t]
eText (TextMacro Text
name) = do
  forall a. Text -> Eval a ()
warn forall a b. (a -> b) -> a -> b
$ Text
"encountered unexpanded macro " forall a. Semigroup a => a -> a -> a
<> Text
name
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
eText (TextValue Text
t) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText Text
t
eText (TextTerm Term
term) = do
  Output a
t' <- forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term
  Output a
t'' <- if Term -> Text
termName Term
term forall a. Eq a => a -> a -> Bool
== Text
"no date"
            then do
              Maybe (Output a)
mbsuff <- forall a. CiteprocOutput a => Eval a (Maybe (Output a))
getYearSuffix
              case Maybe (Output a)
mbsuff of
                Maybe (Output a)
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return Output a
t'
                Just Output a
suff
                  | Term -> TermForm
termForm Term
term forall a. Eq a => a -> a -> Bool
== TermForm
Long
                    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Output a] -> Output a
grouped [Output a
t', forall a. a -> Output a
Literal (forall a. CiteprocOutput a => Text -> a
fromText Text
" "), Output a
suff]
                  | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Output a] -> Output a
grouped [Output a
t', Output a
suff]
            else forall (m :: * -> *) a. Monad m => a -> m a
return Output a
t'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Tag -> Output a -> Output a
Tagged (Term -> Tag
TagTerm Term
term) Output a
t''


-- | Delete substituted variables so they aren't used again.
deleteSubstitutedVariables :: [Variable] -> Eval a ()
deleteSubstitutedVariables :: forall a. [Variable] -> Eval a ()
deleteSubstitutedVariables [Variable]
vars = do
  Bool
inSubst <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInSubstitute
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
inSubst forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st -> -- delete variables so they aren't used again...
      EvalState a
st{ stateReference :: Reference a
stateReference =
                  let Reference ItemId
id' Text
type' Maybe DisambiguationData
d' Map Variable (Val a)
m' = forall a. EvalState a -> Reference a
stateReference EvalState a
st
                   in forall a.
ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
Reference ItemId
id' Text
type' Maybe DisambiguationData
d' (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Variable
v -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Variable
v forall {a}. Val a
SubstitutedVal) Map Variable (Val a)
m' [Variable]
vars) }

-- Numbers with prefixes or suffixes are never ordinalized
-- or rendered in roman numerals (e.g. “2E” remains “2E).
-- Numbers without affixes are individually transformed
-- (“2, 3” can become “2nd, 3rd”, “second, third” or “ii, iii”).
-- So, first we split on punctuation and spaces:
splitNums :: Text -> [Val a]
splitNums :: forall a. Text -> [Val a]
splitNums = forall a b. (a -> b) -> [a] -> [b]
map forall a. Text -> Val a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy Char -> Char -> Bool
sameClass
 where
  go :: Text -> Val a
go Text
t = case Text -> Maybe Int
readAsInt Text
t of
           Just Int
i  -> forall a. Int -> Val a
NumVal Int
i
           Maybe Int
Nothing -> forall a. Text -> Val a
TextVal forall a b. (a -> b) -> a -> b
$ if Text
t forall a. Eq a => a -> a -> Bool
== Text
"-"
                                   then Char -> Text
T.singleton Char
enDash
                                   else Text
t
  sameClass :: Char -> Char -> Bool
sameClass Char
c Char
d = (Char -> Bool
isSepPunct Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c) forall a. Eq a => a -> a -> Bool
==
                  (Char -> Bool
isSepPunct Char
d Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
d)

--- punctuation that separates pages in a range
isSepPunct :: Char -> Bool
isSepPunct :: Char -> Bool
isSepPunct Char
',' = Bool
True
isSepPunct Char
';' = Bool
True
isSepPunct Char
'-' = Bool
True
isSepPunct Char
'\x2013' = Bool
True
isSepPunct Char
_   = Bool
False

eLabel :: CiteprocOutput a
       => Variable
       -> TermForm
       -> Pluralize
       -> Formatting
       -> Eval a (Output a)
eLabel :: forall a.
CiteprocOutput a =>
Variable
-> TermForm -> Pluralize -> Formatting -> Eval a (Output a)
eLabel Variable
var TermForm
termform Pluralize
pluralize Formatting
formatting = do
  Reference a
ref <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> Reference a
stateReference
  let getTerm :: CiteprocOutput a
              => Text -> Val a -> Eval a (Output a)
      getTerm :: forall a. CiteprocOutput a => Text -> Val a -> Eval a (Output a)
getTerm Text
termname Val a
x = do
        let determinePlural :: Text -> TermNumber
determinePlural Text
t
             | Variable
var forall a. Eq a => a -> a -> Bool
== Variable
"number-of-volumes"
             , Text
t forall a. Eq a => a -> a -> Bool
/= Text
"1" Bool -> Bool -> Bool
&& Text
t forall a. Eq a => a -> a -> Bool
/= Text
"0"      = TermNumber
Plural
             | Text
"\\-" Text -> Text -> Bool
`T.isInfixOf` Text
t     = TermNumber
Singular
             | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Text -> [Val a]
splitNums Text
t) forall a. Ord a => a -> a -> Bool
> Int
1  = TermNumber
Plural
               -- see label_CollapsedPageNumberPluralDetection.txt
             | Bool
otherwise                 = TermNumber
Singular
        let number :: TermNumber
number = case Pluralize
pluralize of
                         Pluralize
AlwaysPluralize     -> TermNumber
Plural
                         Pluralize
NeverPluralize      -> TermNumber
Singular
                         Pluralize
ContextualPluralize ->
                          case Val a
x of
                            TextVal Text
t   -> Text -> TermNumber
determinePlural Text
t
                            FancyVal a
w  -> Text -> TermNumber
determinePlural (forall a. CiteprocOutput a => a -> Text
toText a
w)
                            NamesVal [Name]
ns -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ns forall a. Ord a => a -> a -> Bool
> Int
1
                                              then TermNumber
Plural
                                              else TermNumber
Singular
                            Val a
_ -> TermNumber
Singular
        let term :: Term
term = Term
emptyTerm{ termName :: Text
termName = Text
termname
                            , termForm :: TermForm
termForm = TermForm
termform
                            , termNumber :: Maybe TermNumber
termNumber = forall a. a -> Maybe a
Just TermNumber
number }
        forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term
  Maybe Text
locator <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Maybe Text
contextLocator
  Maybe Text
label <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Maybe Text
contextLabel
  let var' :: Variable
var' = if Variable
var forall a. Eq a => a -> a -> Bool
== Variable
"editortranslator" then Variable
"editor" else Variable
var
  Output a
term' <- case (Variable
var, Maybe Text
locator, Maybe Text
label) of
             (Variable
"locator", Just Text
loc, Just Text
lab) -> forall a. CiteprocOutput a => Text -> Val a -> Eval a (Output a)
getTerm Text
lab (forall a. Text -> Val a
TextVal Text
loc)
             (Variable
"locator", Just Text
loc, Maybe Text
Nothing)
                | Text -> Bool
beginsWithSpace Text
loc -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
                | Text
". " Text -> Text -> Bool
`T.isPrefixOf` (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isLetter Text
loc
                                         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
                | Bool
otherwise              -> forall a. CiteprocOutput a => Text -> Val a -> Eval a (Output a)
getTerm Text
"page" (forall a. Text -> Val a
TextVal Text
loc)
             (Variable, Maybe Text, Maybe Text)
_ -> case forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
var' Reference a
ref of
                         Maybe (Val a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
                         Just Val a
x  -> forall a. CiteprocOutput a => Text -> Val a -> Eval a (Output a)
getTerm (Variable -> Text
fromVariable Variable
var) Val a
x

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    case Formatting -> Maybe Text
formatSuffix Formatting
formatting of
      Just Text
suff
        | Text
"." Text -> Text -> Bool
`T.isPrefixOf` Text
suff
          -> case Output a
term' of
               Literal a
x
                 | Text
"." Text -> Text -> Bool
`T.isSuffixOf` forall a. CiteprocOutput a => a -> Text
toText a
x
                 , Bool -> Bool
not (Formatting -> Bool
formatStripPeriods Formatting
formatting)
                 -> forall a. Formatting -> [Output a] -> Output a
formatted
                     Formatting
formatting{ formatSuffix :: Maybe Text
formatSuffix =
                        if Text -> Int
T.length Text
suff forall a. Ord a => a -> a -> Bool
<= Int
1
                           then forall a. Maybe a
Nothing
                           else forall a. a -> Maybe a
Just (Int -> Text -> Text
T.drop Int
1 Text
suff) }
                     [Output a
term']
               Output a
_ -> forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a
term']
      Maybe Text
_ -> forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a
term']

eDate :: CiteprocOutput a
       => Variable
       -> DateType
       -> Maybe ShowDateParts
       -> [DP]
       -> Formatting
       -> Eval a (Output a)
eDate :: forall a.
CiteprocOutput a =>
Variable
-> DateType
-> Maybe ShowDateParts
-> [DP]
-> Formatting
-> Eval a (Output a)
eDate Variable
var DateType
dateType Maybe ShowDateParts
mbShowDateParts [DP]
dps Formatting
formatting
  | Variable
var forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = do
    forall a. Text -> Eval a ()
warn Text
"skipping date element with no variable attribute set"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
  | Bool
otherwise = do
    Maybe (Val a)
datevar <- forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
var
    Maybe (Element Text)
localeDateElt <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup DateType
dateType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Map DateType (Element Text)
localeDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> Locale
contextLocale)
    let addOverride :: t DP -> DP -> [DP] -> [DP]
addOverride t DP
newdps DP
olddp [DP]
accum =
          case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== DP -> DPName
dpName DP
olddp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DP -> DPName
dpName) t DP
newdps of
            Just DP
x  -> DP
x{ dpFormatting :: Formatting
dpFormatting =
                            DP -> Formatting
dpFormatting DP
olddp forall a. Semigroup a => a -> a -> a
<> DP -> Formatting
dpFormatting DP
x } forall a. a -> [a] -> [a]
: [DP]
accum
            Maybe DP
Nothing -> DP
olddp forall a. a -> [a] -> [a]
: [DP]
accum
    let useDatePart :: DP -> Bool
useDatePart DP
dp =
          case Maybe ShowDateParts
mbShowDateParts of
            Just ShowDateParts
Year      -> DP -> DPName
dpName DP
dp forall a. Eq a => a -> a -> Bool
== DPName
DPYear
            Just ShowDateParts
YearMonth -> DP -> DPName
dpName DP
dp forall a. Eq a => a -> a -> Bool
== DPName
DPYear Bool -> Bool -> Bool
|| DP -> DPName
dpName DP
dp forall a. Eq a => a -> a -> Bool
== DPName
DPMonth
            Maybe ShowDateParts
_              -> Bool
True
    let ([DP]
dps', Formatting
formatting') =
          case Maybe (Element Text)
localeDateElt of
            Just (Element (EDate Variable
_ DateType
_ Maybe ShowDateParts
_ [DP]
edps) Formatting
f)
              -> (forall a. (a -> Bool) -> [a] -> [a]
filter DP -> Bool
useDatePart forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {t :: * -> *}. Foldable t => t DP -> DP -> [DP] -> [DP]
addOverride [DP]
dps) [] [DP]
edps,
                   Formatting
formatting forall a. Semigroup a => a -> a -> a
<> Formatting
f)
            Maybe (Element Text)
_ -> (forall a. (a -> Bool) -> [a] -> [a]
filter DP -> Bool
useDatePart [DP]
dps, Formatting
formatting)
    case Maybe (Val a)
datevar of
      Maybe (Val a)
Nothing ->
        -- warn $ "date element for empty variable " <> var
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
      Just (DateVal Date
date) ->
        case Date -> Maybe Text
dateLiteral Date
date of
          Just Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting' [forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText Text
t]
          Maybe Text
Nothing -> do
            let dateparts :: [DateParts]
dateparts = case Date -> Maybe Int
dateSeason Date
date of
                              Just Int
i  ->
                                case Date -> [DateParts]
dateParts Date
date of
                                  [DateParts [Int
y]] ->
                                    [[Int] -> DateParts
DateParts [Int
y, Int
12 forall a. Num a => a -> a -> a
+ Int
i]] -- pseudo-mo
                                  [DateParts]
xs    -> [DateParts]
xs
                              Maybe Int
Nothing -> Date -> [DateParts]
dateParts Date
date
            [Output a]
xs <- forall a.
CiteprocOutput a =>
[DP] -> (DateParts, Maybe DateParts) -> Eval a [Output a]
formatDateParts [DP]
dps'
                    forall a b. (a -> b) -> a -> b
$ case [DateParts]
dateparts of
                        [] -> ([Int] -> DateParts
DateParts [], forall a. Maybe a
Nothing)
                        [DateParts
d] -> (DateParts
d, forall a. Maybe a
Nothing)
                        (DateParts
d:DateParts
e:[DateParts]
_) -> (DateParts
d, forall a. a -> Maybe a
Just DateParts
e)
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== forall a. Output a
NullOutput) [Output a]
xs) forall a b. (a -> b) -> a -> b
$
              -- back off on the claim to nonemptiness
              -- when the only match are in date parts that
              -- we aren't printing; see
              -- group_SuppressTermWhenNoOutputFromPartialDate.txt
              forall a. Int -> Int -> Eval a ()
updateVarCount Int
0 (-Int
1)

            Maybe (Output a)
yearSuffix <- forall a. CiteprocOutput a => Eval a (Maybe (Output a))
getYearSuffix
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Tag -> Output a -> Output a
Tagged (Date -> Tag
TagDate Date
date) forall a b. (a -> b) -> a -> b
$ forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting'
                      ([Output a]
xs forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (Output a)
yearSuffix)
      Just Val a
_ -> do
        forall a. Text -> Eval a ()
warn forall a b. (a -> b) -> a -> b
$ Text
"date element for variable with non-date value " forall a. Semigroup a => a -> a -> a
<>
                Variable -> Text
fromVariable Variable
var
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput


getYearSuffix :: CiteprocOutput a => Eval a (Maybe (Output a))
getYearSuffix :: forall a. CiteprocOutput a => Eval a (Maybe (Output a))
getYearSuffix = do
  Maybe DisambiguationData
disamb <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets (forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EvalState a -> Reference a
stateReference)
  StyleOptions
sopts <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> StyleOptions
contextStyleOptions
  -- we only want year suffix on first occurence of year
  -- in a reference:
  Bool
usedYearSuffix <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> Bool
stateUsedYearSuffix
  case Maybe DisambiguationData
disamb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DisambiguationData -> Maybe Int
disambYearSuffix of
    Just Int
c
      | Bool -> Bool
not (StyleOptions -> Bool
styleUsesYearSuffixVariable StyleOptions
sopts)
      , Bool -> Bool
not Bool
usedYearSuffix
      -> do
        forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify forall a b. (a -> b) -> a -> b
$ \EvalState a
st -> EvalState a
st{ stateUsedYearSuffix :: Bool
stateUsedYearSuffix = Bool
True }
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Tag -> Output a -> Output a
Tagged (Int -> Tag
TagYearSuffix Int
c)
                         (forall a. a -> Output a
Literal (forall a. CiteprocOutput a => Text -> a
fromText (Int -> Text
showYearSuffix Int
c)))
      | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Maybe Int
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

formatSortDate :: CiteprocOutput a
               => [DP] -> (Maybe Int, Maybe Int, Maybe Int) -> Output a
formatSortDate :: forall a.
CiteprocOutput a =>
[DP] -> (Maybe Int, Maybe Int, Maybe Int) -> Output a
formatSortDate [DP]
dpSpecs (Maybe Int
mbyr, Maybe Int
mbmo, Maybe Int
mbda) =
  forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$  String
sortyr forall a. Semigroup a => a -> a -> a
<> String
sortmo forall a. Semigroup a => a -> a -> a
<> String
sortda
 where
  sortyr :: String
sortyr = case Maybe Int
mbyr of
             Just Int
yr | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== DPName
DPYear) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DP -> DPName
dpName) [DP]
dpSpecs
                -> forall r. PrintfType r => String -> r
printf String
"%04d" (Int
yr forall a. Num a => a -> a -> a
+ Int
5000) -- to work with BC and AD
             Maybe Int
_  -> String
""
  sortmo :: String
sortmo = case Maybe Int
mbmo of
             Just Int
mo | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== DPName
DPMonth) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DP -> DPName
dpName) [DP]
dpSpecs
                -> forall r. PrintfType r => String -> r
printf String
"%02d" Int
mo
             Maybe Int
_  -> String
""
  sortda :: String
sortda = case Maybe Int
mbda of
             Just Int
da | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== DPName
DPDay) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DP -> DPName
dpName) [DP]
dpSpecs
                -> forall r. PrintfType r => String -> r
printf String
"%02d" Int
da
             Maybe Int
_  -> String
""

formatDateParts :: CiteprocOutput a
          => [DP] -> (DateParts, Maybe DateParts) -> Eval a [Output a]
formatDateParts :: forall a.
CiteprocOutput a =>
[DP] -> (DateParts, Maybe DateParts) -> Eval a [Output a]
formatDateParts [DP]
dpSpecs (DateParts
date, Maybe DateParts
mbNextDate) = do
  Bool
inSortKey <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInSortKey
  let (Maybe Int
yr,Maybe Int
mo,Maybe Int
da) = DateParts -> (Maybe Int, Maybe Int, Maybe Int)
bindDateParts DateParts
date
  case DateParts -> (Maybe Int, Maybe Int, Maybe Int)
bindDateParts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DateParts
mbNextDate of
    Maybe (Maybe Int, Maybe Int, Maybe Int)
Nothing
      | Bool
inSortKey -> forall (m :: * -> *) a. Monad m => a -> m a
return [forall a.
CiteprocOutput a =>
[DP] -> (Maybe Int, Maybe Int, Maybe Int) -> Output a
formatSortDate [DP]
dpSpecs (Maybe Int
yr, Maybe Int
mo, Maybe Int
da)]
      | Bool
otherwise -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da)) [DP]
dpSpecs
    Just (Maybe Int
nextyr, Maybe Int
nextmo, Maybe Int
nextda)
      | Bool
inSortKey -> forall (m :: * -> *) a. Monad m => a -> m a
return [forall a.
CiteprocOutput a =>
[DP] -> (Maybe Int, Maybe Int, Maybe Int) -> Output a
formatSortDate [DP]
dpSpecs (Maybe Int
yr, Maybe Int
mo, Maybe Int
da),
                             forall a. a -> Output a
Literal (forall a. CiteprocOutput a => Text -> a
fromText Text
"-"),
                             forall a.
CiteprocOutput a =>
[DP] -> (Maybe Int, Maybe Int, Maybe Int) -> Output a
formatSortDate [DP]
dpSpecs (Maybe Int
nextyr, Maybe Int
nextmo, Maybe Int
nextda)]
      | Bool
otherwise -> do
        let isOpenRange :: Bool
isOpenRange = Maybe Int
nextyr forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0 Bool -> Bool -> Bool
&&
                          forall a. Maybe a -> Bool
isNothing Maybe Int
nextmo Bool -> Bool -> Bool
&&
                          forall a. Maybe a -> Bool
isNothing Maybe Int
nextda
        -- figure out where the range goes:
        -- first to differ out of the items selected by dpSpecs, in order y->m->d
        let dpToNs :: DPName -> (Maybe Int, Maybe Int)
dpToNs DPName
DPYear  = (Maybe Int
yr, Maybe Int
nextyr)
            dpToNs DPName
DPMonth = (Maybe Int
mo, Maybe Int
nextmo)
            dpToNs DPName
DPDay   = (Maybe Int
da, Maybe Int
nextda)
        let areSame :: [DPName]
areSame = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPName -> (Maybe Int, Maybe Int)
dpToNs) forall a b. (a -> b) -> a -> b
$
                        forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DP -> DPName
dpName [DP]
dpSpecs
        let ([DP]
sames1, [DP]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\DP
dp -> DP -> DPName
dpName DP
dp forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DPName]
areSame) [DP]
dpSpecs
        let ([DP]
diffs, [DP]
sames2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\DP
dp -> DP -> DPName
dpName DP
dp forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [DPName]
areSame) [DP]
rest
        let cleanup :: [Output a] -> [Output a]
cleanup = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= forall a. Output a
NullOutput)
        [Output a]
sames1' <- [Output a] -> [Output a]
cleanup 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 a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da)) [DP]
sames1
        [Output a]
diffsLeft' <- [Output a] -> [Output a]
cleanup 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 a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da)) [DP]
diffs
        [Output a]
diffsRight' <- [Output a] -> [Output a]
cleanup 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 a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
nextyr,Maybe Int
nextmo,Maybe Int
nextda)) [DP]
diffs
        [Output a]
sames2' <- [Output a] -> [Output a]
cleanup 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 a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da)) [DP]
sames2
        let rangeDelim :: Maybe Text
rangeDelim = case forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn DP -> DPName
dpName [DP]
diffs of
                                []     -> forall a. Maybe a
Nothing
                                (DP
dp:[DP]
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DP -> Text
dpRangeDelimiter DP
dp
        let toRange :: [Output a] -> [Output a] -> [Output a]
toRange [Output a]
xs [Output a]
ys =
              case forall a. [a] -> Maybe a
lastMay [Output a]
xs of
                Just Output a
xlast ->
                     forall a. [a] -> [a]
initSafe [Output a]
xs forall a. [a] -> [a] -> [a]
++
                       [forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
rangeDelim }
                       [Output a
xlast, forall a. a -> [a] -> a
headDef (forall a. a -> Output a
Literal forall a. Monoid a => a
mempty) [Output a]
ys]] forall a. [a] -> [a] -> [a]
++
                     forall a. [a] -> [a]
tailSafe [Output a]
ys
                Maybe (Output a)
_ -> [Output a]
xs forall a. [a] -> [a] -> [a]
++ [Output a]
ys

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          if Bool
isOpenRange
             then [forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatSuffix :: Maybe Text
formatSuffix = Maybe Text
rangeDelim }
                      (forall a. [Output a] -> [Output a]
removeLastSuffix forall a b. (a -> b) -> a -> b
$ [Output a]
sames1' forall a. [a] -> [a] -> [a]
++ [Output a]
diffsLeft')]
             else forall a. [Output a] -> [Output a]
removeLastSuffix forall a b. (a -> b) -> a -> b
$
                   [Output a]
sames1' forall a. [a] -> [a] -> [a]
++
                   forall {a}. Monoid a => [Output a] -> [Output a] -> [Output a]
toRange (forall a. [Output a] -> [Output a]
removeLastSuffix [Output a]
diffsLeft')
                           (forall a. [Output a] -> [Output a]
removeFirstPrefix [Output a]
diffsRight') forall a. [a] -> [a] -> [a]
++
                   [Output a]
sames2'

removeFirstPrefix :: [Output a] -> [Output a]
removeFirstPrefix :: forall a. [Output a] -> [Output a]
removeFirstPrefix (Formatted Formatting
f [Output a]
xs : [Output a]
rest) =
  forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatPrefix :: Maybe Text
formatPrefix = forall a. Maybe a
Nothing } [Output a]
xs forall a. a -> [a] -> [a]
: [Output a]
rest
removeFirstPrefix [Output a]
xs = [Output a]
xs

removeLastSuffix :: [Output a] -> [Output a]
removeLastSuffix :: forall a. [Output a] -> [Output a]
removeLastSuffix [] = []
removeLastSuffix [Formatted Formatting
f [Output a]
xs] =
  [forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatSuffix :: Maybe Text
formatSuffix = forall a. Maybe a
Nothing } [Output a]
xs ]
removeLastSuffix (Output a
x:[Output a]
xs) = Output a
x forall a. a -> [a] -> [a]
: forall a. [Output a] -> [Output a]
removeLastSuffix [Output a]
xs

eDP :: CiteprocOutput a
    => (Maybe Int, Maybe Int, Maybe Int) ->  DP -> Eval a (Output a)
eDP :: forall a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da) DP
dp = do
  let mbn :: Maybe Int
mbn = case DP -> DPName
dpName DP
dp of
               DPName
DPDay   -> Maybe Int
da
               DPName
DPMonth -> Maybe Int
mo
               DPName
DPYear  -> Maybe Int
yr
  case Maybe Int
mbn of
    Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
    Just Int
0 | DP -> DPName
dpName DP
dp forall a. Eq a => a -> a -> Bool
== DPName
DPYear
            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a. Monoid a => a
mempty -- open date range
    Just Int
n  -> do
      let litStr :: String -> Eval a (Output a)
litStr = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Output a
Literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => Text -> a
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      [Output a]
suffix <- case DP -> DPName
dpName DP
dp of
                  DPName
DPYear
                    | Int
n forall a. Ord a => a -> a -> Bool
< Int
0
                      -> (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
emptyTerm{ termName :: Text
termName = Text
"bc" }
                    | Int
n forall a. Ord a => a -> a -> Bool
> Int
0
                    , Int
n forall a. Ord a => a -> a -> Bool
< Int
1000
                      -> (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
emptyTerm{ termName :: Text
termName = Text
"ad" }
                    | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return []
                  DPName
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
      let n' :: Int
n' = case DP -> DPName
dpName DP
dp of
                 DPName
DPYear -> forall a. Num a => a -> a
abs Int
n
                 DPName
_      -> Int
n
      forall a. Formatting -> [Output a] -> Output a
formatted (DP -> Formatting
dpFormatting DP
dp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[Output a]
suffix) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          case DP -> DPForm
dpForm DP
dp of
            DPForm
DPNumeric             -> String -> Eval a (Output a)
litStr (forall a. Show a => a -> String
show Int
n')
            DPForm
DPNumericLeadingZeros -> String -> Eval a (Output a)
litStr (forall r. PrintfType r => String -> r
printf String
"%02d" Int
n')
            DPForm
DPOrdinal             -> do
              Locale
locale <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Locale
contextLocale
              if Locale -> Maybe Bool
localeLimitDayOrdinalsToDay1 Locale
locale forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True Bool -> Bool -> Bool
&& Int
n' forall a. Eq a => a -> a -> Bool
/= Int
1
                 then String -> Eval a (Output a)
litStr (forall a. Show a => a -> String
show Int
n')
                 else forall a.
CiteprocOutput a =>
NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
NumberOrdinal forall a. Maybe a
Nothing (forall a. Int -> Val a
NumVal Int
n')
            DPForm
form -> do
              let termForMonth :: String -> Term
termForMonth String
s = Term
emptyTerm{ termName :: Text
termName = String -> Text
T.pack String
s
                                            , termForm :: TermForm
termForm = if DPForm
form forall a. Eq a => a -> a -> Bool
== DPForm
DPShort
                                                            then TermForm
Short
                                                            else TermForm
Long }

              case DP -> DPName
dpName DP
dp of
                DPName
DPMonth | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
                        | Int
n forall a. Ord a => a -> a -> Bool
<= Int
12 ->
                  forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' forall a b. (a -> b) -> a -> b
$ String -> Term
termForMonth (forall r. PrintfType r => String -> r
printf String
"month-%02d" Int
n)
                        | Int
n forall a. Ord a => a -> a -> Bool
<= Int
16 -> -- season pseudo-month
                  forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' forall a b. (a -> b) -> a -> b
$ String -> Term
termForMonth (forall r. PrintfType r => String -> r
printf String
"season-%02d" (Int
n forall a. Num a => a -> a -> a
- Int
12))
                        | Int
n forall a. Ord a => a -> a -> Bool
<= Int
20 -> -- season pseudo-month
                  forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' forall a b. (a -> b) -> a -> b
$ String -> Term
termForMonth (forall r. PrintfType r => String -> r
printf String
"season-%02d" (Int
n forall a. Num a => a -> a -> a
- Int
16))
                        | Bool
otherwise -> -- season pseudo-month
                  forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' forall a b. (a -> b) -> a -> b
$ String -> Term
termForMonth (forall r. PrintfType r => String -> r
printf String
"season-%02d" (Int
n forall a. Num a => a -> a -> a
- Int
20))
                DPName
_                 -> String -> Eval a (Output a)
litStr (forall a. Show a => a -> String
show Int
n')


bindDateParts :: DateParts -> (Maybe Int, Maybe Int, Maybe Int)
bindDateParts :: DateParts -> (Maybe Int, Maybe Int, Maybe Int)
bindDateParts DateParts
date =
      case DateParts
date of
        DateParts (Int
y:Int
m:Int
d:[Int]
_) -> (forall a. a -> Maybe a
Just Int
y,forall a. a -> Maybe a
Just Int
m,forall a. a -> Maybe a
Just Int
d)
        DateParts [Int
y,Int
m]     -> (forall a. a -> Maybe a
Just Int
y,forall a. a -> Maybe a
Just Int
m,forall a. Maybe a
Nothing)
        DateParts [Int
y]       -> (forall a. a -> Maybe a
Just Int
y,forall a. Maybe a
Nothing,forall a. Maybe a
Nothing)
        DateParts
_                   -> (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing,forall a. Maybe a
Nothing)

eNames :: CiteprocOutput a
        => [Variable]
        -> NamesFormat
        -> [Element a]
        -> Formatting
        -> Eval a (Output a)
eNames :: forall a.
CiteprocOutput a =>
[Variable]
-> NamesFormat -> [Element a] -> Formatting -> Eval a (Output a)
eNames [Variable]
vars NamesFormat
namesFormat' [Element a]
subst Formatting
formatting = do
  Maybe NamesFormat
substituteNamesForm <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Maybe NamesFormat
contextSubstituteNamesForm
  Bool
inSortKey <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInSortKey
  let namesFormat :: NamesFormat
namesFormat =
        case Maybe NamesFormat
substituteNamesForm of
          Maybe NamesFormat
Nothing -> NamesFormat
namesFormat'
          Just NamesFormat
subs ->
            NamesFormat
            { namesLabel :: Maybe (TermForm, Pluralize, Formatting)
namesLabel           =
                if Bool
inSortKey -- see test/csl/sort_DropNameLabelInSort.txt
                   -- though this doesn't seem to be in the spec
                   then forall a. Maybe a
Nothing
                   else NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
namesFormat' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
subs
            , namesEtAl :: Maybe (Text, Formatting)
namesEtAl            = NamesFormat -> Maybe (Text, Formatting)
namesEtAl NamesFormat
namesFormat' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                       NamesFormat -> Maybe (Text, Formatting)
namesEtAl NamesFormat
subs
            , namesName :: Maybe (NameFormat, Formatting)
namesName            = NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
namesFormat' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                       NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
subs
            , namesLabelBeforeName :: Bool
namesLabelBeforeName =
                if forall a. Maybe a -> Bool
isJust (NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
namesFormat') Bool -> Bool -> Bool
&&
                   forall a. Maybe a -> Bool
isJust (NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
namesFormat')
                   then NamesFormat -> Bool
namesLabelBeforeName NamesFormat
namesFormat'
                   else NamesFormat -> Bool
namesLabelBeforeName NamesFormat
subs
            }

  [Variable]
vars' <- if Variable
"editor" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
vars Bool -> Bool -> Bool
&& Variable
"translator" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
vars
              then do
                Maybe (Val a)
ed <- forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
"editor"
                Maybe (Val a)
tr <- forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
"translator"
                let termform :: TermForm
termform =
                      case NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
namesFormat of
                        Just (TermForm
termform', Pluralize
_, Formatting
_) -> TermForm
termform'
                        Maybe (TermForm, Pluralize, Formatting)
_ -> TermForm
Long
                Output a
mbterm <- forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm'
                            Term
emptyTerm{ termName :: Text
termName = Text
"editortranslator"
                                     , termForm :: TermForm
termForm = TermForm
termform }
                if Maybe (Val a)
ed forall a. Eq a => a -> a -> Bool
== Maybe (Val a)
tr Bool -> Bool -> Bool
&& Output a
mbterm forall a. Eq a => a -> a -> Bool
/= forall a. Output a
NullOutput
                   then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Variable
"editortranslator" forall a. a -> [a] -> [a]
:
                        [Variable
v | Variable
v <- [Variable]
vars
                           , Variable
v forall a. Eq a => a -> a -> Bool
/= Variable
"editor"
                           , Variable
v forall a. Eq a => a -> a -> Bool
/= Variable
"translator"]
                   else forall (m :: * -> *) a. Monad m => a -> m a
return [Variable]
vars
              else forall (m :: * -> *) a. Monad m => a -> m a
return [Variable]
vars
  Bool
inSubstitute <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInSubstitute
  let (NameFormat
nameFormat, Formatting
nameFormatting') =
        forall a. a -> Maybe a -> a
fromMaybe (NameFormat
defaultNameFormat, forall a. Monoid a => a
mempty) (NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
namesFormat)
  let nameFormatting :: Formatting
nameFormatting = Formatting
nameFormatting' forall a. Semigroup a => a -> a -> a
<>
                       Formatting
formatting{ formatPrefix :: Maybe Text
formatPrefix = forall a. Maybe a
Nothing
                                 , formatSuffix :: Maybe Text
formatSuffix = forall a. Maybe a
Nothing
                                 , formatDelimiter :: Maybe Text
formatDelimiter = forall a. Maybe a
Nothing }
  [(Variable, Maybe (Val a))]
rawContribs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Variable
var -> (Variable
var,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable
                       (if Variable
var forall a. Eq a => a -> a -> Bool
== Variable
"editortranslator"
                           then Variable
"editor"
                           else Variable
var)) [Variable]
vars'
  if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Variable, Maybe (Val a))]
rawContribs
     then
       case [Element a]
subst of
         els :: [Element a]
els@(Element a
_:[Element a]
_) | Bool -> Bool
not Bool
inSubstitute -> do
           [Output a]
res <- forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST
                  (\Context a
ctx EvalState a
st -> (Context a
ctx{ contextInSubstitute :: Bool
contextInSubstitute = Bool
True
                                  , contextSubstituteNamesForm :: Maybe NamesFormat
contextSubstituteNamesForm =
                                      forall a. a -> Maybe a
Just NamesFormat
namesFormat },
                               EvalState a
st)) forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => [Element a] -> Eval a [Output a]
eSubstitute [Element a]
els
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
             case [Output a]
res of
               (Tagged TagNames{} Output a
_:[Output a]
_) -> forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a]
res
               -- important to have title (or whatever) tagged as
               -- substituting for Names, for purposes of
               -- disambiguation:
               [Output a]
_ -> forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting
                    [forall a. Tag -> Output a -> Output a
Tagged (Variable -> NamesFormat -> [Name] -> Tag
TagNames Variable
"" NamesFormat
namesFormat []) forall a b. (a -> b) -> a -> b
$ forall a. [Output a] -> Output a
grouped [Output a]
res]
         [Element a]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
     else do
        [Output a]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
CiteprocOutput a =>
NamesFormat
-> NameFormat
-> Formatting
-> (Variable, Maybe (Val a))
-> Eval a (Output a)
formatNames NamesFormat
namesFormat NameFormat
nameFormat Formatting
nameFormatting)
               [(Variable, Maybe (Val a))]
rawContribs
        forall a. [Variable] -> Eval a ()
deleteSubstitutedVariables [Variable
v | (Variable
v, Just Val a
_) <- [(Variable, Maybe (Val a))]
rawContribs ]

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          case NameFormat -> NameForm
nameForm NameFormat
nameFormat of
             NameForm
CountName -> forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length
               [Name
name
                 | Tagged (TagName Name
name) Output a
_ <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall on. Uniplate on => on -> [on]
universe [Output a]
xs]
             NameForm
_ -> forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix = Formatting -> Maybe Text
formatPrefix Formatting
formatting
                                  , formatSuffix :: Maybe Text
formatSuffix = Formatting -> Maybe Text
formatSuffix Formatting
formatting
                                  , formatDelimiter :: Maybe Text
formatDelimiter =
                                    Formatting -> Maybe Text
formatDelimiter Formatting
formatting } [Output a]
xs

eSubstitute :: CiteprocOutput a
            => [Element a]
            -> Eval a [Output a]
eSubstitute :: forall a. CiteprocOutput a => [Element a] -> Eval a [Output a]
eSubstitute [Element a]
els =
  case [Element a]
els of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    (Element a
e:[Element a]
es) -> do
      [Output a]
res <- forall a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement Element a
e
      case forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= forall a. Output a
NullOutput) [Output a]
res of
        [] -> forall a. CiteprocOutput a => [Element a] -> Eval a [Output a]
eSubstitute [Element a]
es
        [Output a]
xs -> forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
xs

formatNames :: CiteprocOutput a
            => NamesFormat
            -> NameFormat
            -> Formatting
            -> (Variable, Maybe (Val a))
            -> Eval a (Output a)
formatNames :: forall a.
CiteprocOutput a =>
NamesFormat
-> NameFormat
-> Formatting
-> (Variable, Maybe (Val a))
-> Eval a (Output a)
formatNames NamesFormat
namesFormat NameFormat
nameFormat Formatting
formatting (Variable
var, Just (NamesVal [Name]
names)) =
  do
  Bool
isSubsequent <- (Position
Subsequent forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> [Position]
contextPosition
  Bool
isInBibliography <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInBibliography
  let (Maybe Int
etAlMin, Maybe Int
etAlUseFirst) =
        if Bool -> Bool
not Bool
isInBibliography Bool -> Bool -> Bool
&& Bool
isSubsequent
           then (NameFormat -> Maybe Int
nameEtAlSubsequentMin NameFormat
nameFormat forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NameFormat -> Maybe Int
nameEtAlMin NameFormat
nameFormat,
                 NameFormat -> Maybe Int
nameEtAlSubsequentUseFirst NameFormat
nameFormat forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    NameFormat -> Maybe Int
nameEtAlUseFirst NameFormat
nameFormat)
           else (NameFormat -> Maybe Int
nameEtAlMin NameFormat
nameFormat, NameFormat -> Maybe Int
nameEtAlUseFirst NameFormat
nameFormat)
  Bool
inSortKey <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInSortKey
  Maybe DisambiguationData
disamb <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets (forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EvalState a -> Reference a
stateReference)
  [Output a]
names' <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (forall a.
CiteprocOutput a =>
NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
formatName NameFormat
nameFormat Formatting
formatting) [Int
1..] [Name]
names
  let delim' :: Text
delim' = forall a. a -> Maybe a -> a
fromMaybe (NameFormat -> Text
nameDelimiter NameFormat
nameFormat) forall a b. (a -> b) -> a -> b
$
                 Formatting -> Maybe Text
formatDelimiter Formatting
formatting
  let delim :: Text
delim = case (Text -> Bool
beginsWithSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Formatting -> Maybe Text
formatSuffix Formatting
formatting,
                    Text -> Bool
endsWithSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Formatting -> Maybe Text
formatPrefix Formatting
formatting) of
                    (Just Bool
True, Just Bool
True) -> Text -> Text
T.strip Text
delim'
                    (Just Bool
True, Maybe Bool
_)         -> Text -> Text
T.stripStart Text
delim'
                    (Maybe Bool
_, Just Bool
True)         -> Text -> Text
T.stripEnd Text
delim'
                    (Maybe Bool, Maybe Bool)
_                      -> Text
delim'
  let numnames :: Int
numnames = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
names'
  [Output a]
label <- case NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
namesFormat of
             Just (TermForm
termform, Pluralize
pluralize, Formatting
lf) | Bool -> Bool
not Bool
inSortKey ->
               (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
CiteprocOutput a =>
Variable
-> TermForm -> Pluralize -> Formatting -> Eval a (Output a)
eLabel Variable
var TermForm
termform Pluralize
pluralize Formatting
lf
             Maybe (TermForm, Pluralize, Formatting)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
  Maybe Text
mbAndTerm <- case NameFormat -> Maybe TermForm
nameAndStyle NameFormat
nameFormat of
                  Just TermForm
Symbol -> do
                    [(Term, Text)]
ts <- forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = Text
"and"
                                               , termForm :: TermForm
termForm = TermForm
Symbol }
                    case [(Term, Text)]
ts of
                      (Term
_,Text
x):[(Term, Text)]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
x
                      []      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"&"
                  Just TermForm
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = Text
"and"
                                                   , termForm :: TermForm
termForm = TermForm
Long }
                  Maybe TermForm
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  let finalNameIsOthers :: Bool
finalNameIsOthers = (forall a. [a] -> Maybe a
lastMay [Name]
names forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> Maybe Text
nameLiteral) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"others"
        -- bibtex conversions often have this, and we want to render it "et al"
  let etAlUseLast :: Bool
etAlUseLast = NameFormat -> Bool
nameEtAlUseLast NameFormat
nameFormat
  let etAlThreshold :: Maybe Int
etAlThreshold = case Maybe Int
etAlMin of
                        Just Int
x | Int
numnames forall a. Ord a => a -> a -> Bool
>= Int
x
                          -> case (Maybe DisambiguationData
disamb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DisambiguationData -> Maybe Int
disambEtAlNames, Maybe Int
etAlUseFirst) of
                               (Just Int
n, Just Int
m) -> forall a. a -> Maybe a
Just (forall a. Ord a => a -> a -> a
max Int
m Int
n)
                               (Maybe Int
_, Maybe Int
y) -> Maybe Int
y
                               | Int
numnames forall a. Ord a => a -> a -> Bool
< Int
x
                               , Bool
finalNameIsOthers -> forall a. a -> Maybe a
Just (Int
numnames forall a. Num a => a -> a -> a
- Int
1)
                        Maybe Int
_ -> forall a. Maybe a
Nothing
  let beforeLastDelim :: Text
beforeLastDelim =
        case Maybe Text
mbAndTerm of
          Maybe Text
Nothing -> Text
delim
          Just Text
_ ->
             case NameFormat -> DelimiterPrecedes
nameDelimiterPrecedesLast NameFormat
nameFormat of
                DelimiterPrecedes
PrecedesContextual
                  | Int
numnames forall a. Ord a => a -> a -> Bool
> Int
2          -> Text
delim
                  | Bool
otherwise             -> Text
""
                DelimiterPrecedes
PrecedesAfterInvertedName
                  -> case NameFormat -> Maybe NameAsSortOrder
nameAsSortOrder NameFormat
nameFormat of
                       Just NameAsSortOrder
NameAsSortOrderAll -> Text
delim
                       Just NameAsSortOrder
NameAsSortOrderFirst
                         | Int
numnames forall a. Ord a => a -> a -> Bool
< Int
3        -> Text
delim
                       Maybe NameAsSortOrder
_                       -> Text
""
                DelimiterPrecedes
PrecedesAlways            -> Text
delim
                DelimiterPrecedes
PrecedesNever             -> Text
""
  let andPreSpace :: Text
andPreSpace = case Text
beforeLastDelim of
        Text
"" -> case Formatting -> Maybe Text
formatSuffix Formatting
formatting of
                Just Text
t | Text -> Bool
endsWithSpace Text
t -> Text
""
                Maybe Text
_ -> Text
" "
        Text
t | Text -> Bool
endsWithSpace Text
t -> Text
""
        Text
_  -> Text
" "
  let andPostSpace :: Text
andPostSpace = case Formatting -> Maybe Text
formatPrefix Formatting
formatting of
                       Just Text
t | Text -> Bool
beginsWithSpace Text
t -> Text
""
                       Maybe Text
_ -> Text
" "
  let mbAndDelim :: Maybe Text
mbAndDelim = case Maybe Text
mbAndTerm of
                         Maybe Text
Nothing -> forall a. Maybe a
Nothing
                         Just Text
t  -> forall a. a -> Maybe a
Just (Text
andPreSpace forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
andPostSpace)
  let etAlPreSpace :: Text
etAlPreSpace = case Formatting -> Maybe Text
formatSuffix Formatting
formatting of
                       Just Text
t | Text -> Bool
endsWithSpace Text
t -> Text
""
                       Maybe Text
_ -> Text
" "
  let beforeEtAl :: Text
beforeEtAl =
        case NameFormat -> DelimiterPrecedes
nameDelimiterPrecedesEtAl NameFormat
nameFormat of
            DelimiterPrecedes
PrecedesContextual
              | Int
numnames forall a. Ord a => a -> a -> Bool
> Int
2
              , Maybe Int
etAlThreshold forall a. Ord a => a -> a -> Bool
> forall a. a -> Maybe a
Just Int
1 -> Text
delim
              | Bool
otherwise              -> Text
etAlPreSpace
            DelimiterPrecedes
PrecedesAfterInvertedName
                  -> case NameFormat -> Maybe NameAsSortOrder
nameAsSortOrder NameFormat
nameFormat of
                       Just NameAsSortOrder
NameAsSortOrderAll  -> Text
delim
                       Just NameAsSortOrder
NameAsSortOrderFirst
                         | Maybe Int
etAlThreshold forall a. Ord a => a -> a -> Bool
< forall a. a -> Maybe a
Just Int
2 -> Text
delim
                       Maybe NameAsSortOrder
_                          -> Text
etAlPreSpace
            DelimiterPrecedes
PrecedesAlways            -> Text
delim
            DelimiterPrecedes
PrecedesNever             -> Text
etAlPreSpace
  Output a
etAl <- case NamesFormat -> Maybe (Text, Formatting)
namesEtAl NamesFormat
namesFormat of
                Just (Text
term, Formatting
f) -> forall a.
CiteprocOutput a =>
Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting Formatting
f{
                    formatPrefix :: Maybe Text
formatPrefix = Text -> Text
removeDoubleSpaces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                      forall a. a -> Maybe a
Just Text
beforeEtAl forall a. Semigroup a => a -> a -> a
<> Formatting -> Maybe Text
formatPrefix Formatting
f } forall a b. (a -> b) -> a -> b
$
                 forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
emptyTerm{ termName :: Text
termName = Text
term }
                Maybe (Text, Formatting)
Nothing
                  | Bool
etAlUseLast Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
finalNameIsOthers ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                      forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix = forall a. a -> Maybe a
Just Text
beforeEtAl }
                        [forall a. CiteprocOutput a => Text -> Output a
literal Text
"\x2026 "] -- ellipses
                  | Bool
otherwise   ->
                      forall a. Formatting -> [Output a] -> Output a
Formatted forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix = forall a. a -> Maybe a
Just Text
beforeEtAl }
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
emptyTerm{ termName :: Text
termName = Text
"et-al" }
  let addNameAndDelim :: Output a -> Int -> Output a
addNameAndDelim Output a
name Int
idx
       | Maybe Int
etAlThreshold forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0 = forall a. Output a
NullOutput
       | Int
idx forall a. Eq a => a -> a -> Bool
== Int
1    = Output a
name
       | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
idx forall a. Num a => a -> a -> a
- Int
1 forall a. Eq a => a -> a -> Bool
==) Maybe Int
etAlThreshold =
         if Bool
inSortKey
            then forall a. Output a
NullOutput
            else Output a
etAl
       | Int
idx forall a. Eq a => a -> a -> Bool
== Int
numnames
       , Bool
etAlUseLast
       , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
idx forall a. Num a => a -> a -> a
- Int
1 forall a. Ord a => a -> a -> Bool
>=) Maybe Int
etAlThreshold
         = Output a
name
       | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
idx forall a. Num a => a -> a -> a
- Int
1 forall a. Ord a => a -> a -> Bool
>) Maybe Int
etAlThreshold = forall a. Output a
NullOutput
       | Bool
inSortKey = Output a
name
       | Int
idx forall a. Eq a => a -> a -> Bool
== Int
numnames
         = forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix =
                       forall a. a -> Maybe a
Just (Text
beforeLastDelim forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mbAndDelim) }
            [Output a
name]
       | Bool
otherwise = forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix = forall a. a -> Maybe a
Just Text
delim } [Output a
name]
  let names'' :: [Output a]
names'' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Output a -> Int -> Output a
addNameAndDelim [Output a]
names' [Int
1..]
  -- we set delimiter to Nothing because we're handling delim
  -- manually, to allow for things like "and" and no final comma
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Tag -> Output a -> Output a
Tagged (Variable -> NamesFormat -> [Name] -> Tag
TagNames Variable
var NamesFormat
namesFormat [Name]
names)
         forall a b. (a -> b) -> a -> b
$ forall a. [Output a] -> Output a
grouped forall a b. (a -> b) -> a -> b
$
           if NamesFormat -> Bool
namesLabelBeforeName NamesFormat
namesFormat
              then [Output a]
label forall a. [a] -> [a] -> [a]
++ [Output a]
names''
              else [Output a]
names'' forall a. [a] -> [a] -> [a]
++ [Output a]
label

formatNames NamesFormat
_ NameFormat
_ Formatting
_ (Variable
var, Just Val a
x) = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Val a
x forall a. Eq a => a -> a -> Bool
/= forall {a}. Val a
SubstitutedVal) forall a b. (a -> b) -> a -> b
$
    forall a. Text -> Eval a ()
warn forall a b. (a -> b) -> a -> b
$ Text
"ignoring non-name value for variable " forall a. Semigroup a => a -> a -> a
<> Variable -> Text
fromVariable Variable
var
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput
formatNames NamesFormat
_ NameFormat
_ Formatting
_ (Variable
_, Maybe (Val a)
Nothing) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput

formatName :: CiteprocOutput a
           => NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
formatName :: forall a.
CiteprocOutput a =>
NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
formatName NameFormat
nameFormat Formatting
formatting Int
order Name
name = do
  Maybe DisambiguationData
disamb <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets (forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EvalState a -> Reference a
stateReference)
  let nameFormat' :: NameFormat
nameFormat' =
        case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambiguationData -> Map Name NameHints
disambNameMap forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe DisambiguationData
disamb of
          Maybe NameHints
Nothing -> NameFormat
nameFormat
          Just NameHints
AddInitials
            -> NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName }
          Just NameHints
AddInitialsIfPrimary
            | Int
order forall a. Eq a => a -> a -> Bool
== Int
1  -> NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName }
            | Bool
otherwise -> NameFormat
nameFormat
          Just NameHints
AddGivenName ->
            NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName
                      , nameInitialize :: Bool
nameInitialize = Bool
False
                      }
          Just NameHints
AddGivenNameIfPrimary
            | Int
order forall a. Eq a => a -> a -> Bool
== Int
1 ->
               NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName
                         , nameInitialize :: Bool
nameInitialize = Bool
False
                         }
            | Bool
otherwise -> NameFormat
nameFormat
  forall a. Tag -> Output a -> Output a
Tagged (Name -> Tag
TagName Name
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    case Name -> Maybe Text
nameLiteral Name
name of
      Just Text
t  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting
                        forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [forall a. CiteprocOutput a => Text -> Output a
literal Text
t]
                          (\Formatting
f -> [forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f [forall a. CiteprocOutput a => Text -> Output a
literal Text
t]])
                          (NameFormat -> Maybe Formatting
nameFamilyFormatting NameFormat
nameFormat)
      Maybe Text
Nothing -> forall a.
CiteprocOutput a =>
NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
getDisplayName NameFormat
nameFormat' Formatting
formatting Int
order Name
name


getNamePartSortOrder :: Name -> Eval a [Text]
getNamePartSortOrder :: forall a. Name -> Eval a [Text]
getNamePartSortOrder Name
name = do
  DemoteNonDroppingParticle
demoteNonDroppingParticle <-
    forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> DemoteNonDroppingParticle
styleDemoteNonDroppingParticle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> StyleOptions
contextStyleOptions)
  forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    case Name -> Maybe Text
nameLiteral Name
name of
      Maybe Text
Nothing
        | Name -> Bool
isByzantineName Name
name
           -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                   case DemoteNonDroppingParticle
demoteNonDroppingParticle of
                     DemoteNonDroppingParticle
DemoteNever ->
                           [Name -> Maybe Text
nameNonDroppingParticle Name
name forall a. Semigroup a => a -> a -> a
<> Name -> Maybe Text
nameFamily Name
name,
                            Name -> Maybe Text
nameDroppingParticle Name
name,
                            Name -> Maybe Text
nameGiven Name
name,
                            Name -> Maybe Text
nameSuffix Name
name]
                     DemoteNonDroppingParticle
_ ->  [Name -> Maybe Text
nameFamily Name
name,
                            Name -> Maybe Text
nameDroppingParticle Name
name forall a. Semigroup a => a -> a -> a
<>
                              Name -> Maybe Text
nameNonDroppingParticle Name
name,
                            Name -> Maybe Text
nameGiven Name
name,
                            Name -> Maybe Text
nameSuffix Name
name]
        | Bool
otherwise
           -> forall (m :: * -> *) a. Monad m => a -> m a
return [Name -> Maybe Text
nameFamily Name
name,
                      Name -> Maybe Text
nameGiven Name
name]
      Just Text
n -> forall (m :: * -> *) a. Monad m => a -> m a
return [forall a. a -> Maybe a
Just Text
n]

literal :: CiteprocOutput a => Text -> Output a
literal :: forall a. CiteprocOutput a => Text -> Output a
literal = forall a. a -> Output a
Literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => Text -> a
fromText

showYearSuffix :: Int -> Text
showYearSuffix :: Int -> Text
showYearSuffix Int
x
  | Int
x forall a. Ord a => a -> a -> Bool
< Int
27    = Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Int -> Char
chr forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ (Int
x forall a. Num a => a -> a -> a
- Int
1)
  | Bool
otherwise =
      let x' :: Int
x' = Int
x forall a. Num a => a -> a -> a
- Int
1
       in String -> Text
T.pack [Int -> Char
chr (Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
+ (Int
x' forall a. Integral a => a -> a -> a
`div` Int
26)),
                  Int -> Char
chr (Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ (Int
x' forall a. Integral a => a -> a -> a
`mod` Int
26))]

initialize :: Maybe Lang
           -> Bool       -- ^ initialize
           -> Bool       -- ^ with hyphen
           -> Text       -- ^ initialize with (suffix)
           -> Text
           -> Text
initialize :: Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
makeInitials Bool
useHyphen Text
initializeWith =
   Text -> Text
stripSpaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
" -" Text
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Either Text Text -> Text
initializeWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Either Text Text]
splitWords
  where
   stripSpaces :: Text -> Text
stripSpaces = (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
==Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
' ') -- preserve nbsp
   -- Left values are already initials
   -- Right values are not
   splitWords :: Text -> [Either Text Text]
splitWords =
     forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([Either Text Text]
ws,String
cs) ->
                  case String
cs of
                    [] -> [Either Text Text]
ws
                    [Char
d] -> forall a b. a -> Either a b
Left (Char -> Text
T.singleton Char
d) forall a. a -> [a] -> [a]
: [Either Text Text]
ws
                    String
_   -> forall a b. b -> Either a b
Right (String -> Text
T.pack (forall a. [a] -> [a]
reverse String
cs)) forall a. a -> [a] -> [a]
: [Either Text Text]
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl'
     (\([Either Text Text]
ws, String
cs) Char
c ->
       case Char
c of
         Char
'.' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs   -> ([Either Text Text]
ws, [])
             | Bool
otherwise -> (forall a b. a -> Either a b
Left (String -> Text
T.pack (forall a. [a] -> [a]
reverse String
cs)) forall a. a -> [a] -> [a]
: [Either Text Text]
ws, [])
         Char
'-' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs   -> ([Either Text Text]
ws, [Char
'-'])
             | Bool
otherwise -> (forall a b. b -> Either a b
Right (String -> Text
T.pack (forall a. [a] -> [a]
reverse String
cs)) forall a. a -> [a] -> [a]
: [Either Text Text]
ws, [Char
'-'])
         Char
' ' -> case String
cs of
                  []  -> ([Either Text Text]
ws, String
cs)
                  [Char
d] -> (forall a b. a -> Either a b
Left (Char -> Text
T.singleton Char
d) forall a. a -> [a] -> [a]
: [Either Text Text]
ws, [])
                  String
_   -> (forall a b. b -> Either a b
Right (String -> Text
T.pack (forall a. [a] -> [a]
reverse String
cs)) forall a. a -> [a] -> [a]
: [Either Text Text]
ws, [])
         Char
_   -> ([Either Text Text]
ws, Char
cforall a. a -> [a] -> [a]
:String
cs))
     ([], forall a. Monoid a => a
mempty)
   addSuffix :: Text -> Text
addSuffix Text
t
     | Text -> Bool
T.null Text
t  = forall a. Monoid a => a
mempty
     | Bool
otherwise = Text
t forall a. Semigroup a => a -> a -> a
<> Text
initializeWith
   toInitial :: Text -> Text
toInitial Text
t =
       case Text -> Maybe (Char, Text)
T.uncons Text
t of
         Just (Char
'-', Text
t') ->
           case Text -> Maybe (Char, Text)
T.uncons Text
t' of
             Just (Char
c, Text
_)
               | Char -> Bool
isUpper Char
c
               , Bool
useHyphen -> Text
"-" forall a. Semigroup a => a -> a -> a
<> Maybe Lang -> Text -> Text
Unicode.toUpper Maybe Lang
mblang (Char -> Text
T.singleton Char
c)
               | Char -> Bool
isUpper Char
c -> Maybe Lang -> Text -> Text
Unicode.toUpper Maybe Lang
mblang (Char -> Text
T.singleton Char
c)
             Maybe (Char, Text)
_ -> forall a. Monoid a => a
mempty  -- e.g. Ji-ping -> J. not J.-p.
         Just (Char
c, Text
t')
           | Char -> Bool
isUpper Char
c ->
             case Text -> Maybe (Char, Text)
T.uncons Text
t' of
               Just (Char
d, Text
t'')
                 | Char -> Bool
isUpper Char
d  -- see test/csl/name_LongAbbreviation.txt
                 , Bool -> Bool
not (Text -> Bool
T.null Text
t'')
                 , (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLower Text
t''
                 -> Char -> Text
T.singleton Char
c forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower (Char -> Text
T.singleton Char
d)
               Maybe (Char, Text)
_ -> Char -> Text
T.singleton Char
c
         Maybe (Char, Text)
_ -> Text
t
   initializeWord :: Either Text Text -> Text
initializeWord (Left Text
t) -- Left values already initialized
     = Text -> Text
addSuffix Text
t
   initializeWord (Right Text
t) -- Right values not already initialized
     | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLower Text
t = if Text -> Bool
endsWithSpace Text
initializeWith
                            then Text
t forall a. Semigroup a => a -> a -> a
<> Text
" "
                            else Text
" " forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
" "
     | Bool
makeInitials    = (Text -> Text
addSuffix forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toInitial) Text
t
     | Bool
otherwise       = Text
t forall a. Semigroup a => a -> a -> a
<> Text
" "

getDisplayName :: CiteprocOutput a
               => NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
getDisplayName :: forall a.
CiteprocOutput a =>
NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
getDisplayName NameFormat
nameFormat Formatting
formatting Int
order Name
name = do
  Bool
inSortKey <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Bool
contextInSortKey
  DemoteNonDroppingParticle
demoteNonDroppingParticle <-
    forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> DemoteNonDroppingParticle
styleDemoteNonDroppingParticle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> StyleOptions
contextStyleOptions)
  Bool
initializeWithHyphen <-
    forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Bool
styleInitializeWithHyphen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> StyleOptions
contextStyleOptions)
  Maybe Lang
mblang <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Maybe Lang
localeLanguage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Context a -> Locale
contextLocale)
  let initialize' :: Text -> Text
initialize' =
        case Name -> Maybe Text
nameFamily Name
name of
          Maybe Text
Nothing -> forall a. a -> a
id
          Just Text
_ ->
            case NameFormat -> Maybe Text
nameInitializeWith NameFormat
nameFormat of
              Just Text
initializeWith ->
                Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize
                Maybe Lang
mblang
                (NameFormat -> Bool
nameInitialize NameFormat
nameFormat)
                Bool
initializeWithHyphen
                Text
initializeWith
              Maybe Text
Nothing -> forall a. a -> a
id
  let separator :: Text
separator = NameFormat -> Text
nameSortSeparator NameFormat
nameFormat
  let Output a
x <+> :: Output a -> Output a -> Output a
<+> Output a
NullOutput = Output a
x
      Output a
NullOutput <+> Output a
x = Output a
x
      Literal a
x <+> Output a
y =
        case Text -> Maybe (Text, Char)
T.unsnoc (forall a. CiteprocOutput a => a -> Text
toText a
x) of
          Just (Text
_, Char
c) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'’' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\x2013' Bool -> Bool -> Bool
||
                        Char
c forall a. Eq a => a -> a -> Bool
== Char
'\xa0' ->
               forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty [forall a. a -> Output a
Literal a
x, Output a
y]
          Maybe (Text, Char)
_ | Name -> Bool
isByzantineName Name
name ->
               forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. a -> Maybe a
Just Text
" " } [forall a. a -> Output a
Literal a
x, Output a
y]
            | Bool
otherwise -> forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty [forall a. a -> Output a
Literal a
x, Output a
y]
      Formatted Formatting
f [Output a]
x <+> Output a
y =
        forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter =
                            case Formatting -> Maybe Text
formatSuffix Formatting
f of
                              Just Text
t | Text -> Bool
endsWithSpace Text
t -> forall a. Maybe a
Nothing
                              Maybe Text
_ -> forall a. a -> Maybe a
Just Text
" " } [forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
x, Output a
y]
      Linked Text
i [Output a]
x <+> Output a
y =
        forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. a -> Maybe a
Just Text
" " } [forall a. Text -> [Output a] -> Output a
Linked Text
i [Output a]
x, Output a
y]
      Tagged Tag
_ Output a
x <+> Output a
y = Output a
x Output a -> Output a -> Output a
<+> Output a
y
      InNote Output a
x <+> Output a
y = Output a
x Output a -> Output a -> Output a
<+> Output a
y
  let Output a
x <:> :: Output a -> Output a -> Output a
<:> Output a
NullOutput = Output a
x
      Output a
NullOutput <:> Output a
x = Output a
x
      Literal a
x <:> Output a
y =
        forall a. Formatting -> [Output a] -> Output a
formatted forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. a -> Maybe a
Just Text
separator } [forall a. a -> Output a
Literal a
x, Output a
y]
      Formatted Formatting
f [Output a]
x <:> Output a
y = forall a. Formatting -> [Output a] -> Output a
formatted
        (forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. a -> Maybe a
Just Text
separator }) [forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f [Output a]
x, Output a
y]
      Linked Text
i [Output a]
x <:> Output a
y = forall a. Formatting -> [Output a] -> Output a
formatted
        (forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = forall a. a -> Maybe a
Just Text
separator }) [forall a. Text -> [Output a] -> Output a
Linked Text
i [Output a]
x, Output a
y]
      Tagged Tag
_ Output a
x <:> Output a
y = Output a
x Output a -> Output a -> Output a
<:> Output a
y
      InNote Output a
x <:> Output a
y = Output a
x Output a -> Output a -> Output a
<:> Output a
y

  let familyAffixes :: [Output a] -> Output a
familyAffixes = forall a. Formatting -> [Output a] -> Output a
formatted
          (case NameFormat -> Maybe Formatting
nameFamilyFormatting NameFormat
nameFormat of
             Maybe Formatting
Nothing -> forall a. Monoid a => a
mempty
             Just Formatting
f  -> forall a. Monoid a => a
mempty{ formatSuffix :: Maybe Text
formatSuffix = Formatting -> Maybe Text
formatSuffix Formatting
f
                              , formatPrefix :: Maybe Text
formatPrefix = Formatting -> Maybe Text
formatPrefix Formatting
f })
  let givenAffixes :: [Output a] -> Output a
givenAffixes = forall a. Formatting -> [Output a] -> Output a
formatted
          (case NameFormat -> Maybe Formatting
nameGivenFormatting NameFormat
nameFormat of
             Maybe Formatting
Nothing -> forall a. Monoid a => a
mempty
             Just Formatting
f  -> forall a. Monoid a => a
mempty{ formatSuffix :: Maybe Text
formatSuffix = Formatting -> Maybe Text
formatSuffix Formatting
f
                              , formatPrefix :: Maybe Text
formatPrefix = Formatting -> Maybe Text
formatPrefix Formatting
f })
  let familyFormatting :: [Output a] -> Output a
familyFormatting = forall a. Formatting -> [Output a] -> Output a
formatted
          (case NameFormat -> Maybe Formatting
nameFamilyFormatting NameFormat
nameFormat of
             Maybe Formatting
Nothing -> forall a. Monoid a => a
mempty
             Just Formatting
f  -> Formatting
f{ formatSuffix :: Maybe Text
formatSuffix = forall a. Maybe a
Nothing
                         , formatPrefix :: Maybe Text
formatPrefix = forall a. Maybe a
Nothing })
  let givenFormatting :: [Output a] -> Output a
givenFormatting = forall a. Formatting -> [Output a] -> Output a
formatted
          (case NameFormat -> Maybe Formatting
nameGivenFormatting NameFormat
nameFormat of
             Maybe Formatting
Nothing -> forall a. Monoid a => a
mempty
             Just Formatting
f  -> Formatting
f{ formatSuffix :: Maybe Text
formatSuffix = forall a. Maybe a
Nothing
                         , formatPrefix :: Maybe Text
formatPrefix = forall a. Maybe a
Nothing })
  let nonDroppingParticle :: Output a
nonDroppingParticle =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Output a
NullOutput (forall a. [Output a] -> Output a
familyFormatting forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => Text -> Output a
literal) forall a b. (a -> b) -> a -> b
$
          Name -> Maybe Text
nameNonDroppingParticle Name
name
  let droppingParticle :: Output a
droppingParticle =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Output a
NullOutput (forall a. [Output a] -> Output a
givenFormatting forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => Text -> Output a
literal) forall a b. (a -> b) -> a -> b
$
          Name -> Maybe Text
nameDroppingParticle Name
name
  let given :: Output a
given =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Output a
NullOutput (forall a. [Output a] -> Output a
givenFormatting forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => Text -> Output a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
initialize') forall a b. (a -> b) -> a -> b
$
          Name -> Maybe Text
nameGiven Name
name
  let family :: Output a
family =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Output a
NullOutput (forall a. [Output a] -> Output a
familyFormatting forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CiteprocOutput a => Text -> Output a
literal) forall a b. (a -> b) -> a -> b
$
          Name -> Maybe Text
nameFamily Name
name
  let suffix :: Output a
suffix = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Output a
NullOutput forall a. CiteprocOutput a => Text -> Output a
literal forall a b. (a -> b) -> a -> b
$ Name -> Maybe Text
nameSuffix Name
name
  let useSortOrder :: Bool
useSortOrder = Bool
inSortKey Bool -> Bool -> Bool
||
                     case NameFormat -> Maybe NameAsSortOrder
nameAsSortOrder NameFormat
nameFormat of
                       Just NameAsSortOrder
NameAsSortOrderAll -> Bool
True
                       Just NameAsSortOrder
NameAsSortOrderFirst -> Int
order forall a. Eq a => a -> a -> Bool
== Int
1
                       Maybe NameAsSortOrder
_ -> Bool
False
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$
    if Name -> Bool
isByzantineName Name
name
       then
         case NameFormat -> NameForm
nameForm NameFormat
nameFormat of
              NameForm
LongName
                | DemoteNonDroppingParticle
demoteNonDroppingParticle forall a. Eq a => a -> a -> Bool
== DemoteNonDroppingParticle
DemoteNever Bool -> Bool -> Bool
||
                  DemoteNonDroppingParticle
demoteNonDroppingParticle forall a. Eq a => a -> a -> Bool
== DemoteNonDroppingParticle
DemoteSortOnly
                , Bool
useSortOrder->
                      forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
nonDroppingParticle forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
family ] forall {a}. Output a -> Output a -> Output a
<:>
                      forall a. [Output a] -> Output a
givenAffixes
                      [ Output a
given forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
droppingParticle ] forall {a}. Output a -> Output a -> Output a
<:>
                      Output a
suffix
                | DemoteNonDroppingParticle
demoteNonDroppingParticle forall a. Eq a => a -> a -> Bool
== DemoteNonDroppingParticle
DemoteDisplayAndSort
                , Bool
useSortOrder->
                      forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
family ] forall {a}. Output a -> Output a -> Output a
<:>
                      forall a. [Output a] -> Output a
givenAffixes
                      [ Output a
given forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
droppingParticle forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
nonDroppingParticle ] forall {a}. Output a -> Output a -> Output a
<:>
                      Output a
suffix
                | Name -> Bool
nameCommaSuffix Name
name ->
                      forall a. [Output a] -> Output a
givenAffixes
                      [ Output a
given ] forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                      forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
droppingParticle forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
nonDroppingParticle forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
family forall {a}. Output a -> Output a -> Output a
<:>
                        Output a
suffix ]
                | Bool
otherwise ->
                      forall a. [Output a] -> Output a
givenAffixes
                      [ Output a
given ] forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                      forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
droppingParticle forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
nonDroppingParticle forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
family forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
suffix ]
              NameForm
ShortName ->
                      forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
nonDroppingParticle forall {a}. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
family ]
              NameForm
CountName -> forall a. Output a
NullOutput
       else
         case NameFormat -> NameForm
nameForm NameFormat
nameFormat of
              NameForm
LongName  -> forall a. [Output a] -> Output a
grouped
                [ forall a. [Output a] -> Output a
familyAffixes
                  [ Output a
family ]
                , forall a. [Output a] -> Output a
givenAffixes
                  [ Output a
given ] ]
              NameForm
ShortName -> forall a. [Output a] -> Output a
familyAffixes
                             [ Output a
family ]
              NameForm
CountName -> forall a. Output a
NullOutput


eGroup :: CiteprocOutput a
          => Bool -> Formatting -> [Element a] -> Eval a (Output a)
eGroup :: forall a.
CiteprocOutput a =>
Bool -> Formatting -> [Element a] -> Eval a (Output a)
eGroup Bool
isMacro Formatting
formatting [Element a]
els = do
  -- A group is suppressed if it directly or indirectly
  -- calls at least one variable but all of the variables
  -- it calls are empty.
  VarCount Int
oldVars Int
oldNonempty <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> VarCount
stateVarCount
  [Output a]
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 a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement [Element a]
els
  VarCount Int
newVars Int
newNonempty <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> VarCount
stateVarCount
  let isempty :: Bool
isempty = Int
newVars forall a. Eq a => a -> a -> Bool
/= Int
oldVars Bool -> Bool -> Bool
&& Int
newNonempty forall a. Eq a => a -> a -> Bool
== Int
oldNonempty

  -- see
  -- https://github.com/citation-style-language/documentation/blob/master/specification.rst#group
  -- "When a cs:group contains a child cs:macro, if the cs:macro is
  -- non-empty, it is treated as a non-empty variable for the purposes of
  -- determining suppression of the outer cs:group."
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isMacro Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isempty) forall a b. (a -> b) -> a -> b
$ forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not Bool
isempty
              then forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a]
xs
              else forall a. Output a
NullOutput

eChoose :: CiteprocOutput a
        => [(Match, [Condition], [Element a])] -> Eval a [Output a]
eChoose :: forall a.
CiteprocOutput a =>
[(Match, [Condition], [Element a])] -> Eval a [Output a]
eChoose [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
eChoose ((Match
match, [Condition]
conditions, [Element a]
els):[(Match, [Condition], [Element a])]
rest) = do
  Reference a
ref <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> Reference a
stateReference
  Maybe Text
label <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Maybe Text
contextLabel
  let disambiguate :: Bool
disambiguate = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False
                      DisambiguationData -> Bool
disambCondition (forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation Reference a
ref)
  [Position]
positions <- forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> [Position]
contextPosition
  Bool
hasLocator <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks forall a. Context a -> Maybe Text
contextLocator
  let isNumeric :: Text -> Bool
isNumeric Text
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
        (\Text
chunk -> (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
chunk Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpace Text
chunk)) forall a b. (a -> b) -> a -> b
$
        (Char -> Bool) -> Text -> [Text]
T.split (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'&')
         (Text -> Text -> Text -> Text
T.replace Text
", " Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"& " Text
"&" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
", " Text
"," forall a b. (a -> b) -> a -> b
$ Text
t)
  let testCondition :: Condition -> Bool
testCondition Condition
cond =
        case Condition
cond of
           HasVariable Variable
"locator" -> Bool
hasLocator
           HasVariable Variable
t ->
             case forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
t Reference a
ref of
               Just Val a
x  -> forall a. CiteprocOutput a => Val a -> Bool
isNonEmpty Val a
x
               Maybe (Val a)
Nothing -> Bool
False
           HasType Text
t -> forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"type" Reference a
ref forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall a. Text -> Val a
TextVal Text
t)
           IsUncertainDate Variable
t -> case forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
t Reference a
ref of
                                  Just (DateVal Date
d) -> Date -> Bool
dateCirca Date
d
                                  Maybe (Val a)
_                -> Bool
False
           IsNumeric Variable
t -> case forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
t Reference a
ref of
                            Just (NumVal Int
_)   -> Bool
True
                            Just (TextVal Text
x)  -> Text -> Bool
isNumeric Text
x
                            Just (FancyVal a
x) -> Text -> Bool
isNumeric (forall a. CiteprocOutput a => a -> Text
toText a
x)
                            Maybe (Val a)
_                 -> Bool
False
           HasLocatorType Variable
t -> case Maybe Text
label of
                                 Just Text
"sub verbo" -> Variable
t forall a. Eq a => a -> a -> Bool
== Variable
"sub-verbo"
                                 Just Text
x -> Text -> Variable
toVariable Text
x forall a. Eq a => a -> a -> Bool
== Variable
t
                                 Maybe Text
Nothing -> Variable
t forall a. Eq a => a -> a -> Bool
== Variable
"page"
           HasPosition Position
pos -> Position
pos forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Position]
positions
           Condition
WouldDisambiguate -> Bool
disambiguate
  let matched :: Bool
matched = (case Match
match of
                   Match
MatchAll  -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Condition -> Bool
testCondition
                   Match
MatchAny  -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Condition -> Bool
testCondition
                   Match
MatchNone -> Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Condition -> Bool
testCondition) [Condition]
conditions
  if Bool
matched
     then 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 a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement [Element a]
els
     else forall a.
CiteprocOutput a =>
[(Match, [Condition], [Element a])] -> Eval a [Output a]
eChoose [(Match, [Condition], [Element a])]
rest


eNumber :: CiteprocOutput a => Variable -> NumberForm -> Eval a (Output a)
eNumber :: forall a.
CiteprocOutput a =>
Variable -> NumberForm -> Eval a (Output a)
eNumber Variable
var NumberForm
nform = do
  Maybe (Val a)
mbv <- forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
var
  [(Term, Text)]
varTerms <- forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = Variable -> Text
fromVariable Variable
var }
  let mbGender :: Maybe TermGender
mbGender = case [(Term, Text)]
varTerms of
                   [] -> forall a. Maybe a
Nothing
                   ((Term
t,Text
_):[(Term, Text)]
_) -> Term -> Maybe TermGender
termGender Term
t
  let nparts :: [Val a]
nparts = case Maybe (Val a)
mbv of
                 Just x :: Val a
x@NumVal{}   -> [Val a
x]
                 Just (FancyVal a
x) -> forall a. Text -> [Val a]
splitNums (forall a. CiteprocOutput a => a -> Text
toText a
x)
                 Just (TextVal Text
t)  -> forall a. Text -> [Val a]
splitNums Text
t
                 Maybe (Val a)
_                 -> []
  forall a. [Output a] -> Output a
grouped 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 a.
CiteprocOutput a =>
NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
nform Maybe TermGender
mbGender) [Val a]
nparts

evalNumber :: CiteprocOutput a
           => NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber :: forall a.
CiteprocOutput a =>
NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
form Maybe TermGender
mbGender (NumVal Int
i) = do
  let numterm :: String -> t -> Term
numterm String
s t
x = Term
emptyTerm { termName :: Text
termName = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
s t
x
                              , termGenderForm :: Maybe TermGender
termGenderForm = Maybe TermGender
mbGender }
  let dectext :: Text
dectext = String -> Text
T.pack (forall a. Show a => a -> String
show Int
i)
  let twomatch :: Term
twomatch = forall {t}. PrintfArg t => String -> t -> Term
numterm String
"ordinal-%02d" (Int
i forall a. Integral a => a -> a -> a
`mod` Int
100)
  let onematch :: Term
onematch = forall {t}. PrintfArg t => String -> t -> Term
numterm String
"ordinal-%02d" (Int
i forall a. Integral a => a -> a -> a
`mod` Int
10)
  let fallback :: Term
fallback = Term
emptyTerm { termName :: Text
termName = Text
"ordinal" }
  case NumberForm
form of
    NumberForm
NumberNumeric -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText Text
dectext
    NumberForm
NumberOrdinal -> do
      [(Term, Text)]
res <- (if Int
i forall a. Ord a => a -> a -> Bool
> Int
99
                 then forall a. (a -> Bool) -> [a] -> [a]
filter (\(Term
t,Text
_) -> Term -> Maybe TermMatch
termMatch Term
t forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just TermMatch
WholeNumber)
                 else forall a. a -> a
id) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
twomatch
      case [(Term, Text)]
res of
        ((Term
_,Text
suff):[(Term, Text)]
_) ->
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText (Text
dectext forall a. Semigroup a => a -> a -> a
<> Text
suff)
        [] -> do -- not an exact match
          [(Term, Text)]
res' <- (if Int
i forall a. Ord a => a -> a -> Bool
> Int
10
                      then forall a. (a -> Bool) -> [a] -> [a]
filter (\(Term
t,Text
_) ->
                             forall a. Maybe a -> Bool
isNothing (Term -> Maybe TermMatch
termMatch Term
t) Bool -> Bool -> Bool
||
                             Term -> Maybe TermMatch
termMatch Term
t forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just TermMatch
LastDigit)
                      else forall a. a -> a
id) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
onematch
          case [(Term, Text)]
res' of
            ((Term
_,Text
suff):[(Term, Text)]
_) ->
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText (Text
dectext forall a. Semigroup a => a -> a -> a
<> Text
suff)
            [] -> do
              [(Term, Text)]
res'' <- forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
fallback
              case [(Term, Text)]
res'' of
                ((Term
_,Text
suff):[(Term, Text)]
_) ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText (Text
dectext forall a. Semigroup a => a -> a -> a
<> Text
suff)
                [] -> do
                  forall a. Text -> Eval a ()
warn forall a b. (a -> b) -> a -> b
$ Text
"no ordinal suffix found for " forall a. Semigroup a => a -> a -> a
<> Text
dectext
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText (String -> Text
T.pack (forall a. Show a => a -> String
show Int
i))
    NumberForm
NumberLongOrdinal
      | Int
i forall a. Ord a => a -> a -> Bool
>= Int
1
      , Int
i forall a. Ord a => a -> a -> Bool
<= Int
10 -> do
        [(Term, Text)]
res <- forall a. Term -> Eval a [(Term, Text)]
lookupTerm (forall {t}. PrintfArg t => String -> t -> Term
numterm String
"long-ordinal-%02d" Int
i)
        case [(Term, Text)]
res of
          ((Term
_,Text
t):[(Term, Text)]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText Text
t
          []        -> forall a.
CiteprocOutput a =>
NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
NumberOrdinal Maybe TermGender
mbGender (forall a. Int -> Val a
NumVal Int
i)
      | Bool
otherwise -> forall a.
CiteprocOutput a =>
NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
NumberOrdinal Maybe TermGender
mbGender (forall a. Int -> Val a
NumVal Int
i)
    NumberForm
NumberRoman -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText forall a b. (a -> b) -> a -> b
$ Int -> Text
toRomanNumeral Int
i
evalNumber NumberForm
_ Maybe TermGender
_ (TextVal Text
t) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => Text -> a
fromText Text
t
evalNumber NumberForm
_ Maybe TermGender
_ (FancyVal a
t) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Output a
Literal a
t
evalNumber NumberForm
_ Maybe TermGender
_ Val a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Output a
NullOutput


warn :: Text -> Eval a ()
warn :: forall a. Text -> Eval a ()
warn Text
t = forall w (m :: * -> *) r s.
(Monoid w, Monad m) =>
w -> RWST r w s m ()
tell forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton Text
t

-- | Convert number < 4000 to lowercase roman numeral.
toRomanNumeral :: Int -> Text
toRomanNumeral :: Int -> Text
toRomanNumeral Int
x
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
4000 Bool -> Bool -> Bool
|| Int
x forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Text
T.pack (forall a. Show a => a -> String
show Int
x)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
1000 = Text
"m" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
1000)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
900  = Text
"cm" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
900)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
500  = Text
"d" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
500)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
400  = Text
"cd" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
400)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
100  = Text
"c" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
100)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
90   = Text
"xc" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
90)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
50   = Text
"l"  forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
50)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
40   = Text
"xl" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
40)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
10   = Text
"x" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
10)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
9    = Text
"ix"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
5    = Text
"v" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
5)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
4    = Text
"iv"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
1    = Text
"i" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
1)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
0    = Text
""
  | Bool
otherwise = String -> Text
T.pack (forall a. Show a => a -> String
show Int
x)

-- Gets variable while updating var count.
askVariable :: CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable :: forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
"page-first" = do
  Maybe (Val a)
res <- forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
"page"
  case Maybe (Val a)
res of
    Just (TextVal Text
t)  ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Val a
TextVal forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSepPunct) Text
t
    Just (FancyVal a
x) ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Val a
TextVal forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSepPunct) forall a b. (a -> b) -> a -> b
$ forall a. CiteprocOutput a => a -> Text
toText a
x
    Just (NumVal Int
n)   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> Val a
NumVal Int
n
    Maybe (Val a)
_                 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
askVariable Variable
v = do
  Reference a
ref <- forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets forall a. EvalState a -> Reference a
stateReference
  case forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
v Reference a
ref of
    Just Val a
x | forall a. CiteprocOutput a => Val a -> Bool
isNonEmpty Val a
x Bool -> Bool -> Bool
&& Val a
x forall a. Eq a => a -> a -> Bool
/= forall {a}. Val a
SubstitutedVal -> do
      forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Val a
x
    Maybe (Val a)
_ -> do
      forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
0
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

isNonEmpty :: CiteprocOutput a => Val a -> Bool
isNonEmpty :: forall a. CiteprocOutput a => Val a -> Bool
isNonEmpty (TextVal Text
t) = Bool -> Bool
not (Text -> Bool
T.null Text
t)
isNonEmpty (FancyVal a
x) = a
x forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty
isNonEmpty (NamesVal []) = Bool
False
isNonEmpty (DateVal (Date [] Bool
_ Maybe Int
Nothing Maybe Text
Nothing)) = Bool
False
isNonEmpty Val a
_       = Bool
True

citationLabel :: Reference a -> Val a
citationLabel :: forall a. Reference a -> Val a
citationLabel Reference a
ref = forall a. Text -> Val a
TextVal Text
trigraph
 where
  trigraph :: Text
trigraph = Text
namepart forall a. Semigroup a => a -> a -> a
<> Text
datepart
  datepart :: Text
datepart = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Variable
"issued" Map Variable (Val a)
varmap of
               Just (DateVal Date
d) -> Date -> Text
getYear Date
d
               Maybe (Val a)
_ -> Text
""
  namepart :: Text
namepart = if Variable
"author" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
namevars
                then Variable -> Text
getNames Variable
"author"
                else case [Variable]
namevars of
                       (Variable
n:[Variable]
_) -> Variable -> Text
getNames Variable
n
                       [Variable]
_     -> Text
"Xyz"
  varmap :: Map Variable (Val a)
varmap = forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference a
ref
  vars :: [Variable]
vars = forall k a. Map k a -> [k]
M.keys Map Variable (Val a)
varmap
  namevars :: [Variable]
namevars = [Variable
v | Variable
v <- [Variable]
vars, Variable -> VariableType
variableType Variable
v forall a. Eq a => a -> a -> Bool
== VariableType
NameVariable]
  getNames :: Variable -> Text
getNames Variable
var = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Variable
var Map Variable (Val a)
varmap of
                   Just (NamesVal [Name]
ns) ->
                     let x :: Int
x = case forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ns of
                               Int
1  -> Int
4
                               Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
4 -> Int
1
                                 | Bool
otherwise -> Int
2
                     in forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
                        forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.take Int
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Name -> Maybe Text
nameFamily)
                        (forall a. Int -> [a] -> [a]
take Int
4 [Name]
ns)
                   Maybe (Val a)
_ -> Text
""
  getYear :: Date -> Text
getYear Date
d = case Date -> [DateParts]
dateParts Date
d of
                (DateParts (Int
x:[Int]
_):[DateParts]
_) ->
                  String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%02d" forall a b. (a -> b) -> a -> b
$ Int
x forall a. Integral a => a -> a -> a
`mod` Int
100)
                [DateParts]
_ -> Text
""

removeDoubleSpaces :: Text -> Text
removeDoubleSpaces :: Text -> Text
removeDoubleSpaces = Text -> Text -> Text -> Text
T.replace Text
"  " Text
" "

endsWithSpace :: Text -> Bool
endsWithSpace :: Text -> Bool
endsWithSpace Text
t = Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Char -> Bool
isSpace (Text -> Char
T.last Text
t)

beginsWithSpace :: Text -> Bool
beginsWithSpace :: Text -> Bool
beginsWithSpace Text
t = Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Char -> Bool
isSpace (Text -> Char
T.head Text
t)