diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,58 @@
# citeproc changelog
+## 0.5
+
+ * Add `linkBibliography` field to `CiteprocOptions` [API change].
+ When this is set to True, we hyperlink bibliography entries according
+ to the draft of the CSL v1.02 spec (Appendix VI). When an entry has
+ a DOI, PMCID, PMID, or URL available but none of these are rendered
+ by the style, add a link to the title (or, if no title is present,
+ the whole entry), using the URL for the DOI, PMCID, PMID, or URL
+ (in that order of priority). (Benjamin Bray, #88.)
+
+ * In generating citation labels, only use `issued` date.
+ Not, for example, `accessed` (#80).
+
+ * Citeproc.Locale: export `lookupQuotes`. [API change]
+
+ * Citeproc.Types: Add `localizeQuotes` method to CiteprocOutput class
+ [API change].
+
+ * Citeproc.CslJson, Citeproc.Pandoc: Implement `localizeQuotes`.
+
+ * Citeproc: apply `localizeQuotes` after rendering. This ensures
+ that quotes are properly localized and flipflopped. Previously this
+ was done in `renderCslJson` (for CSL JSON) and in pandoc
+ (for Pandoc Inlines). It is more consistent to do this as part
+ of the rendering pipeline, in citeproc itself.
+
+ * Citeproc.CslJson: Drop the Locale parameter from the signature of
+ `renderCslJson` [breaking API change]. It was only needed for quote
+ localization, which now occurs outside of this function.
+
+ * Citeproc.Pandoc: use a Span with class csl-quoted for quotes,
+ rather than a Quoted inline. This way we can leave Quoted elements
+ passed in by pandoc alone, and we won't get strange effects like the
+ one described in #87 (where `"` behaves differently when in
+ a citation suffix).
+
+ * Default to Shifted with `icu` flag (#83). This makes the library
+ behave similarly whether compiled with `icu` or with the default
+ `unicode-collation` and prevents test failures with `icu`.
+
+ * Require recent text-icu with icu flag.
+ Older versions don't build with newer versions of icu4c.
+
+ * Support links in CslJson (Benjamin Bray). Currently they are
+ only supported in rendering, not parsing (in support of #88).
+
+ * Allow test cases to specify CiteprocOptions (Benjamin Bray).
+
+ * Update locales from upstream.
+
+ * Add new CSL tests to repository.
+
+
## 0.4.1
* Change Pandoc `inNote` so it creates a `Span` with class `csl-note`
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -40,8 +40,20 @@
The main point of entry is the function `citeproc` from the
module `Citeproc`. This takes as arguments:
-- a `CiteprocOptions` structure (which currently just allows you
- to set whether citations are hyperlinked to the bibliography)
+- a `CiteprocOptions` structure, which includes the following options:
+
+ * `linkCitations` controls whether citations are hyperlinked
+ to the bibliography.
+
+ * `linkBibliography` automatically linkifies any identifiers (DOI,
+ PMCID, PMID, or URL) appearing in a bibliography entry. When an
+ entry has a DOI, PMCID, PMID, or URL available but none of these
+ are rendered by the style, add a link to the title (or, if no title
+ is present, the whole entry), using the URL for the DOI, PMCID,
+ PMID, or URL (in that order of priority). See
+ [Appendix VI](https://github.com/citation-style-language/documentation/blob/master/specification.rst#appendix-vi-links)
+ of the CSL v1.0.2 spec.
+
- a `Style`, which you will want to produce by parsing a CSL
style file using `parseStyle` from `Citeproc.Style`.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/Main.hs b/app/Main.hs
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -88,10 +88,10 @@
case format of
Json -> Aeson.object
[ ("citations", Aeson.toJSON $
- map (cslJsonToJson locale)
+ map cslJsonToJson
(resultCitations result))
, ("bibliography", Aeson.toJSON $
- map (second $ cslJsonToJson locale)
+ map (second cslJsonToJson)
(resultBibliography result))
, ("warnings", Aeson.toJSON $ resultWarnings result)
]
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.4.1
+version: 0.5
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
@@ -81,7 +81,7 @@
, unicode-collation >= 0.1.3 && < 0.2
-- , pretty-show
if flag(icu)
- build-depends: text-icu
+ build-depends: text-icu >= 0.7.1.0
ghc-options: -Wall
-Wincomplete-record-updates
diff --git a/locales/locales.json b/locales/locales.json
--- a/locales/locales.json
+++ b/locales/locales.json
@@ -17,6 +17,7 @@
"fi": "fi-FI",
"fr": "fr-FR",
"he": "he-IL",
+ "hi": "hi-IN",
"hr": "hr-HR",
"hu": "hu-HU",
"id": "id-ID",
@@ -112,7 +113,7 @@
"Spanish (Mexico)"
],
"et-EE": [
- "Eesti",
+ "Eesti keel",
"Estonian"
],
"eu": [
@@ -139,6 +140,10 @@
"עברית",
"Hebrew"
],
+ "hi-IN": [
+ "हिंदी",
+ "Hindi"
+ ],
"hr-HR": [
"Hrvatski",
"Croatian"
@@ -176,7 +181,7 @@
"Latin"
],
"lt-LT": [
- "Lietuvių",
+ "Lietuvių kalba",
"Lithuanian"
],
"lv-LV": [
diff --git a/locales/pl-PL.xml b/locales/pl-PL.xml
--- a/locales/pl-PL.xml
+++ b/locales/pl-PL.xml
@@ -7,6 +7,9 @@
Michal
+
+ Pendzoncymisio
+
This work is licensed under a Creative Commons Attribution-ShareAlike 3.0 License
2012-07-04T23:31:02+00:00
@@ -22,7 +25,7 @@
- udostępniono
+ dostęp
i
i inni
anonim
diff --git a/locales/th-TH.xml b/locales/th-TH.xml
--- a/locales/th-TH.xml
+++ b/locales/th-TH.xml
@@ -282,7 +282,7 @@
กรกฎาคม
สิงหาคม
กันยายน
- ตุลาคาม
+ ตุลาคม
พฤศจิกายน
ธันวาคม
diff --git a/src/Citeproc.hs b/src/Citeproc.hs
--- a/src/Citeproc.hs
+++ b/src/Citeproc.hs
@@ -34,9 +34,16 @@
, resultBibliography = rBibliography
, resultWarnings = warnings ++ noPrintedFormWarnings }
where
- rCitations = map (trimR . movePunct . renderOutput opts) citationOs
- rBibliography = map (second (trimR . movePunct .
- renderOutput opts{ linkCitations = False }))
+ rCitations = map ( trimR
+ . localizeQuotes locale
+ . movePunct
+ . renderOutput opts
+ ) citationOs
+ rBibliography = map (second
+ ( trimR
+ . localizeQuotes locale
+ . movePunct
+ . renderOutput opts{ linkCitations = False } ))
bibliographyOs
locale = mergeLocales mblang style
trimR = dropTextWhileEnd (== ' ')
diff --git a/src/Citeproc/CslJson.hs b/src/Citeproc/CslJson.hs
--- a/src/Citeproc/CslJson.hs
+++ b/src/Citeproc/CslJson.hs
@@ -30,13 +30,12 @@
import Citeproc.Types
+import Citeproc.Locale (lookupQuotes)
import Citeproc.CaseTransform
import Data.Ord ()
import Data.Char (isAlphaNum, isSpace, isAscii)
import Data.Text (Text)
-import Data.Maybe (fromMaybe)
import qualified Data.Text as T
-import qualified Data.Map as M
import Data.Foldable (fold)
import Data.Functor.Identity
import Data.Attoparsec.Text as P
@@ -62,6 +61,7 @@
| CslSub (CslJson a)
| CslNoCase (CslJson a)
| CslDiv Text (CslJson a)
+ | CslLink Text (CslJson a)
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
instance Semigroup (CslJson a) where
@@ -96,6 +96,7 @@
uniplate (CslSub x) = plate CslSub |* x
uniplate (CslNoCase x) = plate CslNoCase |* x
uniplate (CslDiv t x) = plate CslDiv |- t |* x
+ uniplate (CslLink t x) = plate CslLink |- t |* x
instance Biplate (CslJson a) (CslJson a) where
biplate = plateSelf
@@ -147,7 +148,8 @@
movePunctuationInsideQuotes
= punctuationInsideQuotes
mapText f = runIdentity . traverse (return . f)
- addHyperlink _ = id -- CSL JSON doesn't support links
+ addHyperlink url x = CslLink url x
+ localizeQuotes = convertQuotes
dropTextWhile' :: (Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhile' f x = evalState (traverse g x) False
@@ -178,6 +180,7 @@
CslSup x -> CslSup (dropTextWhileEnd' f x)
CslNoCase x -> CslNoCase (dropTextWhileEnd' f x)
CslDiv t x -> CslDiv t (dropTextWhileEnd' f x)
+ CslLink t x -> CslLink t (dropTextWhileEnd' f x)
parseCslJson :: Locale -> Text -> CslJson Text
parseCslJson locale t =
@@ -203,7 +206,7 @@
]
where
((outerOpenQuote, outerCloseQuote), (innerOpenQuote, innerCloseQuote)) =
- fromMaybe (("\x201C","\x201D"),("\x2018","\x2019")) $ lookupQuotes locale
+ lookupQuotes locale
isSpecialChar c = c == '<' || c == '>' || c == '\'' || c == '"' ||
c == '’' || (not (isAscii c) && (isSuperscriptChar c || isQuoteChar c))
isQuoteChar = P.inClass
@@ -287,21 +290,6 @@
, useSmallCaps :: Bool
} deriving (Show, Eq)
-lookupTerm :: Locale -> Text -> Maybe Text
-lookupTerm locale termname = do
- let terms = localeTerms locale
- case M.lookup termname terms of
- Just ((_,t):_) -> Just t
- _ -> Nothing
-
-lookupQuotes :: Locale -> Maybe ((Text, Text), (Text, Text))
-lookupQuotes locale = do
- outerQuotes <- (,) <$> lookupTerm locale "open-quote"
- <*> lookupTerm locale "close-quote"
- innerQuotes <- (,) <$> lookupTerm locale "open-inner-quote"
- <*> lookupTerm locale "close-inner-quote"
- return (outerQuotes, innerQuotes)
-
-- | Render 'CslJson' as 'Text'. Set the first parameter to True
-- when rendering HTML output (so that entities are escaped).
-- Set it to False when rendering for CSL JSON bibliographies.
@@ -312,8 +300,7 @@
renderCslJson useEntities locale =
go (RenderContext True True True True)
where
- (outerQuotes, innerQuotes) = fromMaybe (("\"","\""),("'","'"))
- $ lookupQuotes locale
+ (outerQuotes, innerQuotes) = lookupQuotes locale
go :: RenderContext -> CslJson Text -> Text
go ctx el =
case el of
@@ -363,6 +350,7 @@
CslSub x -> "" <> go ctx x <> ""
CslBaseline x -> "" <> go ctx x <> ""
CslDiv t x -> " t <> "\">" <> go ctx x <> "
"
+ CslLink t x -> " t <> "\">" <> go ctx x <> ""
CslNoCase x -> go ctx x -- nocase is just for internal purposes
escape t
| useEntities
@@ -373,11 +361,41 @@
Nothing -> t
| otherwise = t
-cslJsonToJson :: Locale -> CslJson Text -> [Value]
-cslJsonToJson locale = go (RenderContext True True True True)
+-- localized quotes
+convertQuotes :: Locale -> CslJson Text -> CslJson Text
+convertQuotes locale = go True
where
- (outerQuotes, innerQuotes) = fromMaybe
- (("\"","\""),("'","'")) $ lookupQuotes locale
+ (outerQuotes, innerQuotes) = lookupQuotes locale
+
+ go useOuter el =
+ case el of
+ CslConcat x y -> go useOuter x <> go useOuter y
+ CslQuoted x
+ | useOuter
+ -> CslText (fst outerQuotes) <>
+ go (not useOuter) x <>
+ CslText (snd outerQuotes)
+ | otherwise
+ -> CslText (fst innerQuotes) <>
+ go (not useOuter) x <>
+ CslText (snd innerQuotes)
+ CslNormal x -> CslNormal $ go useOuter x
+ CslItalic x -> CslItalic $ go useOuter x
+ CslBold x -> CslBold $ go useOuter x
+ CslUnderline x -> CslUnderline $ go useOuter x
+ CslNoDecoration x -> CslNoDecoration $ go useOuter x
+ CslSmallCaps x -> CslSmallCaps $ go useOuter x
+ CslSup x -> CslSup $ go useOuter x
+ CslSub x -> CslSub $ go useOuter x
+ CslBaseline x -> CslBaseline $ go useOuter x
+ CslDiv t x -> CslDiv t $ go useOuter x
+ CslNoCase x -> CslNoCase $ go useOuter x
+ x -> x
+
+
+cslJsonToJson :: CslJson Text -> [Value]
+cslJsonToJson = go (RenderContext True True True True)
+ where
isString (String _) = True
isString _ = False
consolidateStrings :: [Value] -> [Value]
@@ -396,15 +414,7 @@
CslConcat x CslEmpty -> go ctx x
CslConcat (CslConcat x y) z -> go ctx (CslConcat x (CslConcat y z))
CslConcat x y -> go ctx x <> go ctx y
- CslQuoted x
- | useOuterQuotes ctx
- -> [String (fst outerQuotes)] <>
- go ctx{ useOuterQuotes = False } x <>
- [String (snd outerQuotes)]
- | otherwise
- -> [String (fst innerQuotes)] <>
- go ctx{ useOuterQuotes = True } x <>
- [String (snd innerQuotes)]
+ CslQuoted x -> go ctx x -- should be localized already
CslNormal x
| useItalics ctx -> go ctx x
| otherwise -> [ object
@@ -482,6 +492,12 @@
, ("contents", toJSON $ go ctx x)
]
]
+ CslLink t x -> [ object
+ [ ("format", "link")
+ , ("target", toJSON $ t)
+ , ("contents", toJSON $ go ctx x)
+ ]
+ ]
CslNoCase x -> go ctx x -- nocase is just for internal purposes
@@ -515,6 +531,7 @@
CslSup _ -> return' el
CslNoCase _ -> return' el
CslDiv _ _ -> return' el
+ CslLink _ _ -> return' el
CslEmpty -> return' el
where
-- we need to apply g to update the state:
@@ -588,6 +605,7 @@
CslBaseline x -> CslBaseline (go x)
CslNoCase x -> CslNoCase (go x)
CslDiv t x -> CslDiv t (go x)
+ CslLink t x -> CslLink t (go x)
CslText t -> CslText t
CslEmpty -> CslEmpty
diff --git a/src/Citeproc/Eval.hs b/src/Citeproc/Eval.hs
--- a/src/Citeproc/Eval.hs
+++ b/src/Citeproc/Eval.hs
@@ -73,6 +73,10 @@
, stateRefMap :: ReferenceMap a
, stateReference :: Reference a
, stateUsedYearSuffix :: Bool
+ , stateUsedIdentifier :: Bool
+ -- ^ tracks whether an identifier (DOI,PMCID,PMID,URL) has yet been used
+ , stateUsedTitle :: Bool
+ -- ^ tracks whether the item title has yet been used
} deriving (Show)
@@ -120,6 +124,8 @@
, stateRefMap = refmap
, stateReference = Reference mempty mempty Nothing mempty
, stateUsedYearSuffix = False
+ , stateUsedIdentifier = False
+ , stateUsedTitle = False
}
assignCitationNumbers sortedIds =
@@ -1142,16 +1148,51 @@
, contextPosition = position
},
st{ stateReference = ref
- , stateUsedYearSuffix = False }))
+ , stateUsedYearSuffix = False
+ , stateUsedIdentifier = False
+ , stateUsedTitle = False
+ }))
$ do xs <- mconcat <$> mapM eElement (layoutElements layout)
+
+ -- find identifiers that can be used to hyperlink the title
+ let mbident =
+ foldl (<|>) Nothing
+ [ IdentDOI <$> (valToText =<< lookupVariable "DOI" ref)
+ , IdentPMCID <$> (valToText =<< lookupVariable "PMCID" ref)
+ , IdentPMID <$> (valToText =<< lookupVariable "PMID" ref)
+ , 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
+
+ -- when no links were rendered for a bibliography item, hyperlink
+ -- the title, if it exists, otherwise hyperlink the whole item
+ let xs' =
+ if usedLink || not inBiblio
+ then xs
+ else case mburl of
+ Nothing -> xs
+ Just url -> if usedTitle
+ -- hyperlink the title
+ then fmap (transform (linkTitle url)) xs
+ -- hyperlink the entire bib item
+ else [Linked url xs]
+
let mblang = lookupVariable "language" ref
>>= valToText
>>= either (const Nothing) Just . parseLang
return $
case mblang of
- Nothing -> xs
+ Nothing -> xs'
Just lang -> map
- (transform (addLangToFormatting lang)) xs
+ (transform (addLangToFormatting lang)) xs'
Nothing -> do
warn $ "citation " <> unItemId (citationItemId item) <>
" not found"
@@ -1425,7 +1466,6 @@
eText :: CiteprocOutput a => TextType -> Eval a (Output a)
eText (TextVariable varForm v) = do
ref <- gets stateReference
- inSubstitute <- asks contextInSubstitute
-- 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,
@@ -1499,6 +1539,11 @@
coerce (referenceId ref)
return NullOutput
+ "DOI" -> handleIdent fixShortDOI IdentDOI
+ "PMCID" -> handleIdent id IdentPMCID
+ "PMID" -> handleIdent id IdentPMID
+ "URL" -> handleIdent id IdentURL
+
_ -> do
mbv <- if varForm == ShortForm
then do
@@ -1521,12 +1566,32 @@
Just (NumVal x) -> return $ Literal
$ fromText (T.pack (show x))
_ -> return NullOutput
- when inSubstitute $
- modify $ \st -> -- delete variable so it isn't used again...
- st{ stateReference =
- let Reference id' type' d' m' = stateReference st
- in Reference id' type' d' (M.delete v m') }
- return res
+ handleSubst
+ if v == "title" && res /= NullOutput
+ then do
+ modify (\st -> st { stateUsedTitle = True })
+ -- tag title so we can hyperlink it later
+ return $ Tagged TagTitle res
+ else return res
+ where
+ handleIdent :: CiteprocOutput b => (Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
+ handleIdent f identConstr = do
+ mbv <- askVariable v
+ handleSubst
+ case f <$> (valToText =<< mbv) of
+ Nothing -> return NullOutput
+ Just t -> do
+ -- create link and remember that we've done so far
+ modify (\st -> st { stateUsedIdentifier = True })
+ let url = identifierToURL (identConstr t)
+ return $ Linked url [Literal $ fromText t]
+ handleSubst :: Eval a ()
+ handleSubst = do inSubst <- asks contextInSubstitute
+ when inSubst $
+ modify $ \st -> -- delete variable so it isn't used again...
+ st{ stateReference =
+ let Reference id' type' d' m' = stateReference st
+ in Reference id' type' d' (M.delete v m') }
eText (TextMacro name) = do
warn $ "encountered unexpanded macro " <> name
return NullOutput
@@ -2254,6 +2319,8 @@
case formatSuffix f of
Just t | endsWithSpace t -> Nothing
_ -> Just " " } [formatted f x, y]
+ Linked i x <+> y =
+ formatted mempty{ formatDelimiter = Just " " } [Linked i x, y]
Tagged _ x <+> y = x <+> y
InNote x <+> y = x <+> y
let x <:> NullOutput = x
@@ -2262,6 +2329,8 @@
formatted mempty{ formatDelimiter = Just separator } [Literal x, y]
Formatted f x <:> y = formatted
(mempty{ formatDelimiter = Just separator }) [Formatted f x, y]
+ Linked i x <:> y = formatted
+ (mempty{ formatDelimiter = Just separator }) [Linked i x, y]
Tagged _ x <:> y = x <:> y
InNote x <:> y = x <:> y
@@ -2543,11 +2612,9 @@
citationLabel ref = TextVal trigraph
where
trigraph = namepart <> datepart
- datepart = case datevars of
- [] -> ""
- (var:_) -> case M.lookup var varmap of
- Just (DateVal d) -> getYear d
- _ -> ""
+ datepart = case M.lookup "issued" varmap of
+ Just (DateVal d) -> getYear d
+ _ -> ""
namepart = if "author" `elem` namevars
then getNames "author"
else case namevars of
@@ -2556,7 +2623,6 @@
varmap = referenceVariables ref
vars = M.keys varmap
namevars = [v | v <- vars, variableType v == NameVariable]
- datevars = [v | v <- vars, variableType v == DateVariable]
getNames var = case M.lookup var varmap of
Just (NamesVal ns) ->
let x = case length ns of
@@ -2568,8 +2634,8 @@
(take 4 ns)
_ -> ""
getYear d = case dateParts d of
- (DateParts (x:_):_) -> T.pack $ printf "%02d"
- $ x `mod` 100
+ (DateParts (x:_):_) ->
+ T.pack (printf "%02d" $ x `mod` 100)
_ -> ""
removeDoubleSpaces :: Text -> Text
diff --git a/src/Citeproc/Locale.hs b/src/Citeproc/Locale.hs
--- a/src/Citeproc/Locale.hs
+++ b/src/Citeproc/Locale.hs
@@ -3,13 +3,15 @@
module Citeproc.Locale
( parseLocale,
getLocale,
- getPrimaryDialect
+ getPrimaryDialect,
+ lookupQuotes
)
where
import Citeproc.Types
import Citeproc.Element (runElementParser, pLocale)
import Citeproc.Data (localeFiles)
import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Text.XML as X
import System.FilePath (takeExtension, dropExtension)
@@ -105,4 +107,19 @@
(\l -> M.lookup (toCode l) locales)) of
Just loc -> loc
Nothing -> Left $ CiteprocLocaleNotFound $ renderLang lang
+
+lookupTerm :: Locale -> Text -> Maybe Text
+lookupTerm locale termname = do
+ let terms = localeTerms locale
+ case M.lookup termname terms of
+ Just ((_,t):_) -> Just t
+ _ -> Nothing
+
+lookupQuotes :: Locale -> ((Text, Text), (Text, Text))
+lookupQuotes locale = ((outerOpen, outerClose), (innerOpen, innerClose))
+ where
+ outerOpen = fromMaybe "\x201C" $ lookupTerm locale "open-quote"
+ outerClose = fromMaybe "\x201D" $ lookupTerm locale "close-quote"
+ innerOpen = fromMaybe "\x2018" $ lookupTerm locale "open-inner-quote"
+ innerClose = fromMaybe "\x2019" $ lookupTerm locale "close-inner-quote"
diff --git a/src/Citeproc/Pandoc.hs b/src/Citeproc/Pandoc.hs
--- a/src/Citeproc/Pandoc.hs
+++ b/src/Citeproc/Pandoc.hs
@@ -17,6 +17,7 @@
import Citeproc.CaseTransform
import Control.Monad.Trans.State.Strict as S
import Control.Monad (unless, when)
+import Citeproc.Locale (lookupQuotes)
import Data.Functor.Reverse
import Data.Char (isSpace, isPunctuation, isAlphaNum)
@@ -68,7 +69,7 @@
DisplayLeftMargin -> B.spanWith ("",["csl-left-margin"],[])
DisplayRightInline -> B.spanWith ("",["csl-right-inline"],[])
DisplayIndent -> B.spanWith ("",["csl-indent"],[])
- addQuotes = B.doubleQuoted . flipFlopQuotes DoubleQuote
+ addQuotes = B.spanWith ("",["csl-quoted"],[])
inNote = B.spanWith ("",["csl-note"],[])
movePunctuationInsideQuotes
= punctuationInsideQuotes
@@ -76,20 +77,31 @@
where go (Str t) = Str (f t)
go x = x
addHyperlink t = B.link t ""
+ localizeQuotes = convertQuotes
-flipFlopQuotes :: QuoteType -> Inlines -> Inlines
-flipFlopQuotes qt = B.fromList . map (go qt) . B.toList
+-- localized quotes
+convertQuotes :: Locale -> Inlines -> Inlines
+convertQuotes locale = B.fromList . map (go DoubleQuote) . B.toList
where
+ ((oqOuter, cqOuter), (oqInner, cqInner)) = lookupQuotes locale
+
+ oq DoubleQuote = oqOuter
+ oq SingleQuote = oqInner
+ cq DoubleQuote = cqOuter
+ cq SingleQuote = cqInner
+
+ flipflop SingleQuote = DoubleQuote
+ flipflop DoubleQuote = SingleQuote
+
go :: QuoteType -> Inline -> Inline
- go q (Quoted _ zs) =
- let q' = case q of
- SingleQuote -> DoubleQuote
- DoubleQuote -> SingleQuote
- in Quoted q' (map (go q') zs)
+ go q (Span ("",["csl-quoted"],[]) ils) =
+ Span ("",["csl-quoted"],[])
+ (Str (oq q) : map (go (flipflop q)) ils ++ [Str (cq q)])
+ go q (Span attr zs) = Span attr (map (go q) zs)
+ go q (Quoted qt' zs) = Quoted qt' (map (go q) zs)
go q (SmallCaps zs) = SmallCaps (map (go q) zs)
go q (Superscript zs) = Superscript (map (go q) zs)
go q (Subscript zs) = Subscript (map (go q) zs)
- go q (Span attr zs) = Span attr (map (go q) zs)
go q (Emph zs) = Emph (map (go q) zs)
go q (Underline zs) = Underline (map (go q) zs)
go q (Strong zs) = Strong (map (go q) zs)
@@ -107,9 +119,17 @@
Just (c,_) -> c == '.' || c == ','
Nothing -> False
go [] = []
+ go (Span ("",["csl-quoted"],[]) xs : Str t : rest)
+ | startsWithMovable t
+ = Span ("",["csl-quoted"],[])
+ (xs ++ [Str (T.take 1 t) | not (endWithPunct True xs)]) :
+ if T.length t == 1
+ then go rest
+ else Str (T.drop 1 t) : go rest
go (Quoted qt xs : Str t : rest)
| startsWithMovable t
- = Quoted qt (xs ++ [Str (T.take 1 t) | not (endWithPunct True xs)]) :
+ = Quoted qt
+ (xs ++ [Str (T.take 1 t) | not (endWithPunct True xs)]) :
if T.length t == 1
then go rest
else Str (T.drop 1 t) : go rest
diff --git a/src/Citeproc/Types.hs b/src/Citeproc/Types.hs
--- a/src/Citeproc/Types.hs
+++ b/src/Citeproc/Types.hs
@@ -89,6 +89,9 @@
, fromVariable
, lookupVariable
, Output(..)
+ , Identifier(..)
+ , identifierToURL
+ , fixShortDOI
, Tag(..)
, outputToText
, renderOutput
@@ -141,17 +144,30 @@
-- | Options affecting the output in ways that go beyond
-- what can be specified in styles.
-newtype CiteprocOptions =
+data CiteprocOptions =
CiteprocOptions
{ linkCitations :: Bool
-- ^ Create hyperlinks from citations to bibliography entries
+ , linkBibliography :: Bool
+ -- ^ Enables the following options:
+ --
+ -- * Automatically linkify any DOI, PMCID, PMID, or URL
+ -- appearing in a bibliography entry.
+ -- * When a bibliography entry has a DOI, PMCID, PMID, or URL available
+ -- (in order of priority), but the style does not explicitly render at
+ -- least one of them, add a hyperlink to the title instead.
+ -- * A bibliography item with a DOI, PMCID, PMID, or URL available
+ -- (in order of priority) will be wrapped in a hyperlink when the hyperlink
+ -- has not already been applied to one of its parts (e.g. to the title).
}
deriving (Show, Eq)
defaultCiteprocOptions :: CiteprocOptions
defaultCiteprocOptions =
CiteprocOptions
- { linkCitations = False }
+ { linkCitations = False
+ , linkBibliography = False
+ }
data CiteprocError =
CiteprocXMLError Text
@@ -190,6 +206,7 @@
inNote :: a -> a
mapText :: (Text -> Text) -> a -> a
addHyperlink :: Text -> a -> a
+ localizeQuotes :: Locale -> a -> a
addFormatting :: CiteprocOutput a => Formatting -> a -> a
addFormatting f x =
@@ -1431,6 +1448,7 @@
data Output a =
Formatted Formatting [Output a]
+ | Linked Text [Output a]
| InNote (Output a)
| Literal a
| Tagged Tag (Output a)
@@ -1439,6 +1457,7 @@
instance Uniplate (Output a) where
uniplate (Formatted f xs) = plate Formatted |- f ||* xs
+ uniplate (Linked u xs) = plate Linked |- u ||* xs
uniplate (InNote x) = plate InNote |* x
uniplate (Literal x) = plate Literal |- x
uniplate (Tagged t x) = plate Tagged |- t |* x
@@ -1447,10 +1466,37 @@
instance Biplate (Output a) (Output a) where
biplate = plateSelf
+data Identifier =
+ IdentDOI Text
+ | IdentPMCID Text
+ | IdentPMID Text
+ | IdentURL Text
+ deriving (Show, Eq)
+
+identifierToURL :: Identifier -> Text
+identifierToURL ident =
+ case ident of
+ IdentDOI t -> tolink "https://doi.org/" (fixShortDOI t)
+ IdentPMCID t -> tolink "https://www.ncbi.nlm.nih.gov/pmc/articles/" t
+ IdentPMID t -> tolink "https://www.ncbi.nlm.nih.gov/pubmed/" t
+ IdentURL t -> tolink "https://" t
+ where
+ tolink pref x = if T.null x || ("://" `T.isInfixOf` x)
+ then x
+ else pref <> x
+
+-- see https://shortdoi.org
+fixShortDOI :: Text -> Text
+fixShortDOI x = if "10/" `T.isPrefixOf` x
+ then T.drop 3 x
+ else x
+
data Tag =
TagTerm
| TagCitationNumber Int
| TagCitationLabel
+ | TagTitle
+ -- ^ marks the title of an entry, so it can be hyperlinked later
| TagItem CitationItemType ItemId
| TagName Name
| TagNames Variable NamesFormat [Name]
@@ -1464,6 +1510,7 @@
outputToText (Literal x ) = toText x
outputToText (Tagged _ x) = outputToText x
outputToText (Formatted _ xs) = T.unwords $ map outputToText xs
+outputToText (Linked _ xs) = T.unwords $ map outputToText xs
outputToText (InNote x) = outputToText x
renderOutput :: CiteprocOutput a => CiteprocOptions -> Output a -> a
@@ -1474,11 +1521,25 @@
, itemtype /= AuthorOnly
= addHyperlink ("#ref-" <> unItemId ident) $ renderOutput opts x
renderOutput opts (Tagged _ x) = renderOutput opts x
+renderOutput opts (Formatted f [Linked url xs])
+ | linkBibliography opts
+ , url == prefix <> anchor
+ -- ensure correct handling of link prefixes like (https://doi.org/)
+ -- when a link's prefix+anchor=target, ensure the link includes the prefix
+ -- (see pandoc#6723 and citeproc#88)
+ = renderOutput opts $ Linked url [Formatted f xs]
+ where
+ anchor = mconcat (map outputToText xs)
+ prefix = fromMaybe "" (formatPrefix f)
renderOutput opts (Formatted formatting xs) =
addFormatting formatting . mconcat . fixPunct .
(case formatDelimiter formatting of
Just d -> addDelimiters (fromText d)
Nothing -> id) . filter (/= mempty) $ map (renderOutput opts) xs
+renderOutput opts (Linked url xs)
+ = (if linkBibliography opts
+ then addHyperlink url
+ else id) . mconcat . fixPunct $ map (renderOutput opts) xs
renderOutput opts (InNote x) = inNote $
dropTextWhile isSpace $
dropTextWhile (\c -> c == ',' || c == ';' || c == '.' || c == ':') $
diff --git a/src/Citeproc/Unicode.hs b/src/Citeproc/Unicode.hs
--- a/src/Citeproc/Unicode.hs
+++ b/src/Citeproc/Unicode.hs
@@ -13,6 +13,7 @@
import Text.Collate.Lang (Lang(..), parseLang, renderLang, lookupLang)
#ifdef MIN_VERSION_text_icu
import qualified Data.Text.ICU as ICU
+import qualified Data.Text.ICU.Collate as ICUC
#else
import qualified Text.Collate as U
#endif
@@ -56,14 +57,19 @@
comp :: Maybe Lang -> Text -> Text -> Ordering
#ifdef MIN_VERSION_text_icu
-comp mblang = ICU.collate (ICU.collator (toICULocale mblang))
+comp mblang = ICU.collate collator
+ where
+ collator = ICU.collatorWith (toICULocale mblang) [ICUC.AlternateHandling alt]
+ alt = case mblang >>= lookup "u" . langExtensions >>= lookup "ka" of
+ Just "noignore" -> ICUC.NonIgnorable
+ _ -> ICUC.Shifted
#else
-comp mblang =
- let lang = fromMaybe (Lang "" Nothing Nothing [] [] []) mblang
- coll = case lookup "u" (langExtensions lang) >>= lookup "ka" of
- -- default to Shifted variable weighting, unless a variable
- -- weighting is explicitly specified with the ka keyword:
- Nothing -> U.setVariableWeighting U.Shifted $ U.collatorFor lang
- Just _ -> U.collatorFor lang
- in U.collate coll
+comp mblang = U.collate coll
+ where
+ lang = fromMaybe (Lang "" Nothing Nothing [] [] []) mblang
+ coll = case lookup "u" (langExtensions lang) >>= lookup "ka" of
+ -- default to Shifted variable weighting, unless a variable
+ -- weighting is explicitly specified with the ka keyword:
+ Nothing -> U.setVariableWeighting U.Shifted $ U.collatorFor lang
+ Just _ -> U.collatorFor lang
#endif
diff --git a/stack.yaml b/stack.yaml
--- a/stack.yaml
+++ b/stack.yaml
@@ -5,5 +5,6 @@
resolver: lts-17.5
extra-deps:
- unicode-collation-0.1.3
+- text-icu-0.7.1.0
ghc-options:
"$locals": -fhide-source-paths
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -25,6 +25,7 @@
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Aeson as A
+import Data.Aeson ((.:?), (.!=))
import Data.Text.Encoding (decodeUtf8)
import System.FilePath
import Data.Maybe (fromMaybe)
@@ -45,8 +46,23 @@
, citations :: Maybe [Citation a]
, abbreviations :: Maybe Abbreviations
, skipReason :: Maybe Text
+ , options :: Maybe TestOptions
} deriving (Show)
+newtype TestOptions =
+ TestOptions { testCiteprocOpts :: CiteprocOptions }
+ deriving (Show, Eq)
+
+defaultTestOptions :: TestOptions
+defaultTestOptions = TestOptions
+ { testCiteprocOpts = defaultCiteprocOptions }
+
+instance A.FromJSON TestOptions where
+ parseJSON = A.withObject "TestOptions" $ fmap TestOptions . \v ->
+ CiteprocOptions
+ <$> v .:? "linkCitations" .!= False
+ <*> v .:? "linkBibliography" .!= False
+
data TestResult =
Passed
| Skipped Text
@@ -57,6 +73,7 @@
runTest :: CiteprocTest (CslJson Text)
-> StateT Counts IO TestResult
runTest test = do
+ let opts = fromMaybe defaultTestOptions . options $ test
let cites =
case citations test of
Just cs -> cs
@@ -94,7 +111,7 @@
Just (Right style') -> do
let style = style'{ styleAbbreviations = abbreviations test }
let loc = mergeLocales Nothing style
- let actual = citeproc defaultCiteprocOptions
+ let actual = citeproc (testCiteprocOpts opts)
style Nothing (input test) cites
unless (null (resultWarnings actual)) $ do
liftIO $ do
@@ -228,6 +245,7 @@
, abbreviations = fromJSON "ABBREVIATIONS" <$>
lookup "abbreviations" sections
, skipReason = reason
+ , options = fromJSON "TESTOPTIONS" <$> lookup "options" sections
}
-- for motivation see e.g. test/csl/collapse_CitationNumberRangesInsert.txt
diff --git a/test/extra/issue_80.txt b/test/extra/issue_80.txt
new file mode 100644
--- /dev/null
+++ b/test/extra/issue_80.txt
@@ -0,0 +1,95 @@
+>>===== MODE =====>>
+citation
+<<===== MODE =====<<
+
+
+
+>>===== RESULT =====>>
+Astha; Asthb; Bron00
+<<===== RESULT =====<<
+
+
+>>===== CSL =====>>
+
+<<===== CSL =====<<
+
+
+>>===== INPUT =====>>
+[
+ {
+ "author": [
+ {
+ "family": "Asthma",
+ "given": "Albert"
+ }
+ ],
+ "id": "ITEM-1",
+ "accessed": {
+ "date-parts": [
+ [
+ "1900"
+ ]
+ ]
+ },
+ "title": "Book A",
+ "type": "book"
+ },
+ {
+ "author": [
+ {
+ "family": "Asthma",
+ "given": "Zeppo"
+ }
+ ],
+ "id": "ITEM-2",
+ "accessed": {
+ "date-parts": [
+ [
+ "1900"
+ ]
+ ]
+ },
+ "title": "Book B",
+ "type": "book"
+ },
+ {
+ "author": [
+ {
+ "family": "Bronchitis",
+ "given": "Buffy"
+ }
+ ],
+ "id": "ITEM-3",
+ "issued": {
+ "date-parts": [
+ [
+ "2000"
+ ]
+ ]
+ },
+ "title": "Book C",
+ "type": "book"
+ }
+]
+<<===== INPUT =====<<
+
+
+>>===== VERSION =====>>
+1.0
+<<===== VERSION =====<<
+
diff --git a/test/extra/link_bibitems.txt b/test/extra/link_bibitems.txt
new file mode 100644
--- /dev/null
+++ b/test/extra/link_bibitems.txt
@@ -0,0 +1,179 @@
+This test checks the following properties:
+ - when no DOI/PMCID/PMID/URL, in order of priority, appears as plain text in
+ an item, and when further, no title appears, the entire bibitem should be
+ linkified with one of those identifiers.
+ - shortDOIs should be handled correctly, meaning that every shortDOI of
+ the form 10/abcde should be converted to the DOI abcde
+
+>>===== MODE =====>>
+bibliography
+<<===== MODE =====<<
+
+>>===== OPTIONS =====>>
+{
+ "linkBibliography" : true
+}
+<<===== OPTIONS =====<<
+
+>>===== RESULT =====>>
+
+<<===== RESULT =====<<
+
+>>===== CSL =====>>
+
+
+<<===== CSL =====<<
+
+>>===== INPUT =====>>
+[
+ {
+ "author": [
+ { "family": "Apple", "given": "Andrew" }
+ ],
+ "id": "ITEM-A",
+ "type": "book",
+ "title": "AAAA",
+ "DOI": "10.1021/ja01577a030",
+ "issued": {
+ "date-parts": [ [ 2010 ] ]
+ }
+ },
+ {
+ "author": [
+ { "family": "Blueberry", "given": "Bethany" }
+ ],
+ "id": "ITEM-B",
+ "type": "book",
+ "title": "BBBB",
+ "DOI": "10/bbbbb",
+ "issued": {
+ "date-parts": [ [ 2011 ] ]
+ }
+ },
+ {
+ "author": [
+ { "family": "Cherry", "given": "Carlos" }
+ ],
+ "id": "ITEM-C",
+ "type": "book",
+ "title": "CCCC",
+ "URL": "https://pandoc.org/",
+ "issued": {
+ "date-parts": [ [ 2012 ] ]
+ }
+ },
+ {
+ "author": [
+ { "family": "Durian", "given": "Denice" }
+ ],
+ "id": "ITEM-D",
+ "type": "book",
+ "title": "DDDD",
+ "PMID": "30310042",
+ "issued": {
+ "date-parts": [ [ 2013 ] ]
+ }
+ },
+ {
+ "author": [
+ { "family": "Elderberry", "given": "Edward" }
+ ],
+ "id": "ITEM-E",
+ "type": "book",
+ "title": "EEEE",
+ "PMCID": "PMC3531190",
+ "issued": {
+ "date-parts": [ [ 2014 ] ]
+ }
+ },
+ {
+ "author": [
+ { "family": "Fig", "given": "Francella" }
+ ],
+ "id": "ITEM-F",
+ "type": "book",
+ "title": "FFFF",
+ "DOI": "10/bbbbb",
+ "PMCID": "PMC3531190",
+ "PMID": "30310042",
+ "URL": "https://pandoc.org/",
+ "issued": {
+ "date-parts": [ [ 2015 ] ]
+ }
+ },
+ {
+ "author": [
+ { "family": "Grapefruit", "given": "Gordon" }
+ ],
+ "id": "ITEM-G",
+ "type": "book",
+ "title": "GGGG",
+ "PMCID": "PMC3531190",
+ "PMID": "30310042",
+ "URL": "https://pandoc.org/",
+ "issued": {
+ "date-parts": [ [ 2016 ] ]
+ }
+ },
+ {
+ "author": [
+ { "family": "Honeydew", "given": "Helen" }
+ ],
+ "id": "ITEM-H",
+ "type": "book",
+ "title": "HHHH",
+ "PMID": "30310042",
+ "URL": "https://pandoc.org/",
+ "issued": {
+ "date-parts": [ [ 2017 ] ]
+ }
+ }
+]
+<<===== INPUT =====<<
+
+
+>>===== VERSION =====>>
+1.0
+<<===== VERSION =====<<
diff --git a/test/extra/link_plainurls.txt b/test/extra/link_plainurls.txt
new file mode 100644
--- /dev/null
+++ b/test/extra/link_plainurls.txt
@@ -0,0 +1,152 @@
+This test checks the following properties:
+ - plain URLs appearing in bibliography items should be linkified
+ - when a link's prefix+anchor matches its target, the
+ prefix should be included in the anchor
+ - shortDOIs should be handled correctly, meaning that every shortDOI of
+ the form 10/abcde should be converted to the DOI abcde
+
+>>===== MODE =====>>
+bibliography
+<<===== MODE =====<<
+
+>>===== OPTIONS =====>>
+{
+ "linkBibliography" : true
+}
+<<===== OPTIONS =====<<
+
+>>===== RESULT =====>>
+
+
+
Blueberry. BBBB. 2011.
https://doi.org/bbbbb
+
Cherry. CCCC. 2012.
https://pandoc.org/
+
+
+