diff --git a/README b/README --- a/README +++ b/README @@ -5,9 +5,9 @@ ----- [citeproc-hs] is a Haskell implementation of the Citation Style -Language [CSL]. +Language ([CSL]). -[citeproc-hs] adds to [Pandoc], the famous [Haskell] text processing +[citeproc-hs] adds to [pandoc], the famous [Haskell] text processing tool, a Bibtex like citation and bibliographic formatting and generation facility. @@ -25,27 +25,30 @@ releases of [OpenOffice](http://bibliographic.openoffice.org/). [citeproc-hs] can process and format citations according to a [CSL] -style, given a [MODS] collection of references. +style, given a collection of references. -The Metadata Object Description Schema ([MODS]) is an XML format which -is used by [Bibutils] to interconvert many different bibliographic -database formats, like Bibtex, Endnote, and others. +Natively [citeproc-hs] can only read [MODS] XML formattted +bibliographic databases. The Metadata Object Description Schema +([MODS]) is an XML format which is used by [bibutils] to interconvert +many different bibliographic database formats, like Bibtex, Endnote, +and others. -[Bibutils] can be used to convert Bibtex and other bibliographic +[bibutils] can be used to convert Bibtex and other bibliographic databases to [MODS] collections, which can be thus read by [citeproc-hs]. -[Bibutils] also exports a library and a future plan is to use that -library for providing native support for the most widely used -bibliographic databases in [citeproc-hs]. +[bibutils] also exports a library and this library can be used by +[citeproc-hs] for reading the most widely used bibliographic +databases. This requires the installation of [hs-bibutils], the +Haskell bindings to [bibutils]. [citeproc-hs] is a library that exports functions to parse [CSL] styles and [MODS] collections, to process lists of citation groups and to format the processed output. The output is a Haskell data type that can be further processed for conversion to any kind of formats (at the -present time plain ASCII and the [Pandoc] native format) +present time plain ASCII and the pandoc] native format) -[Pandoc] is a [Haskell] library for converting from one markup format to +[pandoc] is a [Haskell] library for converting from one markup format to another, and a command-line tool that uses this library. It can read [markdown] and (subsets of) [reStructuredText], [HTML], and [LaTeX]; and it can write [markdown], [reStructuredText], [HTML], [LaTeX], [ConTeXt], @@ -67,6 +70,8 @@ Installation ------------ +### Installing without bibutils support + [citeproc-hs] depends on [hxt], the Haskell XML Tool Box. In order to install [citeproc-hs] you need to install [hxt] and its @@ -74,7 +79,7 @@ -Every package downloaded form [Hackage] can be installed with those +Every package downloaded form [Hackage] can be installed with these simple commands: runhaskell Setup.lhs configure @@ -90,16 +95,34 @@ runhaskell Setup.lhs build runhaskell Setup.lhs install --user +### Installing with bibutils support + +Since [bibutils] doesn't build a shared object and doesn't install the +library, which is a static object used to compile the single +[bibutils] utilities, by default [citeproc-hs] is not built with +[bibutils] support. + +If you succeeded in installing [bibutils] and [hs-bibutils], you can +enable [bibutils] by configuring with the `-fbibutils` flag: + + runhaskell Setup.lhs configure -fbibutils + +and then build and install with: + + runhaskell Setup.lhs build + runhaskell Setup.lhs install + + Using citeproc-hs with Pandoc ----------------------------- -If you want to use [citeproc-hs] with [Pandoc] you need to install -[citeproc-hs] first, get the [Pandoc] source code and compile it with +If you want to use [citeproc-hs] with [pandoc] you need to install +[citeproc-hs] first, get the [pandoc] source code and compile it with the `-f citeproc` flag: - runhaskell Setup.lhs configure -f citeproc - runhaskell Setup.lhs build - runhaskell Setup.lhs install + runhaskell Setup.hs configure -f citeproc + runhaskell Setup.hs build + runhaskell Setup.hs install Citations are inserted like simple reference links: @@ -119,29 +142,33 @@ [Rossato2006@ p. 10; Pascuzzi2002@ cap. 12] To automatically format citations and generate the bibliography, run -[Pandoc] with the `--csl` and `--mods` flags: +[pandoc] with the `--csl` and `--biblio` flags: - pandoc --csl cslStyle.csl --mods modsCollection.xml text.markdown > text.html + pandoc --csl cslStyle.csl --biblio modsCollection.mods text.markdown > text.html Obviously you can export the text into any of the formats supported by -[Pandoc]. +[pandoc]. Some examples can be found in the `test` directory of the source tree. You can try them with: - pandoc --csl apa.csl --mods modsCollection.xml test.markdown - pandoc --csl apa.csl --mods modsCollection.xml test_note.markdown + pandoc --csl apa.csl --biblio modsCollection.xml --biblio-format mods test.markdown + pandoc --csl apa.csl --biblio modsCollection.xml --biblio-format mods test_note.markdown Documentation ------------- -No further documentation is so far available and even haddock -generated documentation is at a very early stage. +[Haddock] documentation for the exported API is available at the +following address: -Some usage examples can be found in the `test` directory of the -source tree. + +Generating the [Haddock] documentation is troublesome with Cabal < +1.6.0.2 (GHC-6.10.1 comes with Cabal-1.6.0.1), because of this: + + + Known Issues ------------ @@ -150,7 +177,6 @@ Specifically the following options are not implemented: - - "collapse" (citation collapsing) - "hanging-indent" - "second-field-align" - "line-spacing" @@ -174,7 +200,7 @@ me with ideas, comments and suggestions that made it possible to come to something usable. -[John MacFarlane], the author of [Pandoc], has been very supportive of +[John MacFarlane], the author of [pandoc], has been very supportive of the project and provided a lot of useful feed back, comments and suggestions. @@ -213,16 +239,18 @@ Copyright © 2008 Andrea Rossato -[citeproc-hs]: http://code.haskell.org/cioteproc-hs +[citeproc-hs]: http://code.haskell.org/citeproc-hs [CSL]: http://xbiblio.sourceforge.net/csl/ -[Pandoc]: http://johnmacfarlane.net/pandoc/ +[pandoc]: http://johnmacfarlane.net/pandoc/ [Zotero]: http://www.zotero.org [MODS]: http://www.loc.gov/mods/ -[Bibutils]: http://www.scripps.edu/~cdputnam/software/bibutils/ +[bibutils]: http://www.scripps.edu/~cdputnam/software/bibutils/ +[hs-bibutils]: http://code.haskell.org/hs-bibutils/ [Hackage]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/citeproc-hs [hxt]: http://www.fh-wedel.de/~si/HXmlToolbox/ [Bruce D'Arcus]: http://community.muohio.edu/blogs/darcusb/ [John MacFarlane]: http://johnmacfarlane.net/ +[Haddock]: http://www.haskell.org/haddock/ [markdown]: http://daringfireball.net/projects/markdown/ [reStructuredText]: http://docutils.sourceforge.net/docs/ref/rst/introduction.html diff --git a/citeproc-hs.cabal b/citeproc-hs.cabal --- a/citeproc-hs.cabal +++ b/citeproc-hs.cabal @@ -1,22 +1,23 @@ name: citeproc-hs -version: 0.1 +version: 0.2 homepage: http://code.haskell.org/citeproc-hs synopsis: A Citation Style Language implementation in Haskell -description: citeproc-hs is a Hakell port of Citeproc, a - processor for converting citations into a variety - of formats using a macro language called Citation - Style Language (CSL). - . - For more details on Citeproc and CSL, please check: - . +description: citeproc-hs is a library for automatically + formatting bibliographic reference citations into + a variety of styles using a macro language called + Citation Style Language (CSL). More details on + CSL can be found here: + . + . + For the API documentation please see "Text.CSL". category: Text license: BSD3 license-file: LICENSE author: Andrea Rossato maintainer: andrea.rossato@ing.unitn.it -cabal-version: >= 1.2 +cabal-version: >= 1.6 build-type: Simple data-files: locales/locales-af-AZ.xml locales/locales-af-ZA.xml @@ -53,6 +54,7 @@ locales/locales-sv-SE.xml locales/locales-th-TH.xml locales/locales-tr-TR.xml + locales/locales-uk-UA.xml locales/locales-vi-VN.xml locales/locales-zh-CN.xml locales/locales-zh-TW.xml @@ -63,25 +65,37 @@ flag test description: Run the textsuite. +flag bibutils + description: Use Chris Putnam's Bibutils. + default: False + library - exposed-modules: Text.CSL - Text.CSL.Eval - Text.CSL.Parser - Text.CSL.Proc - Text.CSL.Reference - Text.CSL.Style - Text.CSL.Input.MODS - Text.CSL.Output.Pandoc - Text.CSL.Output.Plain - other-modules: Paths_citeproc_hs - ghc-options: -funbox-strict-fields -Wall - ghc-prof-options: -prof -auto-all - hs-source-dirs: src dist/build/autogen + exposed-modules: Text.CSL + Text.CSL.Eval + Text.CSL.Parser + Text.CSL.Proc + Text.CSL.Proc.Collapse + Text.CSL.Proc.Disamb + Text.CSL.Reference + Text.CSL.Style + Text.CSL.Input.MODS + Text.CSL.Input.Bibutils + Text.CSL.Output.Pandoc + Text.CSL.Output.Plain + other-modules: Paths_citeproc_hs + ghc-options: -funbox-strict-fields -Wall + ghc-prof-options: -prof -auto-all + hs-source-dirs: src + build-depends: containers, directory, mtl, hxt >= 8.1 - if flag(small_base) - build-depends: base >= 3, containers, directory + if flag(bibutils) + build-depends: hs-bibutils, filepath, directory + extra-libraries: bibutils + extensions: CPP + cpp-options: -DUSE_BIBUTILS + if impl(ghc >= 6.10) + build-depends: base >= 4, syb else - build-depends: base < 3 + build-depends: base >= 3 && < 4 - build-depends: mtl, hxt >= 8.1 diff --git a/locales/locales-sr-RS.xml b/locales/locales-sr-RS.xml --- a/locales/locales-sr-RS.xml +++ b/locales/locales-sr-RS.xml @@ -15,7 +15,7 @@ интервју писмо анонимна - анон + анон. и остали у штампи на Интернету @@ -109,30 +109,38 @@ строфа строфе + + sub verbo + s.vv + књига - Пог - кол - црт + Пог. + кол. + црт. фолио - изд - оп + изд. + оп. - стр - стр + стр. + стр. - пар + пар. део - од + од. + + s.v + s.vv + - стр - стр + стр. + стр. том томови edition - изд + изд. ¶¶ @@ -158,19 +166,19 @@ - ур - ур + ур. + ур. - прев - прев + прев. + прев. уредио превео прима интервјуисао - ур - прев + ур. + прев. Јануар Фебруар Март @@ -183,17 +191,17 @@ Октобар Новембар Децембар - Јан - Феб + Јан. + Феб. Март - Апр + Апр. Мај Јуни Јули - Авг - Сеп - Окт - Нов - Дец + Авг. + Сеп. + Окт. + Нов. + Дец. diff --git a/locales/locales-uk-UA.xml b/locales/locales-uk-UA.xml new file mode 100644 --- /dev/null +++ b/locales/locales-uk-UA.xml @@ -0,0 +1,207 @@ + + + + на + в + ibid + accessed + retrieved + із + forthcoming + посилання + n.d. + і + et al. + інтервю + лист + анонімний + анон. + та інші + у пресі + online + cited + інтернет + presented at the + антропологія + астрономія + біологія + ботаніка + хімія + інженерія + generic base + географія + геологія + історія + гуманітарні + література + математика + медицина + філософія + фізика + психологія + соціологія + наука + політичні науки + соціальні науки + теологія + зоологія + + book + books + + + chapter + chapters + + + column + columns + + + figure + figures + + + folio + folios + + + number + numbers + + + line + lines + + + note + notes + + + opus + opera + + + page + pages + + + paragraph + paragraph + + + part + parts + + + section + sections + + + volume + volumes + + + edition + editions + + + verse + verses + + + sub verbo + s.vv + + bk + chap + col + fig + f + no + op + + p + pp + + para + pt + sec + + s.v + s.vv + + + v + vv + + + vol + vols + + edition + ed + + + ¶¶ + + + § + §§ + + + + + + + editor + editors + + + translator + translators + + + + + + + ed + eds + + + tran + trans + + edited by + translated by + to + interview by + ed + trans + Січень + Лютий + Березень + Квітень + Травень + Червень + Липень + Серпень + Вересень + Жовтень + Листопад + Грудень + Січ + Лют + Бер + Квіт + Трав + Чер + Лип + Сер + Вер + Жов + Лис + Груд + + diff --git a/src/Text/CSL.hs b/src/Text/CSL.hs --- a/src/Text/CSL.hs +++ b/src/Text/CSL.hs @@ -4,29 +4,51 @@ -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- --- Maintainer : Andrea Rossato +-- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- --- The CSL implementation +-- /citeproc-hs/ is a library for automatically formatting +-- bibliographic reference citations into a variety of styles using a +-- macro language called Citation Style Language (CSL). More details +-- on CSL can be found here: . -- +-- This module documents and exports the library API. +-- ----------------------------------------------------------------------------- module Text.CSL - ( readCSLFile + ( -- * Introduction + -- $intro + + -- * Overview: A Simple Example + -- $overview + + -- * Reading Bibliographic Databases + readBiblioFile , readModsFile , readModsColletionFile + + -- ** Reference Representation , Reference (..) , getReference + + -- * CSL Parser, Representation, and Processing + , readCSLFile + + -- ** The Style Types , Style (..) , Citation (..) , Bibliography (..) - , FormattedOutput (..) - , evalLayout - , BiblioData (..) + + -- ** High Level Processing , citeproc , processCitations , processBibliography + , BiblioData (..) + + -- * The output and the rendering functions + , FormattedOutput (..) , renderPlain , renderPlainStrict , renderPandoc @@ -34,12 +56,83 @@ , renderPandocStrict ) where -import Text.CSL.Eval import Text.CSL.Parser import Text.CSL.Proc import Text.CSL.Reference import Text.CSL.Style +import Text.CSL.Input.Bibutils import Text.CSL.Input.MODS import Text.CSL.Output.Pandoc import Text.CSL.Output.Plain + +-- $intro +-- +-- /citeproc-hs/ provides functions for reading bibliographic +-- databases, for reading and parsing CSL files and for generating +-- citations in an internal format, 'FormattedOutput', that can be +-- easily rendered into different final formats. At the present time +-- only 'Pandoc' and plain text rendering functions are provided by +-- the library. +-- +-- The library also provides a wrapper around hs-bibutils, the Haskell +-- bindings to Chris Putnam's bibutils, a library that interconverts +-- between various bibliography formats using a common MODS-format XML +-- intermediate. +-- +-- For more information about hs-bibutils see here: +-- . +-- +-- /citeproc-hs/ can natively read MODS formatted bibliographic +-- databases. + +-- $overview +-- +-- The following example assumes you have properly installed +-- hs-bibutils. If not you can use bibutils to convert the following +-- bibtex bibliographic database into a MODS collection. +-- +-- Suppose you have a small bibliographic database, like this one: +-- +-- > @Book{Rossato2005, +-- > author="Andrea Rossato", +-- > title="My First Book", +-- > year="2005" +-- > } +-- > +-- > @Book{Rossato2006, +-- > author="Andrea Rossato", +-- > title="My Second Book", +-- > year="2006" +-- > } +-- > +-- > @Book{Caso2007, +-- > author="Roberto Caso", +-- > title="Roberto's Book", +-- > year="2007" +-- > } +-- +-- Save it as @mybibdb.bib@. +-- +-- Then you can grab one of the CSL style developed by the Zotero +-- community. Suppose this one: +-- +-- +-- +-- saved locally as @apa.csl@. +-- +-- This would be a simple program that formats a list of citations +-- according to that style: +-- +-- > import Text.CSL +-- > +-- > main :: IO () +-- > main = do +-- > m <- readBiblioFile "mybibdb.bib" "bibtex" +-- > s <- readCSLFile "apa.csl" +-- > let result = citeproc s m $ [[("Caso2007","p. 10"),("Rossato2005","p. 10"),("Rossato2006","p. 15")]] +-- > putStrLn . unlines . map (renderPlainStrict) . citations $ result +-- +-- The result would be: +-- +-- > (Caso, 2007, p. 10; Rossato, 2005, p. 10, 2006, p. 15) diff --git a/src/Text/CSL/Eval.hs b/src/Text/CSL/Eval.hs --- a/src/Text/CSL/Eval.hs +++ b/src/Text/CSL/Eval.hs @@ -5,7 +5,7 @@ -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- --- Maintainer : Andrea Rossato +-- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- @@ -172,12 +172,12 @@ getOptionVal "subsequent-author-substitute" ops else do res <- agents ea s as if res /= [] - then return . return . FC k res =<< + then return . return . OContrib k res =<< mapM (rest ags ea s) [1 + l .. length ags] else return [] r' <- evalNames xs nl d return $ if r /= [] && r' /= [] - then r ++ [S d] ++ r' + then r ++ [ODel d] ++ r' else cleanOutput (r ++ r') | otherwise = return [] where @@ -247,6 +247,7 @@ | Just v <- fromValue val :: Maybe String = output fm v | Just v <- fromValue val :: Maybe Locator = output fm (locString v) | Just v <- fromValue val :: Maybe Int = output fm (if v == 0 then [] else show v) + | Just v <- fromValue val :: Maybe CNum = if v == 0 then [] else [OCitNum (unCNum v) fm] | Just v <- fromValue val :: Maybe [RefDate] = formatDate s [] defaultDate v | Just v <- fromValue val :: Maybe [Agent] = concatMap (formatName True f fm defaultNameFormatting) v | otherwise = [] @@ -284,9 +285,9 @@ | True <- et , length x > 1 = addDelim d x | "always" <- delimiterPrecedesLast nf - , length x == 2 = addDelim d (init x) ++ S (d <> andStr nf) : [last x] - | length x == 2 = addDelim d (init x) ++ S ( andStr nf) : [last x] - | length x > 2 = addDelim d (init x) ++ S (d <> andStr nf) : [last x] + , length x == 2 = addDelim d (init x) ++ ODel (d <> andStr nf) : [last x] + | length x == 2 = addDelim d (init x) ++ ODel ( andStr nf) : [last x] + | length x > 2 = addDelim d (init x) ++ ODel (d <> andStr nf) : [last x] | otherwise = addDelim d x andStr nf | "text" <- andConnector nf = " and " @@ -294,17 +295,20 @@ | otherwise = [] isPlural p = (&&) p . (<) 1 +-- | Generate the 'Agent's names applying et-al options, with all +-- possible permutations to disambiguate colliding citations. formatName :: Bool -> Form -> Formatting -> NameFormatting -> Agent -> [Output] formatName b f fm nf n | Person {} <- n - , Short <- f = return $ FN short rest fm - | Person {} <- n = return $ FN (long given') [long given] fm + , Short <- f = return $ OName short rest fm + | Person {} <- n = return $ OName (long given') [long given] fm | Entity s <- n = output fm s | otherwise = [] where - rest = [ family $ concatMap (flip (:) ". " . head) (givenName n) + rest = [ family $ concatMap addPnt (givenName n) , long given] addSpace = flip (++) (if b then [] else " ") + addPnt x = if x /= [] then head x : ". " else [] format x = procList x initia initia x = if initializeWith nf /= [] then head x : initializeWith nf @@ -337,10 +341,10 @@ where addZero n = if length n == 1 then '0' : n else n formatDatePart (RefDate y m d o) (DatePart n f fm) - | "year" <- n, y /= 0 = return $ FY (formatYear f $ show y) s fm - | "month" <- n, m /= 0 = output fm (formatMonth f $ show m) - | "day" <- n, d /= 0 = output fm (formatDay f $ show d) - | "other" <- n, o /= [] = output fm o + | "year" <- n, y /= 0 = return $ OYear (formatYear f $ show y) s fm + | "month" <- n, m /= 0 = output fm (formatMonth f $ show m) + | "day" <- n, d /= 0 = output fm (formatDay f $ show d) + | "other" <- n, o /= [] = output fm o | otherwise = [] formatYear f y | "short" <- f = drop 2 y @@ -364,10 +368,10 @@ _ -> "th" output :: Formatting -> String -> [Output] -output fm s = if s /= "" then [FS s fm] else [] +output fm s = if s /= "" then [OStr s fm] else [] appendOutput :: Formatting -> [Output] -> [Output] -appendOutput fm xs = if xs /= [] then [O xs fm] else [] +appendOutput fm xs = if xs /= [] then [Output xs fm] else [] outputList :: Formatting -> Delimiter -> [Output] -> [Output] outputList fm d = appendOutput fm . addDelim d . cleanOutput @@ -375,11 +379,11 @@ cleanOutput :: [Output] -> [Output] cleanOutput = filter isNotEmpty where - isNotEmpty (FS "" _) = False - isNotEmpty _ = True + isNotEmpty (OStr "" _) = False + isNotEmpty _ = True addDelim :: String -> [Output] -> [Output] -addDelim d = foldr (\x xs -> if length xs < 1 then x : xs else x : S d : xs) [] +addDelim d = foldr (\x xs -> if length xs < 1 then x : xs else x : ODel d : xs) [] consumeVariable :: String -> State EvalState () consumeVariable s @@ -406,6 +410,9 @@ formatVariable :: String -> String formatVariable = foldr f [] where f x xs = if x == '_' then '-' : xs else toLower x : xs + +head' :: [a] -> [a] +head' = foldr (\x _ -> [x]) [] trace :: String -> State EvalState () trace d = modify $ \s -> s { debug = d : debug s } diff --git a/src/Text/CSL/Input/Bibutils.hs b/src/Text/CSL/Input/Bibutils.hs new file mode 100644 --- /dev/null +++ b/src/Text/CSL/Input/Bibutils.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface, PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.CSL.Input.Bibutils +-- Copyright : (C) 2008 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unitn.it +-- Stability : unstable +-- Portability : unportable +-- +----------------------------------------------------------------------------- + +module Text.CSL.Input.Bibutils + ( readBiblioFile + ) where + +import Text.CSL.Reference +import Text.CSL.Input.MODS + +#ifdef USE_BIBUTILS +import Data.Char +import System.Directory ( getTemporaryDirectory, removeFile ) +import System.FilePath ( takeExtension, () ) +import System.IO +import Text.Bibutils +#endif + +-- | Read a file with a bibliographic database of the format specified +-- by the 'String'. If the 'String' is empty the file extension will +-- be used to identify the format. +-- +-- Supported formats are: @\"mods\"@, @\"bibtex\"@, @\"biblatex\"@, +-- @\"ris\"@, @\"endnote\"@, @\"endnotexml\"@, @\"isi\"@, +-- @\"medline\"@, and @\"copac\"@. +readBiblioFile :: FilePath -> String -> IO [Reference] +#ifdef USE_BIBUTILS +readBiblioFile f m + | [] <- m = let mode = case takeExtension (map toLower f) of + ".mods" -> mods_in + ".bib" -> bibtex_in + ".bbx" -> biblatex_in + ".ris" -> ris_in + ".enl" -> endnote_in + ".xml" -> endnotexml_in + ".wos" -> isi_in + ".medline" -> medline_in + ".copac" -> copac_in + _ -> error "Bibliography format not supported." + in readBiblioFile' f mode + | otherwise = let mode = case m of + "mods" -> mods_in + "bibtex" -> bibtex_in + "biblatex" -> biblatex_in + "ris" -> ris_in + "endnote" -> endnote_in + "endnotexml" -> endnotexml_in + "isi" -> isi_in + "medline" -> medline_in + "copac" -> copac_in + _ -> error "Bibliography format not supported." + in readBiblioFile' f mode + +#else +readBiblioFile f m + | "mods" <- m = readModsColletionFile f + | otherwise = error $ "Bibliography format not supported.\n" ++ + "citeproc-hs was not compiled with bibutils support" +#endif + +#ifdef USE_BIBUTILS +readBiblioFile' :: FilePath -> BiblioIn -> IO [Reference] +readBiblioFile' fin bin + | bin == mods_in = readModsColletionFile fin + | otherwise = do + tdir <- getTemporaryDirectory + (f,h) <- openTempFile tdir "citeproc.txt" + hClose h + let tfile = tdir f + param <- bibl_initparams bin mods_out "citeproc-hs" + bibl <- bibl_init + unsetBOM param + bibl_read param bibl fin + bibl_write param bibl tfile + bibl_free bibl + bibl_freeparams param + refs <- readModsColletionFile tfile + removeFile tfile + return refs +#endif diff --git a/src/Text/CSL/Input/MODS.hs b/src/Text/CSL/Input/MODS.hs --- a/src/Text/CSL/Input/MODS.hs +++ b/src/Text/CSL/Input/MODS.hs @@ -6,7 +6,7 @@ -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- --- Maintainer : Andrea Rossato +-- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- @@ -24,10 +24,12 @@ import Data.Char ( isDigit ) -readModsFile :: String -> IO Reference +-- | Read a file with a single MODS record. +readModsFile :: FilePath -> IO Reference readModsFile f = readXmlFile xpMods f -readModsColletionFile :: String -> IO [Reference] +-- | Read a file with a collection of MODS records. +readModsColletionFile :: FilePath -> IO [Reference] readModsColletionFile f = readXmlFile xpModsCollection f xpModsCollection :: PU [Reference] diff --git a/src/Text/CSL/Output/Pandoc.hs b/src/Text/CSL/Output/Pandoc.hs --- a/src/Text/CSL/Output/Pandoc.hs +++ b/src/Text/CSL/Output/Pandoc.hs @@ -5,7 +5,7 @@ -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- --- Maintainer : Andrea Rossato +-- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- @@ -26,14 +26,20 @@ import Text.CSL.Style import Text.CSL.Output.Plain +-- | With a 'Style' and the formatted output generate a 'String' in +-- the native 'Pandoc' formats (i.e. immediately readable by pandoc). renderPandoc :: Style -> [FormattedOutput] -> String renderPandoc _ = show . clean . concatMap (render False) +-- | Same as 'renderPandoc', but the output is wrapped in a pandoc +-- paragraph block. renderPandoc' :: Style -> [FormattedOutput] -> String renderPandoc' _ = show . Para . clean . concatMap (render False) +-- | Same as 'renderPandoc', but will not clean up the produced +-- output. renderPandocStrict :: [FormattedOutput] -> String renderPandocStrict = show . cleanStrict . concatMap (render True) diff --git a/src/Text/CSL/Output/Plain.hs b/src/Text/CSL/Output/Plain.hs --- a/src/Text/CSL/Output/Plain.hs +++ b/src/Text/CSL/Output/Plain.hs @@ -5,7 +5,7 @@ -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- --- Maintainer : Andrea Rossato +-- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- @@ -26,9 +26,12 @@ import Text.CSL.Style +-- | Render the 'FormattedOutput' into a plain text string. renderPlain :: [FormattedOutput] -> String renderPlain = concatMap $ render False +-- | Same as 'renderPlain' , but will not clean up the produced +-- output. renderPlainStrict :: [FormattedOutput] -> String renderPlainStrict = concatMap $ render True diff --git a/src/Text/CSL/Parser.hs b/src/Text/CSL/Parser.hs --- a/src/Text/CSL/Parser.hs +++ b/src/Text/CSL/Parser.hs @@ -6,7 +6,7 @@ -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- --- Maintainer : Andrea Rossato +-- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- @@ -413,7 +413,9 @@ [x] -> return x _ -> error $ "error while reading file " ++ f -readCSLFile :: String -> IO Style +-- | Read and parse a CSL style file into the internal style +-- representation, the 'Style'. +readCSLFile :: FilePath -> IO Style readCSLFile f = do s <- readXmlFile xpStyle f l <- getDataFileName ("locales/locales-" ++ styleLocale s ++ ".xml") diff --git a/src/Text/CSL/Proc.hs b/src/Text/CSL/Proc.hs --- a/src/Text/CSL/Proc.hs +++ b/src/Text/CSL/Proc.hs @@ -5,93 +5,62 @@ -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- --- Maintainer : Andrea Rossato +-- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- --- Output processing. +-- This module provides functions for processing the evaluated +-- 'Output' for disambiguation and citation collapsing. -- ----------------------------------------------------------------------------- module Text.CSL.Proc where -import Control.Arrow ( (&&&), (>>>), (***) ) +import Control.Arrow ( (&&&), (***) ) import Data.Char ( chr ) -import Data.List ( (\\), elemIndex, findIndices - , sortBy, mapAccumL, nub, groupBy - , isPrefixOf ) +import Data.List ( elemIndex, findIndices + , sortBy, mapAccumL, nub ) import Data.Maybe import Data.Ord ( comparing ) import Text.CSL.Eval +import Text.CSL.Proc.Collapse +import Text.CSL.Proc.Disamb import Text.CSL.Reference import Text.CSL.Style +-- | With a 'Style', a list of 'Reference's and the list of citation +-- groups (the list of citations with their locator), produce the +-- 'FormattedOutput' for each citation group. processCitations :: Style -> [Reference] -> [[(String, String)]] -> [[FormattedOutput]] processCitations s rs = citations . citeproc s rs +-- | With a 'Style' and the list of 'Reference's produce the +-- 'FormattedOutput' for the bibliography. processBibliography :: Style -> [Reference] -> [[FormattedOutput]] processBibliography s rs = bibliography $ citeproc s rs [zip (map citeKey rs) (repeat "")] +-- | With a 'Style', a list of 'Reference's and the list of citation +-- groups (the list of citations with their locator), produce the +-- 'FormattedOutput' for each citation group and the bibliography. citeproc :: Style -> [Reference] -> [[(String, String)]] -> BiblioData citeproc s rs cs - = BD (outputGroups citOutput) biblioOutput + = BD citsOutput biblioOutput where - bibs = refsYSuffix . procRefs s . map (getReference rs) . - nub . map (id *** const []) . concat $ cs - refs = getRefs bibs cs - groups = map (procGroup s) refs - - -- | group citation data (with possible alternative names) for every - -- list of contributors which has a duplicate. - contribs = nub $ concatMap (\(CG _ _ os) -> concatMap getCiteData os) groups - collid = map rmGivenNames . collision - duplics = groupBy (\a b -> collid a == collid b) . - sortBy (comparing collid) $ - filter (collid &&& citYear >>> flip elem (getDuplicates groups)) contribs - - needYSuff = map (allTheSame . map disData) duplics - needName = concatMap fst . filter (not . snd) $ zip duplics needYSuff - - disSolved = zip needName (disambiguate $ map disData needName) - addLNames = map (\(c,n) -> c { disambed = head n }) disSolved - addGNames = map (\ c -> c { disambed = addGivenNames (disambed c) }) - - chkdup = same . proc rmGivenNames . map disambed - need a = map fst . filter (not . snd) . zip a - done a = (,) (need a $ chkdup a) (a \\ (need a $ chkdup a)) - - disOpts = getDisOptions s - hasNames = "disambiguate-add-names" `elem` disOpts - hasGName = "disambiguate-add-givenname" `elem` disOpts - hasYSuff = "disambiguate-add-year-suffix" `elem` disOpts - nameDis = case () of - _ | hasNames - , hasGName -> let (n ,ns ) = done addLNames - (n',ns') = done $ addGNames ns - in n ++ n' ++ addGNames ns' - | hasNames -> fst . done $ addLNames - | hasGName -> fst . done $ addGNames needName - | otherwise -> [] - - reEval = let chk = if hasYSuff then filter ((==) [] . citYear) else id - in chk . concatMap fst . filter snd $ zip duplics needYSuff - reEvaluated = if or (query hasIfDis s) && reEval /= [] - then map (uncurry $ reEvaluate s reEval) $ zip refs groups - else groups - + -- the list of bib entries, as a list of Reference, with + -- position, locator and year suffix set. + biblioRefs = refsYSuffix . procRefs s . map (getReference rs) . + nub . map (id *** const []) . concat $ cs + biblioOutput = if "disambiguate-add-year-suffix" `elem` getCitDisambOptions s + then map (map formatOutput) $ proc addYearSuffix $ procBiblio s biblioRefs + else map (map formatOutput) $ procBiblio s biblioRefs outputGroups = map $ \(CG fm d os) -> map formatOutput $ outputList fm d os - citOutput = if disOpts /= [] - then if hasYSuff - then proc addYearSuffix $ proc (updateOutput nameDis) reEvaluated - else proc (updateOutput nameDis) reEvaluated - else groups - biblioOutput = if hasYSuff - then map (map formatOutput) $ proc addYearSuffix $ procBiblio s bibs - else map (map formatOutput) $ procBiblio s bibs + citsOutput = outputGroups $ collapseCitGroups s $ disambCitations s biblioRefs cs +-- | With a 'Style' and a sorted list of 'Reference's produce the +-- evaluated output for the bibliography. procBiblio :: Style -> [Reference] -> [[Output]] procBiblio (Style {biblio = mb, csMacros = ms , csTerms = ts}) rs = maybe [] process mb @@ -104,14 +73,20 @@ then ("subsequent",x) : chkAut a xs else ("first" ,x) : chkAut (author x : a) xs +-- | Given the CSL 'Style' and the list of 'Reference's sort the list +-- according to the 'Style' and assign the citation number to each +-- 'Reference'. procRefs :: Style -> [Reference] -> [Reference] procRefs (Style {biblio = mb, csMacros = ms , csTerms = ts}) rs = maybe rs process mb where - citNum x = x { citationNumber = maybe 0 ((+) 1) . elemIndex x $ rs } + citNum x = x { citationNumber = maybe 0 ((+) 1 . fromIntegral) . elemIndex x $ rs } sort b = evalSorting ts ms (bibOptions b) (bibSort b) process b = map fst . sortBy (comparing snd) . map (citNum &&& sort b) $ rs +-- | Given the list of 'Reference's, compare year and contributors' +-- names and, when they collide, generate a suffix to append to the +-- year for disambiguation. refsYSuffix :: [Reference] -> [Reference] refsYSuffix rs = update indices @@ -131,130 +106,8 @@ , length i > 1 -> i | otherwise -> [] -procGroup :: Style -> [(String,Reference)] -> CitationGroup -procGroup (Style {citation = c, csMacros = ms , csTerms = ts}) - = CG (layFormat $ citLayout c) (layDelim $ citLayout c) . concat . process - where - format (p,r) = evalLayout (citLayout c) False ts ms (citOptions c) p r - sort = evalSorting ts ms (citOptions c) (citSort c) . snd - process = map fst . sortBy (comparing snd) . map (format &&& sort) - -reEvaluate :: Style -> [CiteData] -> [(String,Reference)] -> CitationGroup -> CitationGroup -reEvaluate (Style {citation = c, csMacros = ms , csTerms = ts}) l pr (CG f d os) - = CG f d . flip concatMap (zip pr os) $ - \((p,r),out) -> if citeKey r `elem` map key l - then evalLayout (citLayout c) True ts ms (citOptions c) p r - else [out] - suffixes :: [String] suffixes = l ++ [x ++ y | x <- l, y <- l ] where l = map (return . chr) [97..122] - -updateOutput :: [CiteData] -> Output -> Output -updateOutput m o - | FC k x _ <- o = case elemIndex (CD k x [] [] []) m of - Just i -> FC k (disambed $ m !! i) [] - _ -> o - | otherwise = o - -getDisOptions :: Style -> [String] -getDisOptions - = map fst . filter ((==) "true" . snd) . - filter (isPrefixOf "disambiguate" . fst) . citOptions . citation - -getRefs :: [Reference] -> [[(String, String)]] -> [[(String, Reference)]] -getRefs r = map (map $ getReference' r) . generatePosition - --- | The contributors diambiguation data, the list of names and --- give-names, and the citation year ('FY'). -type NamesYear = ([Output],String) - --- | Get the contributors list ('FC') and the year occurring in more --- then one citation. -getDuplicates :: [CitationGroup] -> [NamesYear] -getDuplicates - = nub . catMaybes . snd . mapAccumL dupl [] . getData - where - getData l = concat . map nub . flip map l $ \(CG _ _ os) -> concatMap getNamesYear os - dupl a c = if snd c `elem` map snd a - then if fst c `elem` map fst a then (a,Nothing) else (c:a,Just $ snd c) - else if fst c `elem` map fst a then (a,Nothing) else (c:a,Nothing ) - -getNamesYear :: Output -> [(String,NamesYear)] -getNamesYear - = proc rmGivenNames >>> - query contribs &&& years >>> - zipData - where - yearsQ = query getYears - years o = if yearsQ o /= [] then yearsQ o else [""] - zipData = uncurry . zipWith $ \(k,c) y -> (,) k (c,y) - contribs o - | FC k x _ <- o = [(k,x)] - | otherwise = [] - -getYears :: Output -> [String] -getYears o - | FY x _ _ <- o = [x] - | otherwise = [] - -hasIfDis :: IfThen -> [Bool] -hasIfDis o - | IfThen (Condition {disambiguation = d}) _ _ <- o = [d /= []] - | otherwise = [False ] - --- | Get the list of possible non ambiguous names for every citation --- whose contributor list and year is occuring in more then one --- citation. -getCiteData :: Output -> [CiteData] -getCiteData - = query contribs &&& years >>> - zipData - where - yearsQ = query getYears - years o = if yearsQ o /= [] then yearsQ o else [""] - zipData = uncurry . zipWith $ \c y -> c {citYear = y} - contribs o - | FC k x xs <- o = [CD k x xs [] []] - | otherwise = [] - --- List Utilities - -disambiguate :: (Eq a) => [[a]] -> [[a]] -disambiguate [] = [] -disambiguate ls - = if hasDuplicates takeHead - then diff ++ disambiguate (map tail' dupl) - else takeHead - where - zipped = zip ls takeHead - diff = map fst . filter (not . snd) $ zip takeHead (same takeHead) - dupl = map (fst . fst) . filter snd $ zip zipped (same takeHead) - - takeHead = map head' ls - head' = foldr (\x _ -> [x]) [] - tail' [x] = [x] - tail' x = tail x - -same :: Eq a => [a] -> [Bool] -same [] = [] -same l - = snd $ mapAccumL check (catMaybes dupl) l - where - dupl = snd $ mapAccumL (\a x -> if x `elem` a then (a,Just x) else (x:a,Nothing)) [] l - check a e = if e `elem` a then (a,True) else (e:a,False) - -hasDuplicates :: Eq a => [a] -> Bool -hasDuplicates = hasSame or - -allTheSame :: Eq a => [a] -> Bool -allTheSame = hasSame and - -hasSame :: Eq a => ([Bool] -> Bool) -> [a] -> Bool -hasSame _ [] = False -hasSame f l - = f . snd $ mapAccumL check [head l] (tail l) - where - check a e = if e `elem` a then (a,True) else (e:a,False) diff --git a/src/Text/CSL/Proc/Collapse.hs b/src/Text/CSL/Proc/Collapse.hs new file mode 100644 --- /dev/null +++ b/src/Text/CSL/Proc/Collapse.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.CSL.Proc.Collapse +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- This module provides functions for processing the evaluated +-- 'Output' for citation collapsing. +-- +----------------------------------------------------------------------------- + +module Text.CSL.Proc.Collapse where + +import Control.Arrow ( (&&&), (>>>) ) +import Data.List ( groupBy ) + +import Text.CSL.Eval +import Text.CSL.Proc.Disamb +import Text.CSL.Style + +-- | Collapse citations according to the style options. +collapseCitGroups :: Style -> [CitationGroup] -> [CitationGroup] +collapseCitGroups s + = map doCollapse + where + doCollapse = case getCollapseOptions s of + "year" : _ -> collapseYear + "year-suffix" : _ -> collapseYearSuf + "citation-number" : _ -> collapseNumber + _ -> id + +-- | Get the collapse option set in the 'Style' for citations. +getCollapseOptions :: Style -> [String] +getCollapseOptions + = map snd . filter ((==) "collapse" . fst) . citOptions . citation + +collapseNumber :: CitationGroup -> CitationGroup +collapseNumber (CG fm d os) = CG fm d (process os) + where + citNum o + | OCitNum i f <- o = [(i,f)] + | otherwise = [] + numOf = foldr (\x _ -> x) (0,emptyFormatting) . query citNum + newNum = map numOf >>> (map fst >>> groupConsec) &&& map snd >>> uncurry zip + process xs = flip concatMap (newNum xs) $ + \(x,f) -> if length x > 2 + then return $ Output [ OCitNum (head x) f + , ODel "-" + , OCitNum (last x) f + ] emptyFormatting + else map (flip OCitNum f) x + +collapseYear :: CitationGroup -> CitationGroup +collapseYear (CG f d os) = CG f d (process os) + where + rmNames [] = [] + rmNames (x:xs) = x : remove xs + remove = proc rmFirstDelim . proc rmContribs + namesOf = map (fst . snd) . getNamesYear + process = map (\x -> Output (addDelim ", " $ rmNames x) emptyFormatting) . + groupBy (\a b -> namesOf a == namesOf b) + +collapseYearSuf :: CitationGroup -> CitationGroup +collapseYearSuf (CG f d os) = CG f d (process os) + where + rmNames [] = [] + rmNames (x:xs) = x : remove xs + remove = proc rmFirstDelim . proc rmYear . proc rmContribs + namesOf = map (fst . snd) . getNamesYear + yearOf = concatMap (take 4 . snd . snd) . getNamesYear + process = map (\x -> Output (addDelim ", " $ rmNames x) emptyFormatting) . + groupBy (\a b -> namesOf a == namesOf b && yearOf a == yearOf b) + + rmYear o + | OYear _ sf fm <- o = OYear sf sf fm + | otherwise = o + +rmFirstDelim :: Output -> Output +rmFirstDelim o + | Output os f <- o = Output (rm os) f + | otherwise = o + where + rm [] = [] + rm (x:xs) + | ODel _ <- x = xs + | otherwise = x : rm xs + +-- | Group consecutive integers: +-- +-- > groupConsec [1,2,3,5,6,8,9] == [[1,2,3],[5,6],[8,9]] +groupConsec :: [Int] -> [[Int]] +groupConsec = groupConsec' [] + where + groupConsec' x [] = x + groupConsec' [] (y:ys) = groupConsec' [[y]] ys + groupConsec' xs (y:ys) = if y - head (last xs) == length (last xs) + then groupConsec' (init xs ++ [last xs ++ [y]]) ys + else groupConsec' ( xs ++ [ [y]]) ys diff --git a/src/Text/CSL/Proc/Disamb.hs b/src/Text/CSL/Proc/Disamb.hs new file mode 100644 --- /dev/null +++ b/src/Text/CSL/Proc/Disamb.hs @@ -0,0 +1,249 @@ +{-# LANGUAGE PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.CSL.Proc.Disamb +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- This module provides functions for processing the evaluated +-- 'Output' for citation disambiguation. +-- +-- Describe the disambiguation process. +-- +----------------------------------------------------------------------------- + +module Text.CSL.Proc.Disamb where + +import Control.Arrow ( (&&&), (>>>) ) +import Data.List ( (\\), elemIndex, sortBy, mapAccumL + , nub, groupBy, isPrefixOf ) +import Data.Maybe +import Data.Ord ( comparing ) + +import Text.CSL.Eval +import Text.CSL.Reference +import Text.CSL.Style + +-- | Given the 'Style', the list of references and the citation +-- groups, disambiguate citations according to the style options. +disambCitations :: Style -> [Reference] -> [[(String, String)]] -> [CitationGroup] +disambCitations s bibs cs + = citOutput + where + -- the list of the position and the reference of each citation + -- for each citation group. + refs = getRefs bibs cs + -- citation groups + groups = map (procGroup s) refs + -- citation data of duplicates + duplics = getDuplCiteData groups + + -- check the options set in the style + disOpts = getCitDisambOptions s + hasNames = "disambiguate-add-names" `elem` disOpts + hasGName = "disambiguate-add-givenname" `elem` disOpts + hasYSuff = "disambiguate-add-year-suffix" `elem` disOpts + + -- citations for which adding a name is not enough. + needYSuff = map (allTheSame . map disambData) duplics + needName = concatMap fst . filter (not . snd) $ zip duplics needYSuff + + -- apply name disambiguation options + addNames = disambWithNames hasNames hasGName needName + + -- the list of citations that need re-evaluation with the + -- \"disambiguate\" condition set to 'True' + reEval = let chk = if hasYSuff then filter ((==) [] . citYear) else id + in chk . concatMap fst . filter snd $ zip duplics needYSuff + reEvaluated = if or (query hasIfDis s) && reEval /= [] + then map (uncurry $ reEvaluate s reEval) $ zip refs groups + else groups + + -- generate the final FormattedOutput. + citOutput = if disOpts /= [] + then if hasYSuff + then proc addYearSuffix $ proc (updateOutput addNames) reEvaluated + else proc (updateOutput addNames) reEvaluated + else groups + +-- | Disambiguate a list of 'CiteData' by adding names to the list of +-- contributors, thus overriding @et-al@ options, if the first 'Bool' +-- is 'True', and/or by adding given-names if the second 'Bool' is +-- 'True'. +disambWithNames :: Bool -> Bool -> [CiteData] -> [CiteData] +disambWithNames bn bg needName + | bn && bg = let (n ,ns ) = done addLNames + (n',ns') = done $ addGNames ns + in n ++ n' ++ addGNames ns' + | bn = fst . done $ addLNames + | bg = fst . done $ addGNames needName + | otherwise = [] + where + -- do name disambiguation + disSolved = zip needName (disambiguate $ map disambData needName) + addLNames = map (\(c,n) -> c { disambed = head n }) disSolved + addGNames = map (\ c -> c { disambed = addGivenNames (disambed c) }) + + chkdup = same . proc rmGivenNames . map disambed + need a = map fst . filter (not . snd) . zip a + done a = (,) (need a $ chkdup a) (a \\ (need a $ chkdup a)) + +-- | Given the list of 'CiteData' with the disambiguated field set +-- update the evaluated citations by setting the contributor list +-- accordingly. +updateOutput :: [CiteData] -> Output -> Output +updateOutput m o + | OContrib k x _ <- o = case elemIndex (CD k x [] [] []) m of + Just i -> OContrib k (disambed $ m !! i) [] + _ -> o + | otherwise = o + +-- | Given the CSL 'Style' and the list of 'Reference's coupled with +-- their position, generate a 'CitationGroup'. The citations are +-- sorted according to the 'Style'. +procGroup :: Style -> [(String,Reference)] -> CitationGroup +procGroup (Style {citation = c, csMacros = ms , csTerms = ts}) + = CG (layFormat $ citLayout c) (layDelim $ citLayout c) . concat . process + where + format (p,r) = evalLayout (citLayout c) False ts ms (citOptions c) p r + sort = evalSorting ts ms (citOptions c) (citSort c) . snd + process = map fst . sortBy (comparing snd) . map (format &&& sort) + + +-- | Evaluate again a citation group with the 'EvalState' 'disamb' +-- field set to 'True' (for matching the @\"disambiguate\"@ +-- condition). +reEvaluate :: Style -> [CiteData] -> [(String,Reference)] -> CitationGroup -> CitationGroup +reEvaluate (Style {citation = c, csMacros = ms , csTerms = ts}) l pr (CG f d os) + = CG f d . flip concatMap (zip pr os) $ + \((p,r),out) -> if citeKey r `elem` map key l + then evalLayout (citLayout c) True ts ms (citOptions c) p r + else [out] + +-- | Check if the 'Style' has any conditional for disambiguation. In +-- this case the conditional will be try after all other +-- disambiguation strategies have failed. To be used with the generic +-- 'query' function. +hasIfDis :: IfThen -> [Bool] +hasIfDis o + | IfThen (Condition {disambiguation = d}) _ _ <- o = [d /= []] + | otherwise = [False ] + +-- | Get the list of disambiguation options set in the 'Style' for +-- citations. +getCitDisambOptions :: Style -> [String] +getCitDisambOptions + = map fst . filter ((==) "true" . snd) . + filter (isPrefixOf "disambiguate" . fst) . citOptions . citation + +-- | Set the locator, the 'citationNumber' and the position for each +-- citation, with the list of 'Reference's and the list of citation +-- groups (citation keys with locators). +getRefs :: [Reference] -> [[(String, String)]] -> [[(String, Reference)]] +getRefs r = map (map $ getReference' r) . generatePosition + +-- | Group citation data (with possible alternative names) of +-- citations which have a duplicate (same 'collision' and same +-- 'citYear'). +getDuplCiteData :: [CitationGroup] -> [[CiteData]] +getDuplCiteData g + = groupBy (\a b -> collide a == collide b) . sortBy (comparing collide) $ duplicates + where + collide = proc rmGivenNames . collision + citeData = nub $ concatMap (mapGroupOutput getCiteData) g + duplicates = filter (collide &&& citYear >>> flip elem (getDuplNamesYear g)) citeData + +-- | For an evaluated citation get its 'CiteData'. The disambiguated +-- citation and the year fields are empty. +getCiteData :: Output -> [CiteData] +getCiteData + = query contribs &&& years >>> + zipData + where + yearsQ = query getYears + years o = if yearsQ o /= [] then yearsQ o else [""] + zipData = uncurry . zipWith $ \c y -> c {citYear = y} + contribs o + | OContrib k x xs <- o = [CD k x xs [] []] + | otherwise = [] + +-- | The contributors diambiguation data, the list of names and +-- give-names, and the citation year ('OYear'). +type NamesYear = ([Output],String) + +-- | Get the contributors list ('OContrib') and the year occurring in +-- more then one citation. +getDuplNamesYear :: [CitationGroup] -> [NamesYear] +getDuplNamesYear + = nub . catMaybes . snd . mapAccumL dupl [] . getData + where + getData = concat . map nub . map (mapGroupOutput getNamesYear) + dupl a c = if snd c `elem` map snd a + then if fst c `elem` map fst a then (a,Nothing) else (c:a,Just $ snd c) + else if fst c `elem` map fst a then (a,Nothing) else (c:a,Nothing ) + +-- | Get the list of citation keys coupled with their 'NamesYear' in +-- the evaluated 'Output'. +getNamesYear :: Output -> [(String,NamesYear)] +getNamesYear + = proc rmGivenNames >>> + query contribs &&& years >>> + zipData + where + yearsQ = query getYears + years o = if yearsQ o /= [] then yearsQ o else [""] + zipData = uncurry . zipWith $ \(k,c) y -> (,) k (c,y) + contribs o + | OContrib k x _ <- o = [(k,x)] + | otherwise = [] + +getYears :: Output -> [String] +getYears o + | OYear x _ _ <- o = [x] + | otherwise = [] + + +-- List Utilities + +-- | Try to disambiguate a list of lists by returning the first non +-- colliding element, if any, of each list: +-- +-- > disambiguate [[1,2],[1,3],[2]] = [[2],[3],[2]] +disambiguate :: (Eq a) => [[a]] -> [[a]] +disambiguate [] = [] +disambiguate l + = if hasMult l && not (allTheSame l) && hasDuplicates heads + then disambiguate (rest l) + else heads + where + heads = map head' l + rest = map (\(b,x) -> if b then tail' x else head' x) . zip (same heads) + + hasMult [] = False + hasMult (x:xs) = length x > 1 || hasMult xs + + tail' [x] = [x] + tail' x = if null x then x else tail x + +-- | For each element a list of 'Bool': 'True' if the element has a +-- duplicate in the list: +-- +-- > same [1,2,1] = [True,False,True] +same :: Eq a => [a] -> [Bool] +same [] = [] +same l + = map (flip elem dupl) l + where + dupl = catMaybes . snd . macc [] $ l + macc = mapAccumL $ \a x -> if x `elem` a then (a,Just x) else (x:a,Nothing) + +hasDuplicates :: Eq a => [a] -> Bool +hasDuplicates = or . same + +allTheSame :: Eq a => [a] -> Bool +allTheSame = and . same + diff --git a/src/Text/CSL/Reference.hs b/src/Text/CSL/Reference.hs --- a/src/Text/CSL/Reference.hs +++ b/src/Text/CSL/Reference.hs @@ -5,7 +5,7 @@ -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- --- Maintainer : Andrea Rossato +-- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- @@ -49,6 +49,7 @@ | Just v <- fromValue val :: Maybe [Agent] = v /= [] | Just v <- fromValue val :: Maybe [RefDate] = v /= [] | Just v <- fromValue val :: Maybe Int = v /= 0 + | Just v <- fromValue val :: Maybe CNum = v /= 0 | Just v <- fromValue val :: Maybe Locator = v /= NoneLoc | otherwise = False @@ -79,6 +80,7 @@ | ArticleJournal | Bill | Book + | Broadcast | Chapter | Entry | EntryDictionary @@ -111,6 +113,9 @@ instance Show RefType where show = map toLower . formatField . showConstr . toConstr +newtype CNum = CNum { unCNum :: Int } deriving ( Show, Read, Eq, Num, Typeable, Data ) + +-- | The 'Reference' record. data Reference = Reference { citeKey :: String @@ -167,7 +172,7 @@ , doi :: String , isbn :: String - , citationNumber :: Int + , citationNumber :: CNum , yearSuffix :: String , citationLabel :: String } deriving ( Eq, Show, Read, Typeable, Data ) @@ -229,24 +234,29 @@ , doi = [] , isbn = [] - , citationNumber = 0 + , citationNumber = CNum 0 , yearSuffix = [] , citationLabel = [] } +-- | With the list of 'Reference's and the tuple (citation key, +-- locator), return the needed reference with the correct locator set. getReference :: [Reference] -> (String,String) -> Reference getReference r = snd . getReference' r . flip (,) ("",0) +-- | With the 'Reference' list and the generated position for each +-- tuple of citation key and locator, produce a list of 'Reference's +-- with their positions (which come first. getReference' :: [Reference] -> ((String,String),(String,Int)) -> (String, Reference) getReference' r ((c,l),(p,n)) = case c `elemIndex` map citeKey r of Just i -> (,) p $ (r !! i) { locator = parseLocator l - , citationNumber = n } + , citationNumber = CNum n } Nothing -> (,) p $ emptyReference { title = c ++ " not found!" - , citationNumber = n } + , citationNumber = CNum n } data Locator = NoneLoc @@ -260,6 +270,13 @@ | NoteLoc String | OpusLoc String | PageLoc String + | PageFstLoc String + | ParaLoc String + | PartLoc String + | SecLoc String + | SubVerbLoc String + | VolLoc String + | VerseLoc String deriving ( Read, Eq, Typeable, Data ) instance Show Locator where @@ -277,24 +294,40 @@ | NoteLoc s <- l = s | OpusLoc s <- l = s | PageLoc s <- l = s + | PageFstLoc s <- l = s + | ParaLoc s <- l = s + | PartLoc s <- l = s + | SecLoc s <- l = s + | SubVerbLoc s <- l = s + | VolLoc s <- l = s + | VerseLoc s <- l = s | otherwise = [] parseLocator :: String -> Locator parseLocator s - | "b" `isPrefixOf` formatField s = mk BookLoc - | "ch" `isPrefixOf` formatField s = mk ChapterLoc - | "co" `isPrefixOf` formatField s = mk ColumnLoc - | "fi" `isPrefixOf` formatField s = mk FigureLoc - | "fo" `isPrefixOf` formatField s = mk FolioLoc - | "i" `isPrefixOf` formatField s = mk IssueLoc - | "l" `isPrefixOf` formatField s = mk LineLoc - | "n" `isPrefixOf` formatField s = mk NoteLoc - | "o" `isPrefixOf` formatField s = mk OpusLoc - | "p" `isPrefixOf` formatField s = mk PageLoc + | "b" `isPrefixOf` formatField s = mk BookLoc + | "ch" `isPrefixOf` formatField s = mk ChapterLoc + | "co" `isPrefixOf` formatField s = mk ColumnLoc + | "fi" `isPrefixOf` formatField s = mk FigureLoc + | "fo" `isPrefixOf` formatField s = mk FolioLoc + | "i" `isPrefixOf` formatField s = mk IssueLoc + | "l" `isPrefixOf` formatField s = mk LineLoc + | "n" `isPrefixOf` formatField s = mk NoteLoc + | "o" `isPrefixOf` formatField s = mk OpusLoc + | "para" `isPrefixOf` formatField s = mk ParaLoc + | "part" `isPrefixOf` formatField s = mk PartLoc + | "p" `isPrefixOf` formatField s = mk PageLoc + | "sec" `isPrefixOf` formatField s = mk SecLoc + | "sub" `isPrefixOf` formatField s = mk SubVerbLoc + | "ve" `isPrefixOf` formatField s = mk VerseLoc + | "v" `isPrefixOf` formatField s = mk VolLoc +-- | "p" `isPrefixOf` formatField s = mk PageFstLoc | otherwise = NoneLoc where mk c = if null s then NoneLoc else c . concat . tail . words $ s +-- | For each citation group generate the position and the citation +-- number of each citation. generatePosition :: [[(String,String)]] -> [[((String,String),(String,Int))]] generatePosition = getPos ([],[]) diff --git a/src/Text/CSL/Style.hs b/src/Text/CSL/Style.hs --- a/src/Text/CSL/Style.hs +++ b/src/Text/CSL/Style.hs @@ -1,13 +1,12 @@ {-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable {-# LANGUAGE PatternGuards #-} --- {-# LANGUAGE #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Style -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- --- Maintainer : Andrea Rossato +-- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- @@ -19,6 +18,7 @@ import Data.Generics +-- | The representation of a parsed CSL style. data Style = Style { styleClass :: String @@ -207,20 +207,29 @@ data CSAuthor = CSAuthor String String String deriving ( Show, Read, Eq, Typeable, Data ) data CSCategory = CSCategory String String String deriving ( Show, Read, Eq, Typeable, Data ) +-- | The formatted output, produced after post-processing the +-- evaluated citations. data FormattedOutput = FO String Formatting [FormattedOutput] | Delimiter String deriving ( Eq, Show ) +-- | The 'Output' generated by the evaluation of a style. Must be +-- further processed for disambiguation and collapsing. data Output - = FS String Formatting - | FN String [String] Formatting -- ^ A name and its given name if needed - | FY String String Formatting -- ^ The year and a suffix if needed - | O [Output] Formatting - | FC String [Output] [[Output]] -- ^ The contributor(s) with additional names - | S String + = OStr String Formatting -- ^ A simple 'String' + | OName String [String] Formatting -- ^ A (family) name with the list of given names. + | OYear String String Formatting -- ^ The year and a suffix if needed + | OCitNum Int Formatting -- ^ The citation number + | Output [Output] Formatting -- ^ Some nested 'Output' + | OContrib String [Output] [[Output]] -- ^ The citation key with the contributor(s), and everything + -- used for disambiguation. + | ODel String -- ^ A delimiter string. deriving ( Eq, Ord, Show, Typeable, Data ) +-- | A citation group: a list of evaluated citations, the 'Formatting' +-- to be applied to them, and the 'Delimiter' between individual +-- citations. data CitationGroup = CG Formatting String [Output] deriving ( Show, Eq, Typeable, Data ) data BiblioData @@ -229,54 +238,79 @@ , bibliography :: [[FormattedOutput]] } deriving ( Show ) +-- | A record with all the data to produce the 'FormattedOutput' of a +-- citation: the citation key, the part of the citation that may be +-- colliding with other citations (the list of contributors for the +-- same year), the data to disambiguate it (all possible contributors +-- and all possible given names), and the disambiguated citation and +-- its year. data CiteData = CD - { key :: String - , collision :: [Output] - , disData :: [[Output]] - , disambed :: [Output] - , citYear :: String + { key :: String + , collision :: [Output] + , disambData :: [[Output]] + , disambed :: [Output] + , citYear :: String } deriving ( Show, Typeable, Data ) instance Eq CiteData where (==) (CD ka ca _ _ _) (CD kb cb _ _ _) = ka == kb && ca == cb +-- | Convert evaluated 'Output' into 'FormattedOutput', ready for the +-- output filters. formatOutput :: Output -> FormattedOutput formatOutput o - | S s <- o = Delimiter s - | FS s f <- o = FO s f [] - | FN s _ f <- o = FO s f [] - | FY s _ f <- o = FO s f [] - | O os f <- o = FO "" f (format os) - | FC _ s _ <- o = FO "" emptyFormatting (format s) + | ODel s <- o = Delimiter s + | OStr s f <- o = FO s f [] + | OName s _ f <- o = FO s f [] + | OYear s _ f <- o = FO s f [] + | Output os f <- o = FO "" f (format os) + | OContrib _ s _ <- o = FO "" emptyFormatting (format s) + | OCitNum i f <- o = FO (show i) f [] | otherwise = FO "" emptyFormatting [] where format = map formatOutput +-- | Map the evaluated output of a citation group. +mapGroupOutput :: (Output -> [a]) -> CitationGroup -> [a] +mapGroupOutput f (CG _ _ os) = concatMap f os + +-- | A generic processing function. proc :: (Typeable a, Data b) => (a -> a) -> b -> b proc f = everywhere (mkT f) +-- | A generic query function. query :: (Typeable a, Data b) => (a -> [c]) -> b -> [c] query f = everything (++) ([] `mkQ` f) +-- | Removes all given names form a 'OName' element with 'proc'. rmGivenNames :: Output -> Output rmGivenNames o - | FN s _ f <- o = FN s [] f + | OName s _ f <- o = OName s [] f | otherwise = o +-- | Removes all contributors' names. +rmContribs :: Output -> Output +rmContribs o + | OContrib s _ _ <- o = OContrib s [] [] + | otherwise = o + +-- | Add, with 'proc', a give name to the family name. Needed for +-- disambiguation. addGivenNames :: [Output] -> [Output] addGivenNames = reverse . addGN True . reverse where addGN _ [] = [] addGN b (o:os) - | FN _ xs f <- o - , xs /= [] = if b then FN (head xs) (tail xs) f : addGN False os else o:os + | OName _ xs f <- o + , xs /= [] = if b then OName (head xs) (tail xs) f : addGN False os else o:os | otherwise = o : addGN b os +-- | Add the year suffix to the year. Needed for disambiguation. addYearSuffix :: Output -> Output addYearSuffix o - | FY y s f <- o = FY (y ++ s) s f - | otherwise = o + | OYear y s f <- o = OYear (y ++ s) s f + | otherwise = o diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -38,7 +38,7 @@ putStrLn . concatMap renderPlainStrict $ bibliography result when (modsCo config /= []) $ do - ref <- readModsColletionFile (modsCo config) + ref <- readBiblioFile (modsCo config) "bibtex" let result = citeproc s ref [map (citeKey &&& const "") ref] case output config of "pandoc" -> do let concatPan = foldr (\x xs -> if xs /= [] then x ++ "," ++ xs else x ++ xs) []