{-# 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)
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 -> Map Text [Element a]
contextMacros :: M.Map Text [Element a]
, 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
, forall a. Context a -> NameFormat
contextNameFormat :: NameFormat
}
data VarCount =
VarCount
{ VarCount -> Int
variablesAccessed :: Int
, VarCount -> Int
variablesNonempty :: Int
} deriving (Int -> VarCount -> ShowS
[VarCount] -> ShowS
VarCount -> String
(Int -> VarCount -> ShowS)
-> (VarCount -> String) -> ([VarCount] -> ShowS) -> Show VarCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarCount -> ShowS
showsPrec :: Int -> VarCount -> ShowS
$cshow :: VarCount -> String
show :: VarCount -> String
$cshowList :: [VarCount] -> ShowS
showList :: [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)
, forall a. EvalState a -> Map Int (Set ItemId)
stateNoteMap :: M.Map Int (Set.Set ItemId)
, 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
, forall a. EvalState a -> Bool
stateUsedTitle :: Bool
} deriving (Int -> EvalState a -> ShowS
[EvalState a] -> ShowS
EvalState a -> String
(Int -> EvalState a -> ShowS)
-> (EvalState a -> String)
-> ([EvalState a] -> ShowS)
-> Show (EvalState a)
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
$cshowsPrec :: forall a. Show a => Int -> EvalState a -> ShowS
showsPrec :: Int -> EvalState a -> ShowS
$cshow :: forall a. Show a => EvalState a -> String
show :: EvalState a -> String
$cshowList :: forall a. Show a => [EvalState a] -> ShowS
showList :: [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' =
(EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
let VarCount{ variablesAccessed :: VarCount -> Int
variablesAccessed = Int
total
, variablesNonempty :: VarCount -> Int
variablesNonempty = Int
nonempty } = EvalState a -> VarCount
forall a. EvalState a -> VarCount
stateVarCount EvalState a
st
in EvalState a
st{ stateVarCount =
VarCount { variablesAccessed = total + total',
variablesNonempty = nonempty + nonempty' } }
evalStyle :: CiteprocOutput a
=> Style a
-> Maybe Lang
-> [Reference a]
-> [Citation a]
-> ([Output a], [(Text, Output a)], [Text])
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, Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
warnings)
where
refs'' :: [Reference a]
refs'' = [Reference a]
refs' [Reference a] -> [Reference a] -> [Reference a]
forall a. [a] -> [a] -> [a]
++ [Citation a] -> [Reference a]
forall a. [Citation a] -> [Reference a]
extractItemData [Citation a]
citations
([Reference a]
refs, ReferenceMap a
refmap) = [Reference a] -> ([Reference a], ReferenceMap a)
forall a. [Reference a] -> ([Reference a], ReferenceMap a)
makeReferenceMap [Reference a]
refs''
(([Output a]
citationOs, [(Text, Output a)]
bibliographyOs), Set Text
warnings) = RWS
(Context a)
(Set Text)
(EvalState a)
([Output a], [(Text, Output a)])
-> Context a
-> EvalState a
-> (([Output a], [(Text, Output a)]), Set Text)
forall w r s a. Monoid w => RWS r w s a -> r -> s -> (a, w)
evalRWS RWS
(Context a)
(Set Text)
(EvalState a)
([Output a], [(Text, Output a)])
go
Context
{ contextLocale :: Locale
contextLocale = Maybe Lang -> Style a -> Locale
forall a. Maybe Lang -> Style a -> Locale
mergeLocales Maybe Lang
mblang Style a
style
, contextCollate :: [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate = (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues (Maybe Lang -> Text -> Text -> Ordering
Unicode.comp Maybe Lang
mblang)
, contextAbbreviations :: Maybe Abbreviations
contextAbbreviations = Style a -> Maybe Abbreviations
forall a. Style a -> Maybe Abbreviations
styleAbbreviations Style a
style
, contextStyleOptions :: StyleOptions
contextStyleOptions = Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style
, contextMacros :: Map Text [Element a]
contextMacros = Style a -> Map Text [Element a]
forall a. Style a -> Map Text [Element a]
styleMacros Style a
style
, contextLocator :: Maybe Text
contextLocator = Maybe Text
forall a. Maybe a
Nothing
, contextLabel :: Maybe Text
contextLabel = Maybe Text
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 = Maybe NamesFormat
forall a. Maybe a
Nothing
, contextNameFormat :: NameFormat
contextNameFormat = StyleOptions -> NameFormat
styleNameFormat (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style)
}
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 = Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall a. Monoid a => a
mempty
, stateNoteMap :: Map Int (Set ItemId)
stateNoteMap = Map Int (Set ItemId)
forall a. Monoid a => a
mempty
, stateRefMap :: ReferenceMap a
stateRefMap = ReferenceMap a
refmap
, stateReference :: Reference a
stateReference = ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
forall a.
ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
Reference ItemId
forall a. Monoid a => a
mempty Text
forall a. Monoid a => a
mempty Maybe DisambiguationData
forall a. Maybe a
Nothing Map Variable (Val a)
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 =
(EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> RWST r w (EvalState a) m ())
-> (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
EvalState a
st{ stateRefMap = ReferenceMap $ foldl'
(\Map ItemId (Reference a)
m (ItemId
citeId, Int
num) ->
(Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\Reference a
ref ->
Reference a
ref{ referenceVariables =
M.insert "citation-number"
(NumVal num) .
M.insert "citation-key"
(TextVal (unItemId citeId)) .
M.alter (addIfMissing (citationLabel ref))
"citation-label"
$ referenceVariables ref
}) ItemId
citeId Map ItemId (Reference a)
m)
(unReferenceMap (stateRefMap st))
(zip sortedIds [1..]) }
addIfMissing :: a -> Maybe a -> Maybe a
addIfMissing a
x Maybe a
Nothing = a -> Maybe a
forall a. a -> Maybe a
Just a
x
addIfMissing a
_ (Just a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
go :: RWS
(Context a)
(Set Text)
(EvalState a)
([Output a], [(Text, Output a)])
go = do
let citationOrder :: Map ItemId Int
citationOrder = [(ItemId, Int)] -> Map ItemId Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ItemId, Int)] -> Map ItemId Int)
-> [(ItemId, Int)] -> Map ItemId Int
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int)] -> [(ItemId, Int)]
forall a. [a] -> [a]
reverse ([(ItemId, Int)] -> [(ItemId, Int)])
-> [(ItemId, Int)] -> [(ItemId, Int)]
forall a b. (a -> b) -> a -> b
$ [ItemId] -> [Int] -> [(ItemId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip
((Citation a -> [ItemId]) -> [Citation a] -> [ItemId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((CitationItem a -> ItemId) -> [CitationItem a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId ([CitationItem a] -> [ItemId])
-> (Citation a -> [CitationItem a]) -> Citation a -> [ItemId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems) [Citation a]
citations)
[(Int
1 :: Int)..]
let citeIds :: Set ItemId
citeIds = Map ItemId Int -> Set ItemId
forall k a. Map k a -> Set k
M.keysSet Map ItemId Int
citationOrder
let sortedCiteIds :: [ItemId]
sortedCiteIds = (ItemId -> Int) -> [ItemId] -> [ItemId]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn
(Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. Bounded a => a
maxBound (Maybe Int -> Int) -> (ItemId -> Maybe Int) -> ItemId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId -> Map ItemId Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map ItemId Int
citationOrder))
((Reference a -> ItemId) -> [Reference a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId [Reference a]
refs)
let layoutOpts :: LayoutOptions
layoutOpts = Layout a -> LayoutOptions
forall a. Layout a -> LayoutOptions
layoutOptions (Layout a -> LayoutOptions) -> Layout a -> LayoutOptions
forall a b. (a -> b) -> a -> b
$ Style a -> Layout a
forall a. Style a -> Layout a
styleCitation Style a
style
let mbcgDelim :: Maybe Text
mbcgDelim =
case StyleOptions -> Maybe Text
styleCiteGroupDelimiter (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style) of
Just Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
Maybe Text
Nothing
| Maybe Collapsing -> Bool
forall a. Maybe a -> Bool
isJust (LayoutOptions -> Maybe Collapsing
layoutCollapse LayoutOptions
layoutOpts) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
", "
| Bool
otherwise -> Maybe Text
forall a. Maybe a
Nothing
[ItemId] -> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall {m :: * -> *} {r} {w} {a}.
Monad m =>
[ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers [ItemId]
sortedCiteIds
collate <- (Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering)
-> RWST
(Context a)
(Set Text)
(EvalState a)
Identity
([SortKeyValue] -> [SortKeyValue] -> Ordering)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
forall a. Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate
(bibCitations, bibSortKeyMap) <-
case styleBibliography style of
Maybe (Layout a)
Nothing -> ([Citation a], Map ItemId [SortKeyValue])
-> RWST
(Context a)
(Set Text)
(EvalState a)
Identity
([Citation a], Map ItemId [SortKeyValue])
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Map ItemId [SortKeyValue]
forall a. Monoid a => a
mempty)
Just Layout a
biblayout -> do
bibSortKeyMap <- [(ItemId, [SortKeyValue])] -> Map ItemId [SortKeyValue]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
([(ItemId, [SortKeyValue])] -> Map ItemId [SortKeyValue])
-> RWST
(Context a)
(Set Text)
(EvalState a)
Identity
[(ItemId, [SortKeyValue])]
-> RWST
(Context a)
(Set Text)
(EvalState a)
Identity
(Map ItemId [SortKeyValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference a
-> RWST
(Context a)
(Set Text)
(EvalState a)
Identity
(ItemId, [SortKeyValue]))
-> [Reference a]
-> RWST
(Context a)
(Set Text)
(EvalState a)
Identity
[(ItemId, [SortKeyValue])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
((\ItemId
citeId ->
(ItemId
citeId,) ([SortKeyValue] -> (ItemId, [SortKeyValue]))
-> RWST
(Context a) (Set Text) (EvalState a) Identity [SortKeyValue]
-> RWST
(Context a)
(Set Text)
(EvalState a)
Identity
(ItemId, [SortKeyValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Layout a
-> ItemId
-> RWST
(Context a) (Set Text) (EvalState a) Identity [SortKeyValue]
forall a.
CiteprocOutput a =>
Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys Layout a
biblayout ItemId
citeId)
(ItemId
-> RWST
(Context a)
(Set Text)
(EvalState a)
Identity
(ItemId, [SortKeyValue]))
-> (Reference a -> ItemId)
-> Reference a
-> RWST
(Context a)
(Set Text)
(EvalState a)
Identity
(ItemId, [SortKeyValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId)
[Reference a]
refs
let sortedIds =
if [SortKey a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Layout a -> [SortKey a]
forall a. Layout a -> [SortKey a]
layoutSortKeys Layout a
biblayout)
then [ItemId]
sortedCiteIds
else (ItemId -> ItemId -> Ordering) -> [ItemId] -> [ItemId]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
(\ItemId
x ItemId
y -> [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ItemId
x Map ItemId [SortKeyValue]
bibSortKeyMap)
([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ItemId
y Map ItemId [SortKeyValue]
bibSortKeyMap))
((Reference a -> ItemId) -> [Reference a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId [Reference a]
refs)
assignCitationNumbers $
case layoutSortKeys biblayout of
(SortKeyVariable SortDirection
Descending Variable
"citation-number":[SortKey a]
_)
-> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
(SortKeyMacro SortDirection
Descending NameFormat
_ Text
_:[SortKey a]
_)
-> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
[SortKey a]
_ -> [ItemId]
sortedIds
let bibCitations = (ItemId -> Citation a) -> [ItemId] -> [Citation a]
forall a b. (a -> b) -> [a] -> [b]
map (\ItemId
ident ->
Maybe Text
-> Bool
-> Maybe Int
-> Maybe a
-> Maybe a
-> [CitationItem a]
-> Citation a
forall a.
Maybe Text
-> Bool
-> Maybe Int
-> Maybe a
-> Maybe a
-> [CitationItem a]
-> Citation a
Citation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ItemId -> Text
unItemId ItemId
ident) Bool
False Maybe Int
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing
[ItemId
-> Maybe Text
-> Maybe Text
-> CitationItemType
-> Maybe a
-> Maybe a
-> Maybe (Reference a)
-> CitationItem a
forall a.
ItemId
-> Maybe Text
-> Maybe Text
-> CitationItemType
-> Maybe a
-> Maybe a
-> Maybe (Reference a)
-> CitationItem a
CitationItem ItemId
ident Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
CitationItemType
NormalCite Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing Maybe (Reference a)
forall a. Maybe a
Nothing]) [ItemId]
sortedIds
return (bibCitations, bibSortKeyMap)
sortKeyMap <-
foldM (\Map ItemId [SortKeyValue]
m ItemId
citeId -> do
sk <- Layout a
-> ItemId
-> RWST
(Context a) (Set Text) (EvalState a) Identity [SortKeyValue]
forall a.
CiteprocOutput a =>
Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys (Style a -> Layout a
forall a. Style a -> Layout a
styleCitation Style a
style) ItemId
citeId
return $ M.insert citeId sk m)
M.empty
citeIds
let canGroup CitationItem a
i1 CitationItem a
i2
= Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemSuffix CitationItem a
i1) Bool -> Bool -> Bool
&&
Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemPrefix CitationItem a
i2) Bool -> Bool -> Bool
&&
Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemSuffix CitationItem a
i2) Bool -> Bool -> Bool
&&
Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemPrefix CitationItem a
i1)
let sortCitationItems Citation a
citation' =
Citation a
citation'{ citationItems =
concatMap
(sortBy
(\CitationItem a
item1 CitationItem a
item2 ->
[SortKeyValue] -> [SortKeyValue] -> Ordering
collate
([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
(CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item1) Map ItemId [SortKeyValue]
sortKeyMap)
([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
(CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item2) Map ItemId [SortKeyValue]
sortKeyMap)))
$ groupBy canGroup
$ citationItems citation' }
let citCitations = (Citation a -> Citation a) -> [Citation a] -> [Citation a]
forall a b. (a -> b) -> [a] -> [b]
map Citation a -> Citation a
forall {a}. Citation a -> Citation a
sortCitationItems [Citation a]
citations
cs <- disambiguateCitations style bibSortKeyMap citCitations
let cs' = case Maybe Text
mbcgDelim of
Maybe Text
Nothing -> [Output a]
cs
Just Text
citeGroupDelim -> (Output a -> Output a) -> [Output a] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map
(Text
-> Maybe Text
-> Maybe Text
-> Maybe Collapsing
-> Output a
-> Output a
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
x Output a
y
| Output a
x Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
y = Output a
forall a. Output a
NullOutput
| Bool
otherwise = Output a
y
let removeNamesIfSuppressAuthor
(Tagged (TagItem CitationItemType
SuppressAuthor ItemId
cid') Output a
x)
= let y :: Output a
y = Output a -> Output a
forall a. Output a -> Output a
getAuthors Output a
x
in Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (CitationItemType -> ItemId -> Tag
TagItem CitationItemType
SuppressAuthor ItemId
cid')
((Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Output a -> Output a -> Output a
forall {a}. Eq a => Output a -> Output a -> Output a
removeIfEqual Output a
y) Output a
x)
removeNamesIfSuppressAuthor Output a
x = Output a
x
let handleSuppressAuthors = (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
forall {a}. Eq a => Output a -> Output a
removeNamesIfSuppressAuthor
let isNoteCitation = StyleOptions -> Bool
styleIsNoteStyle (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style)
let 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
-> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
(Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a -> Output a
forall a. Output a -> Output a
InNote (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
xs) | Bool -> Bool
not ([Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs)])
| Bool
otherwise
-> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
(Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
if [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs
then []
else [a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
" "),
Formatting -> [Output a] -> Output a
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
-> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
(Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
if [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs Bool -> Bool -> Bool
&& [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
ys
then []
else [Output a -> Output a
forall a. Output a -> Output a
InNote (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f
(Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f' [Output a]
xs Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
ys))])
| Bool
otherwise
-> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty
(Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
if [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs Bool -> Bool -> Bool
&& [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
ys
then []
else [a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
" "),
Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f' [Output a]
xs Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
ys)])
Output a
_ | Bool
isNoteCitation -> Output a -> Output a
forall a. Output a -> Output a
InNote Output a
formattedCit
| Bool
otherwise -> Output a
formattedCit
let cs'' = (Output a -> Output a) -> [Output a] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map (Output a -> Output a
handleSuppressAuthors (Output a -> Output a)
-> (Output a -> Output a) -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output a -> Output a
forall {a}. CiteprocOutput a => Output a -> Output a
handleAuthorOnly) [Output a]
cs'
bs <- case styleBibliography style of
Just Layout a
biblayout
-> (Context a -> Context a) -> Eval a [Output a] -> Eval a [Output a]
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 = True }) (Eval a [Output a] -> Eval a [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall a b. (a -> b) -> a -> b
$
((Int, Citation a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [(Int, Citation a)] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Layout a
-> (Int, Citation a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Layout a -> (Int, Citation a) -> Eval a (Output a)
evalLayout Layout a
biblayout) ([Int] -> [Citation a] -> [(Int, Citation a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Citation a]
bibCitations)
Eval a [Output a]
-> ([Output a] -> Eval a [Output a]) -> Eval a [Output a]
forall a b.
RWST (Context a) (Set Text) (EvalState a) Identity a
-> (a -> RWST (Context a) (Set Text) (EvalState a) Identity b)
-> RWST (Context a) (Set Text) (EvalState a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Output a]
bs ->
case StyleOptions -> Maybe SubsequentAuthorSubstitute
styleSubsequentAuthorSubstitute
(Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style) of
Maybe SubsequentAuthorSubstitute
Nothing -> [Output a] -> Eval a [Output a]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
bs
Just SubsequentAuthorSubstitute
subs -> SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
forall a.
CiteprocOutput a =>
SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
subsequentAuthorSubstitutes SubsequentAuthorSubstitute
subs [Output a]
bs
Maybe (Layout a)
Nothing -> [Output a] -> Eval a [Output a]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
return (cs'', case styleBibliography style of
Maybe (Layout a)
Nothing -> []
Just Layout a
_ ->
[Text] -> [Output a] -> [(Text, Output a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Citation a -> Text) -> [Citation a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> (Citation a -> Maybe Text) -> Citation a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation a -> Maybe Text
forall a. Citation a -> Maybe Text
citationId) [Citation a]
bibCitations) [Output a]
bs)
extractItemData :: [Citation a] -> [Reference a]
= (Citation a -> [Reference a]) -> [Citation a] -> [Reference a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((CitationItem a -> Maybe (Reference a))
-> [CitationItem a] -> [Reference a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CitationItem a -> Maybe (Reference a)
forall a. CitationItem a -> Maybe (Reference a)
citationItemData ([CitationItem a] -> [Reference a])
-> (Citation a -> [CitationItem a]) -> Citation a -> [Reference a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation a -> [CitationItem a]
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) =
[Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a])
-> ([Output a] -> [Output a])
-> [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output a] -> [Output a]
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 = ([Name], Output a)
-> Maybe ([Name], Output a) -> ([Name], Output a)
forall a. a -> Maybe a -> a
fromMaybe ([],Output a
forall a. Output a
NullOutput) (Maybe ([Name], Output a) -> ([Name], Output a))
-> Maybe ([Name], Output a) -> ([Name], Output a)
forall a b. (a -> b) -> a -> b
$ Output a -> Maybe ([Name], Output a)
forall {a}. Output a -> Maybe ([Name], Output a)
getNames Output a
x
samenames :: [Output a]
samenames = SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
forall a.
CiteprocOutput a =>
SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
rule (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
t) ([Name], Output a)
xnames [Output a]
xs
rest :: [Output a]
rest = Int -> [Output a] -> [Output a]
forall a. Int -> [a] -> [a]
drop ([Output a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
samenames) [Output a]
xs
in (Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
samenames) [Output a] -> [Output a] -> [Output a]
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) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x] of
(([Name]
ns,Output a
r) : [([Name], Output a)]
_) -> ([Name], Output a) -> Maybe ([Name], Output a)
forall a. a -> Maybe a
Just ([Name]
ns,Output a
r)
[] -> Maybe ([Name], Output a)
forall a. Maybe a
Nothing
getNames Output a
_ = Maybe ([Name], 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' Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output 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) =
Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
t (Output a -> Output a) -> Maybe (Output a) -> Maybe (Output a)
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)) =
Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f ([Output a] -> Output a)
-> (Output a -> [Output a]) -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
ys) (Output a -> Output a) -> Maybe (Output a) -> Maybe (Output a)
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 [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names then SubsequentAuthorSubstituteRule
CompleteAll else SubsequentAuthorSubstituteRule
rule) of
SubsequentAuthorSubstituteRule
CompleteAll ->
if [Name]
ns [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name]
names Bool -> Bool -> Bool
&& (Bool -> Bool
not ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) Bool -> Bool -> Bool
|| Output a
r Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
raw)
then Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ Output a -> Output a
replaceAll Output a
y
else Maybe (Output a)
forall a. Maybe a
Nothing
SubsequentAuthorSubstituteRule
CompleteEach ->
if [Name]
ns [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name]
names
then Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
replaceEach Output a
y
else Maybe (Output a)
forall a. Maybe a
Nothing
SubsequentAuthorSubstituteRule
PartialEach ->
case [Name] -> [Name] -> Int
forall {a} {t}. (Eq a, Num t) => [a] -> [a] -> t
numberOfMatches [Name]
ns [Name]
names of
Int
num | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 -> Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Int -> Output a -> Output a
replaceFirst Int
num) Output a
y
Int
_ -> Maybe (Output a)
forall a. Maybe a
Nothing
SubsequentAuthorSubstituteRule
PartialFirst ->
case [Name] -> [Name] -> Int
forall {a} {t}. (Eq a, Num t) => [a] -> [a] -> t
numberOfMatches [Name]
ns [Name]
names of
Int
num | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
1 :: Int) -> Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Int -> Output a -> Output a
replaceFirst Int
1) Output a
y
Int
_ -> Maybe (Output a)
forall a. Maybe a