diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,38 @@
# citeproc changelog
+## 0.6
+
+ * Add Term parameter to TagTerm [API change].
+
+ * Add TagPrefix, TagSuffix constructors to Tag [API change].
+
+ * Make sure that extracted AuthorOnly names have the correct
+ formatting (#55).
+
+ * Do case-insensitive sorting, like Zotero (#91).
+
+ * Ignore "ibid" entries in computing ambiguities.
+
+ * Improved disambiguation for author-in-text citations.
+
+ * In disambiguating, convert author-in-text to normal citations.
+ Otherwise we disambiguate incorrectly.
+
+ * Fix title disambiguation with note style (#90).
+ Previously we'd been calculating ambiguities by generating
+ renderings for citation items independently of context.
+ This meant that we didn't detect ambiguities in "subsequent"
+ citations (which might e.g. just have an author).
+
+ * Ensure we don't do collapsing of items across a prefix or suffix (#89).
+ If we have `[@doe99; for contrasting views see @smith33; @doe00]`,
+ we don't want to get collapsing to
+ `(Doe 1999, 2000; for contrasting views, see Smith 1933)`.
+ This isn't strictly by the spec, but it gives better results.
+
+ * Allow collapsing after an initial prefix.
+
+
## 0.5
* Add `linkBibliography` field to `CiteprocOptions` [API change].
diff --git a/app/Main.hs b/app/Main.hs
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -32,7 +32,7 @@
putStr $ usageInfo "citeproc [OPTIONS] [FILE]" options
exitSuccess
when (optVersion opt) $ do
- putStrLn $ "citeproc version " <> VERSION_citeproc
+ putStrLn $ "citeproc version " ++ VERSION_citeproc
exitSuccess
format <- case optFormat opt of
Just "html" -> return Html
@@ -77,7 +77,6 @@
Left e -> err (T.unpack $ prettyCiteprocError e)
Right parsedStyle -> do
let style = parsedStyle{ styleAbbreviations = abbreviations }
- let locale = mergeLocales lang style
let result= citeproc defaultCiteprocOptions
style
lang
diff --git a/citeproc.cabal b/citeproc.cabal
--- a/citeproc.cabal
+++ b/citeproc.cabal
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: citeproc
-version: 0.5
+version: 0.6
synopsis: Generates citations and bibliography from CSL styles.
description: citeproc parses CSL style files and uses them to
generate a list of formatted citations and bibliography
@@ -66,7 +66,7 @@
, bytestring
, text
, containers >= 0.6.0.1 && < 0.7
- , transformers >= 0.5.6 && < 0.6
+ , transformers >= 0.5.6 && < 0.7
, case-insensitive >= 1.2 && < 1.3
, vector
, scientific
diff --git a/man/citeproc.1 b/man/citeproc.1
--- a/man/citeproc.1
+++ b/man/citeproc.1
@@ -1,6 +1,6 @@
.\" Automatically generated by Pandoc 2.13
.\"
-.TH "citeproc" "1" "" "citeproc 0.4" ""
+.TH "citeproc" "1" "" "citeproc 0.6" ""
.hy
.SH NAME
.PP
diff --git a/src/Citeproc/Eval.hs b/src/Citeproc/Eval.hs
--- a/src/Citeproc/Eval.hs
+++ b/src/Citeproc/Eval.hs
@@ -29,11 +29,11 @@
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
@@ -85,9 +85,11 @@
updateVarCount :: Int -> Int -> Eval a ()
updateVarCount total' nonempty' =
modify $ \st ->
- let VarCount total nonempty = stateVarCount st
+ let VarCount{ variablesAccessed = total
+ , variablesNonempty = nonempty } = stateVarCount st
in st{ stateVarCount =
- VarCount (total + total') (nonempty + nonempty') }
+ VarCount { variablesAccessed = total + total',
+ variablesNonempty = nonempty + nonempty' } }
evalStyle :: CiteprocOutput a
=> Style a -- ^ Parsed CSL style.
@@ -155,6 +157,17 @@
let sortedCiteIds = sortOn
(fromMaybe maxBound . (`M.lookup` citationOrder))
(map referenceId refs)
+ let layoutOpts = layoutOptions $ styleCitation style
+ let mbcgDelim =
+ case styleCiteGroupDelimiter (styleOptions style) of
+ Just x -> Just x
+ Nothing
+ -- grouping is activated whenever there is
+ -- collapsing; this is the default
+ -- cite-group-delimiter
+ | isJust (layoutCollapse layoutOpts) -> Just ", "
+ | otherwise -> Nothing
+
assignCitationNumbers sortedCiteIds
-- sorting of bibliography, insertion of citation-number
collate <- asks contextCollate
@@ -222,17 +235,7 @@
$ groupBy canGroup
$ citationItems citation' }
let citCitations = map sortCitationItems citations
- let layoutOpts = layoutOptions $ styleCitation style
cs <- disambiguateCitations style bibSortKeyMap citCitations
- let mbcgDelim =
- case styleCiteGroupDelimiter (styleOptions style) of
- Just x -> Just x
- Nothing
- -- grouping is activated whenever there is
- -- collapsing; this is the default
- -- cite-group-delimiter
- | isJust (layoutCollapse layoutOpts) -> Just ", "
- | otherwise -> Nothing
let cs' = case mbcgDelim of
Nothing -> cs
Just citeGroupDelim -> map
@@ -278,16 +281,14 @@
(x@(Tagged (TagItem AuthorOnly _) _):xs) : ys)
| isNoteCitation
-> formatted mempty
- (Formatted f'{ formatPrefix = Nothing
- , formatSuffix = Nothing } [x] :
+ (x :
if null xs && null ys
then []
else [InNote (formatted f
(formatted f' xs : ys))])
| otherwise
-> Formatted mempty
- (Formatted f'{ formatPrefix = Nothing
- , formatSuffix = Nothing } [x] :
+ (x :
if null xs && null ys
then []
else [Literal (fromText " "),
@@ -426,10 +427,26 @@
let ghostItems = [ ident
| ident <- refIds
, not (ident `Set.member` citeIdsSet)]
+
+ -- for purposes of disambiguation, we remove prefixes and
+ -- suffixes and locators, and we convert author-in-text to normal citation.
+ let removeAffix item = item{ citationItemLabel = Nothing
+ , citationItemLocator = Nothing
+ , citationItemPrefix = Nothing
+ , citationItemSuffix = Nothing }
+ let cleanCitation (Citation a b (i1:i2:is))
+ | citationItemType i1 == AuthorOnly
+ , citationItemType i2 == SuppressAuthor
+ = Citation a b
+ (map removeAffix (i2{ citationItemType = NormalCite }:is))
+ cleanCitation (Citation a b is)
+ = Citation a b (map removeAffix is)
+
-- note that citations must go first, and order must be preserved:
-- we use a "basic item" that strips off prefixes, suffixes, locators
- let allItems = map basicItem $ citeIds ++ ghostItems
- allCites <- renderItems allItems
+ let citations' = map cleanCitation citations ++
+ [Citation Nothing Nothing (map basicItem ghostItems)]
+ allCites <- renderCitations citations'
mblang <- asks (localeLanguage . contextLocale)
styleOpts <- asks contextStyleOptions
@@ -485,55 +502,51 @@
(unReferenceMap $ stateRefMap st)
refIds }
-- redo citations
- renderItems allItems
+ renderCitations citations'
case getAmbiguities allCites' of
[] -> return ()
- ambiguities -> analyzeAmbiguities mblang strategy ambiguities
- withRWST (\ctx st -> (ctx,
- st { stateLastCitedMap = mempty
- , stateNoteMap = mempty })) $
- mapM (evalLayout (styleCitation style)) (zip [1..] citations)
+ ambiguities -> analyzeAmbiguities mblang strategy citations' ambiguities
+ renderCitations citations
where
- renderItems :: [CitationItem a] -> Eval a [Output a]
- renderItems = withRWST (\ctx st -> (ctx,
- st { stateLastCitedMap = mempty
- , stateNoteMap = mempty })) .
- mapM (\item ->
- Tagged (TagItem NormalCite (citationItemId item)) . grouped <$>
- evalItem (styleCitation style) ([], item))
+ renderCitations :: [Citation a] -> Eval a [Output a]
+ renderCitations cs =
+ withRWST (\ctx st -> (ctx,
+ st { stateLastCitedMap = mempty
+ , stateNoteMap = mempty })) $
+ mapM (evalLayout (styleCitation style)) (zip [1..] cs)
- refreshAmbiguities :: [[DisambData]] -> Eval a [[DisambData]]
- refreshAmbiguities = fmap (concatMap getAmbiguities) .
- mapM (renderItems . map (basicItem . ddItem))
+ refreshAmbiguities :: [Citation a] -> Eval a [[DisambData]]
+ refreshAmbiguities = fmap getAmbiguities . renderCitations
analyzeAmbiguities :: Maybe Lang
-> DisambiguationStrategy
+ -> [Citation a]
-> [[DisambData]]
-> Eval a ()
- analyzeAmbiguities mblang strategy ambiguities = do
+ analyzeAmbiguities mblang strategy cs ambiguities = do
-- add names to et al.
return ambiguities
>>= (\as ->
(if not (null as) && disambiguateAddNames strategy
then do
mapM_ (tryAddNames mblang (disambiguateAddGivenNames strategy)) as
- refreshAmbiguities as
+ refreshAmbiguities cs
else
return as))
>>= (\as ->
(case disambiguateAddGivenNames strategy of
Just ByCite | not (null as) -> do
mapM_ (tryAddGivenNames mblang) as
- refreshAmbiguities as
+ refreshAmbiguities cs
_ -> return as))
>>= (\as ->
(if not (null as) && disambiguateAddYearSuffix strategy
then do
addYearSuffixes bibSortKeyMap as
- refreshAmbiguities as
+ refreshAmbiguities cs
else return as))
>>= mapM_ tryDisambiguateCondition
@@ -729,14 +742,27 @@
. groupBy (\x y -> ddRendered x == ddRendered y)
. sortOn ddRendered
. map toDisambData
+ . extractTagItems
-toDisambData :: CiteprocOutput a => Output a -> DisambData
-toDisambData (Tagged (TagItem NormalCite iid) x) =
+extractTagItems :: [Output a] -> [(ItemId, Output a)]
+extractTagItems xs =
+ [(iid, x) | Tagged (TagItem NormalCite iid) x <- concatMap universe xs
+ , not (hasIbid x)]
+ where -- we don't want two "ibid" entries to be treated as ambiguous.
+ hasIbid x = not $ null [ trm | Tagged (TagTerm trm) _ <- universe x
+ , termName trm == "ibid" ]
+
+
+toDisambData :: CiteprocOutput a => (ItemId, Output a) -> DisambData
+toDisambData (iid, x) =
let xs = universe x
ns' = getNames xs
ds' = getDates xs
t = outputToText x
- in DisambData iid ns' ds' t
+ in DisambData { ddItem = iid
+ , ddNames = ns'
+ , ddDates = ds'
+ , ddRendered = t }
where
getNames :: [Output a] -> [Name]
getNames (Tagged (TagNames _ _ ns) _ : xs)
@@ -749,7 +775,6 @@
= d : getDates xs
getDates (_ : xs) = getDates xs
getDates [] = []
-toDisambData _ = error "toDisambData called without tagged item"
--
@@ -779,13 +804,30 @@
(groupWith sameNames xs)
where
-- Note that we cannot assume we've sorted by name,
- -- so we can't just use Data.ListgroupBy
- groupWith :: (b -> b -> Bool) -> [b] -> [[b]]
+ -- 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 _ [] = []
- groupWith isMatched (z:zs) =
- (z : filter (isMatched z) zs) :
- groupWith isMatched (filter (not . isMatched z) zs)
+ groupWith isMatched (z:zs)
+ | hasSuffix z = [z] : groupWith isMatched zs
+ | otherwise = -- we allow a prefix on first item in collapsed group
+ case span hasNoPrefixOrSuffix zs of
+ ([],ys) -> [z] : groupWith isMatched ys
+ (ws,ys) ->
+ (z : filter (isMatched z) ws) :
+ groupWith isMatched (filter (not . isMatched z) ws ++ ys)
+ hasNoPrefixOrSuffix :: Output a -> Bool
+ hasNoPrefixOrSuffix x = not (hasPrefix x) && not (hasSuffix x)
+
+ hasPrefix :: Output a -> Bool
+ hasPrefix x = not $ null [y | y@(Tagged TagPrefix _) <- universe x]
+
+ hasSuffix :: Output a -> Bool
+ hasSuffix x = not $ null [y | y@(Tagged TagSuffix _) <- universe x]
+
collapseRange :: [Output a] -> [Output a] -> [Output a]
collapseRange ys zs
| length ys >= 3
@@ -982,8 +1024,9 @@
<$> mapM getNamePartSortOrder ns
Just (DateVal d) -> return $ Just [T.toLower $ dateToText d]
+-- Note: we do a case-insensitive sort (using toCaseFold):
normalizeSortKey :: Text -> [Text]
-normalizeSortKey = filter (not . T.null) . T.split isWordSep
+normalizeSortKey = filter (not . T.null) . T.split isWordSep . T.toCaseFold
where
isWordSep c = isSpace c || c == '\'' || c == '’' || c == ',' ||
c == 'ʾ' || c == 'ʿ' -- ayn/hamza in transliterated arabic
@@ -1104,9 +1147,9 @@
updateLastCitedMap citationGroupNumber positionInCitation citation item
return $
- maybe id (\pref x -> grouped [Literal pref, x])
+ maybe id (\pref x -> Tagged TagPrefix (grouped [Literal pref, x]))
(citationItemPrefix item)
- . maybe id (\suff x -> grouped [x, Literal suff])
+ . maybe id (\suff x -> Tagged TagSuffix (grouped [x, Literal suff]))
(citationItemSuffix item)
. (\x -> case x of
NullOutput -> x
@@ -1154,8 +1197,8 @@
}))
$ do xs <- mconcat <$> mapM eElement (layoutElements layout)
- -- find identifiers that can be used to hyperlink the title
- let mbident =
+ -- find identifiers that can be used to hyperlink the title
+ let mbident =
foldl (<|>) Nothing
[ IdentDOI <$> (valToText =<< lookupVariable "DOI" ref)
, IdentPMCID <$> (valToText =<< lookupVariable "PMCID" ref)
@@ -1163,14 +1206,14 @@
, IdentURL <$> (valToText =<< lookupVariable "URL" ref)
]
let mburl = identifierToURL <$> mbident
-
+
-- hyperlink any titles in the output
let linkTitle url (Tagged TagTitle x) = Linked url [Tagged TagTitle x]
linkTitle _ x = x
-
+
usedLink <- gets stateUsedIdentifier
usedTitle <- gets stateUsedTitle
- inBiblio <- asks contextInBibliography
+ inBiblio <- asks contextInBibliography
-- when no links were rendered for a bibliography item, hyperlink
-- the title, if it exists, otherwise hyperlink the whole item
@@ -1183,7 +1226,7 @@
-- hyperlink the title
then fmap (transform (linkTitle url)) xs
-- hyperlink the entire bib item
- else [Linked url xs]
+ else [Linked url xs]
let mblang = lookupVariable "language" ref
>>= valToText
@@ -1263,8 +1306,8 @@
capitalizeInitialTerm [] = []
capitalizeInitialTerm (z:zs) = go z : zs
where
- go (Tagged TagTerm x) =
- Tagged TagTerm
+ go (Tagged (TagTerm t) x) =
+ Tagged (TagTerm t)
(formatted mempty{ formatTextCase = Just CapitalizeFirst } [x])
go (Formatted f xs) = Formatted f (capitalizeInitialTerm xs)
go (Tagged tg x) = Tagged tg (go x)
@@ -1586,7 +1629,7 @@
let url = identifierToURL (identConstr t)
return $ Linked url [Literal $ fromText t]
handleSubst :: Eval a ()
- handleSubst = do inSubst <- asks contextInSubstitute
+ handleSubst = do inSubst <- asks contextInSubstitute
when inSubst $
modify $ \st -> -- delete variable so it isn't used again...
st{ stateReference =
@@ -1608,7 +1651,7 @@
-> return $ grouped [t', Literal (fromText " "), suff]
| otherwise -> return $ grouped [t', suff]
else return t'
- return $ Tagged TagTerm t''
+ return $ Tagged (TagTerm term) t''
-- Numbers with prefixes or suffixes are never ordinalized
@@ -1955,8 +1998,12 @@
else return vars
else return vars
inSubstitute <- asks contextInSubstitute
- let (nameFormat, nameFormatting) =
- fromMaybe (defaultNameFormat, mempty) $ namesName namesFormat
+ let (nameFormat, nameFormatting') =
+ fromMaybe (defaultNameFormat, mempty) (namesName namesFormat)
+ let nameFormatting = nameFormatting' <>
+ formatting{ formatPrefix = Nothing
+ , formatSuffix = Nothing
+ , formatDelimiter = Nothing }
rawContribs <- mapM (\var -> (var,) <$>
askVariable
(if var == "editortranslator"
@@ -1995,7 +2042,10 @@
CountName -> Literal $ fromText $ T.pack $ show $ length
[name
| Tagged (TagName name) _ <- concatMap universe xs]
- _ -> formatted formatting xs
+ _ -> formatted mempty{ formatPrefix = formatPrefix formatting
+ , formatSuffix = formatSuffix formatting
+ , formatDelimiter =
+ formatDelimiter formatting } xs
eSubstitute :: CiteprocOutput a
=> [Element a]
diff --git a/src/Citeproc/Types.hs b/src/Citeproc/Types.hs
--- a/src/Citeproc/Types.hs
+++ b/src/Citeproc/Types.hs
@@ -1492,7 +1492,7 @@
else x
data Tag =
- TagTerm
+ TagTerm Term
| TagCitationNumber Int
| TagCitationLabel
| TagTitle
@@ -1503,6 +1503,8 @@
| TagDate Date
| TagYearSuffix Int
| TagLocator
+ | TagPrefix
+ | TagSuffix
deriving (Show, Eq)
outputToText :: CiteprocOutput a => Output a -> Text
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,10 +1,10 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Citeproc
import Citeproc.CslJson
-import Data.Semigroup
import Data.Algorithm.DiffContext
import System.TimeIt (timeIt)
import Control.Monad (unless)
@@ -30,6 +30,9 @@
import System.FilePath
import Data.Maybe (fromMaybe)
import Text.Printf (printf)
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup
+#endif
data CiteprocTest a =
CiteprocTest
@@ -336,7 +339,7 @@
(length (skipped counts))
case length (failed counts) + length (errored counts) of
0 -> exitSuccess
- n | n <= 66 -> do
+ n | n <= 65 -> do
putStrLn "We have passed all the CSL tests we expect to..."
exitSuccess
| otherwise -> exitWith $ ExitFailure n
diff --git a/test/extra/case_insensitive.txt b/test/extra/case_insensitive.txt
new file mode 100644
--- /dev/null
+++ b/test/extra/case_insensitive.txt
@@ -0,0 +1,63 @@
+Zotero does a case-insensitive sort, so we will too.
+
+>>===== MODE =====>>
+bibliography
+<<===== MODE =====<<
+
+
+
+>>===== RESULT =====>>
+
+
The Civil Law
+
The civil life
+