diff --git a/citeproc-hs.cabal b/citeproc-hs.cabal --- a/citeproc-hs.cabal +++ b/citeproc-hs.cabal @@ -1,5 +1,5 @@ name: citeproc-hs -version: 0.3.2 +version: 0.3.3 homepage: http://gorgias.mine.nu/repos/citeproc-hs/ synopsis: A Citation Style Language implementation in Haskell @@ -39,7 +39,7 @@ locales/locales-is-IS.xml locales/locales-it-IT.xml locales/locales-ja-JP.xml - locales/locales-kh-KH.xml + locales/locales-km-KH.xml locales/locales-ko-KR.xml locales/locales-mn-MN.xml locales/locales-nb-NO.xml @@ -72,6 +72,10 @@ description: Use network and HTTP to retrieve csl file from URIs. default: True +flag embed_data_files + description: Embed locale files into the library (needed for windows packaging) + default: False + library exposed-modules: Text.CSL Text.CSL.Eval @@ -91,6 +95,7 @@ Text.CSL.Input.Json Text.CSL.Output.Pandoc Text.CSL.Output.Plain + Text.CSL.Test other-modules: Paths_citeproc_hs ghc-options: -funbox-strict-fields -Wall ghc-prof-options: -prof -auto-all @@ -107,6 +112,11 @@ build-depends: network >= 2, HTTP >= 4000.0.9 extensions: CPP cpp-options: -DUSE_NETWORK + + if flag(embed_data_files) + build-depends: template-haskell, file-embed + extensions: CPP + cpp-options: -DEMBED_DATA_FILES if impl(ghc >= 6.10) build-depends: base >= 4, syb, parsec, old-locale, time diff --git a/locales/locales-af-ZA.xml b/locales/locales-af-ZA.xml --- a/locales/locales-af-ZA.xml +++ b/locales/locales-af-ZA.xml @@ -55,6 +55,7 @@ BC + “ ” ‘ diff --git a/locales/locales-ar-AR.xml b/locales/locales-ar-AR.xml --- a/locales/locales-ar-AR.xml +++ b/locales/locales-ar-AR.xml @@ -1,304 +1,291 @@ - - - - - - - - - - - - - - - زير - و - وآخرون - مجهول - مجهول - عند - by - circa - c. - وثِّقَ - - الطبعة - الطبعات - - ط - et al. - القادم - من - آيبيد - في - تحت الطبع - الإنترنت - مقابلة - رسالة - no date - n.d. - ربط مباشر - قُدَّم في - - reference - references - - - ref. - refs. - - جلب - - - AD - BC - - - “ - ” - ‘ - ’ - - - st - nd - rd - th - - - first - second - third - fourth - fifth - sixth - seventh - eighth - ninth - tenth - - - علم الإنسان - علم الفلك - علم الأحياء - علم النبات - علم الكيمياء - الهندسة - أساس عام - جغرافيا - علم الأرض - التاريخ - الإنسانيات - linguistics - الأدب - الرياضيات - الطب - الفلسفة - الفيزياء - علم النفس - علم الإجتماع - العلوم - العلوم السياسية - العلوم الإجتماعية - العلوم الإلهية - علم الحيوان - - - - كتاب - كُتُب - - - فصل - فصول - - - عمود - أعمدة - - - رسم توضيحي - رسوم توضيحية - - - ورقة - أوراق - - - عدد - أعداد - - - سطر - أسطر - - - ملاحظة - ملاحظات - - - قطعة موسيقية - أوبرا - - - صفحة - صفحات - - - فقرة - فقرات - - - جزء - أجزاء - - - قسم - أقسام - - - sub verbo - sub verbis - - - بيت - أبيات - - - مجلد - مجلدات - - - - ك - ف - عم - ر - و - عد - مم - - ص - ص.ص - - فق - جز - ق - - s.v. - s.vv. - - - ب - بب - - - مج - مجج - - - - - - ¶¶ - - - § - §§ - - - - - - - - - تحرير - تحرير - - - editor - editors - - - ترجمة - ترجمة - - - editor & translator - editors & translators - - - - - - - - - مح - محح - - - ed. - eds. - - - تر - ترر - - - ed. & tran. - eds. & trans. - - - - حرره - edited by - ترجمه - edited & translated by - إلى - مقابلة بواسطة - - - by - مح - ed. - مت - ed. & trans. by - - - يناير - فبراير - مارس - ابريل - مايو - يونيو - يوليو - اغسطس - سبتمبر - اكتوبر - نوفمبر - ديسمبر - - - يناير - فبراير - مارس - ابريل - مايو - يونيو - يوليو - اغسطس - سبتمبر - اكتوبر - نوفمبر - ديسمبر - - - Spring - Summer - Autumn - Winter - - + + + + + + + + + + + + + + + قدمه + و + وآخرون + مجهول + مجهول + عند + عن طريق + حوالي + حو. + وثِّقَ + + الطبعة + الطبعات + + ط. + واخ. + القادم + من + المرجع السابق + في + قيد النشر + الإنترنت + مقابلة + خطاب + دون تاريخ + د.ت + الخط المباشر + قُدَّم في + + مرجع + مراجع + + + مرجع + مراجع + + استرجع + + بعد الميلاد + قبل الميلاد + + + + " + " + ' + ' + + + + + + + الاول + الثاني + الثالث + الرابع + الخامس + السادس + السابع + الثامن + التاسع + العاشر + + علم الأعراق البشرية + الفلك + الأحياء + النبات + الكيمياء + الهندسة + العلوم العامة + الجغرافيا + الجيولوجيا + التاريخ + الإنسانيات + اللغويات + الأدب + الرياضيات + الطب + الفلسفة + الفيزياء + علم النفس + علم الإجتماع + العلوم البحتة + العلوم السياسية + العلوم الإجتماعية + الإلهيات + علم الحيوان + + + كتاب + كُتُب + + + فصل + فصول + + + عمود + أعمدة + + + رسم توضيحي + رسوم توضيحية + + + ورقة + أوراق + + + عدد + أعداد + + + سطر + أسطر + + + ملاحظة + ملاحظات + + + نوته موسيقية + نوتات موسيقية + + + صفحة + صفحات + + + فقرة + فقرات + + + جزء + أجزاء + + + قسم + أقسام + + + تفسير فرعي + تفسيرات فرعية + + + بيت شعر + أبيات شعرية + + + مجلد + مجلدات + + + كتاب + فصل + عمود + رسم توضيحي + مطوية + عدد + نوتة موسيقية + + ص + ص.ص. + + فقرة + ج. + قسم + + تفسير فرعي + تفسيرات فرعية + + + بيت شعر + ابيات شعرية + + + مج. + مج. + + + + + ¶¶ + + + § + §§ + + + + مؤلف + مؤلفين + + + محرر + محررين + + + رئيس التحرير + رؤساء التحرير + + + مترجم + مترجمين + + + مترجم ومحرر + مترجمين ومحررين + + + + مؤلف + مؤلف + + + محرر + محرر + + + مشرف على الطبعة + مشرفين على الطبعة + + + مترجم + مترجمين + + + مترجم ومشرف على الطباعه + مترجمين ومشرفين على الطباعه + + + تحرير + اعداد + ترجمة + اعداد وترجمة + إلى + مقابلة بواسطة + + by + تحرير + اشرف على الطبعة + ترجمة + ترجمه واشرف على الطباعه + + يناير + فبراير + مارس + ابريل + مايو + يونيو + يوليو + اغسطس + سبتمبر + اكتوبر + نوفمبر + ديسمبر + + يناير + فبراير + مارس + ابريل + مايو + يونيو + يوليو + اغسطس + سبتمبر + اكتوبر + نوفمبر + ديسمبر + + الربيع + الصيف + الخريف + الشتاء + + diff --git a/locales/locales-bg-BG.xml b/locales/locales-bg-BG.xml --- a/locales/locales-bg-BG.xml +++ b/locales/locales-bg-BG.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + „ + “ + „ + “ st diff --git a/locales/locales-ca-AD.xml b/locales/locales-ca-AD.xml --- a/locales/locales-ca-AD.xml +++ b/locales/locales-ca-AD.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + « + » + “ + ” st diff --git a/locales/locales-cs-CZ.xml b/locales/locales-cs-CZ.xml --- a/locales/locales-cs-CZ.xml +++ b/locales/locales-cs-CZ.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + „ + “ + ‚ + ‘ st diff --git a/locales/locales-da-DK.xml b/locales/locales-da-DK.xml --- a/locales/locales-da-DK.xml +++ b/locales/locales-da-DK.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + » + « + › + ‹ st diff --git a/locales/locales-de-AT.xml b/locales/locales-de-AT.xml --- a/locales/locales-de-AT.xml +++ b/locales/locales-de-AT.xml @@ -55,10 +55,12 @@ BC - “ - ” - ‘ - ’ + + „ + “ + ‚ + ‘ + st diff --git a/locales/locales-de-CH.xml b/locales/locales-de-CH.xml --- a/locales/locales-de-CH.xml +++ b/locales/locales-de-CH.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + « + » + ‹ + › st diff --git a/locales/locales-de-DE.xml b/locales/locales-de-DE.xml --- a/locales/locales-de-DE.xml +++ b/locales/locales-de-DE.xml @@ -55,16 +55,16 @@ BC - “ - ” - ‘ - ’ + „ + “ + ‚ + ‘ - st - nd - rd - th + . + . + . + . first diff --git a/locales/locales-el-GR.xml b/locales/locales-el-GR.xml --- a/locales/locales-el-GR.xml +++ b/locales/locales-el-GR.xml @@ -16,17 +16,17 @@ και και άλλοι ανώνυμο - ανών - εφ - του + ανών. + εφ. + από περίπου - περ - παρατίθεται στο + περ. + παρατίθεται - έκδοση - εκδόσεις + έκδοση + εκδόσεις - έκδ + έκδ. κ.ά. προσεχές από @@ -41,12 +41,12 @@ έκδοση σε ψηφιακή μορφή παρουσιάστηκε στο - αναφορά - αναφορές + παραπομπή + παραπομπές - αναφ. - αναφ. + παρ. + παρ. ανακτήθηκε @@ -55,10 +55,12 @@ π.Χ. - « - » - ‘ - ’ + + ‘ + ’ + ' + ' ος @@ -85,7 +87,7 @@ βοτανική χημεία μηχανική - γενική βάση + γενική βιβλιογραφία γεωγραφία γεωλογία ιστορία @@ -170,31 +172,31 @@ - βιβ - κεφ - στ - εικ - φακ - τχ - έργ + βιβ. + κεφ. + στ. + εικ. + φάκ + τχ. + έργ. σ σσ - παρ - μερ - τμ + παρ. + μέρ. + τμ. - λήμ - λήμ + λήμ. + λήμ. - στ - στ + στ. + στ. - τμ - τμ + τ. + τ. @@ -209,63 +211,63 @@ - - + συγγραφέας + συγγραφείς επιμελητής επιμελητές - γενική εποπτεία - γενική εποπτεία + διευθυντής σειράς + διευθυντές σειράς μεταφραστής μεταφραστές - μετάφραση και επιμέλεια - μετάφραση και επιμέλεια + μεταφραστής και επιμελητής + μεταφραστές και επιμελητές - - + συγγρ. + συγγρ. - επιμ - επιμ + επιμ. + επιμ. - γεν. επ - γεν. επ + δ/ντής σειράς + δ/ντές σειρας μτφ. μτφ. - μτφ. και επιμ - μτφ. και επιμ + μτφ. και επιμ. + μτφ. και επιμ. - επιμ - γεν επ - μτφ - μτφ. και επιμ - στο + επιμέλεια + διεύθυνση σειράς + μετάφραση + μετάφραση και επιμέλεια + παραλήπτης συνέντευξη - στο - επιμ - γεν. επ - μτφ - μτφ. και επιμ - + στον συλλ. τόμο + επιμέλ. + δ/νση σειράς + μετάφρ. + μετάφρ. και επιμέλ. + Ιανουάριος Φεβρουάριος diff --git a/locales/locales-es-ES.xml b/locales/locales-es-ES.xml --- a/locales/locales-es-ES.xml +++ b/locales/locales-es-ES.xml @@ -55,16 +55,17 @@ BC - “ - ” - ‘ - ’ + + « + » + “ + ” - st - nd - rd - th + o + o + o + o first diff --git a/locales/locales-fr-FR.xml b/locales/locales-fr-FR.xml --- a/locales/locales-fr-FR.xml +++ b/locales/locales-fr-FR.xml diff --git a/locales/locales-hu-HU.xml b/locales/locales-hu-HU.xml --- a/locales/locales-hu-HU.xml +++ b/locales/locales-hu-HU.xml @@ -55,10 +55,11 @@ BC - “ + + „ ” - ‘ - ’ + » + « st diff --git a/locales/locales-is-IS.xml b/locales/locales-is-IS.xml --- a/locales/locales-is-IS.xml +++ b/locales/locales-is-IS.xml @@ -7,195 +7,196 @@ - - + + - accessed - and - and others - anonymous - anon - at - by - circa - c. - cited + opnað + og + og fleiri + nafnlaus + nafnl. + af + eftir + sirca + u.þ.b. + tilvitnun - edition - editions + útgáfa + útgáfur - ed - et al. - forthcoming - from + útg. + o.fl. + óbirt + af ibid. - in - in press + í + í prentun internet - interview - letter - no date - nd - online - presented at the + viðtal + bréf + engin dagsetning + e.d. + rafrænt + flutt á - reference - references + tilvitnun + tilvitnanir - ref. - refs. + tilv. + tilv. - retrieved + sótt - AD - BC + e.Kr. + f.Kr. - “ - ” - ‘ - ’ + + „ + “ + ‚ + ‘ - st - nd - rd - th + . + . + . + . - first - second - third - fourth - fifth - sixth - seventh - eighth - ninth - tenth + fyrsti + annar + þriðji + fjórði + fimmti + sjötti + sjöundi + áttundi + níundi + tíundi - anthropology - astronomy - biology - botany - chemistry - engineering + mannfræði + stjörnufræði + líffræði + grasafræði + efnafræði + verkfræði generic base - geography - geology - history - humanities - linguistics - literature - math - medicine - philosophy - physics - psychology - sociology - science - political science - social science - theology - zoology + landafræði + jarðfræði + saga + hugvísindi + málvísindi + bókmenntir + stærðfræði + læknisfræði + heimspeki + eðlisfræði + sálfræði + félagsfræði + vísindi + stjórnmálafræði + félagsvísindi + guðfræði + dýrafræði - book - books + bók + bækur - chapter - chapters + kafli + kaflar - column - columns + dálkur + dálkar - figure - figures + mynd + myndir - folio - folios + handrit + handrit - number - numbers + númer + númer - line - line + lína + línur - note - notes + skilaboð + skilaboð - opus - opera + tónverk + tónverk - page - pages + blaðsíða + blaðsíður - paragraph - paragraph + málsgrein + málsgreinar - part - parts + hluti + hlutar - section - sections + hluti + hlutar sub verbo sub verbis - verse - verses + vers + vers - volume - volumes + útgáfa + útgáfur - bk - chap - col - fig - f - no - op + b. + k. + d. + mynd. + handr. + nr. + tónv. - p - pp + bls. + bls. - para - pt - sec + málsgr. + hl. + hl. s.v. s.vv. - v - vv + v. + v. - vol - vols + útg. + útg. @@ -210,95 +211,95 @@ - - + höfundur + höfundar - editor - editors + ritstjóri + ritstjórar - editor - editors + ritstjóri + ritstjórar - translator - translators + þýðandi + þýðendur - editor & translator - editors & translators + ritstjóri og þýðandi + ritstjórar og þýðendur - - + höf. + höf. - ed - eds + ritstj. + ritstj. - ed. - eds. + ritstj. + ritstj. - tran - trans + þýð. + þýð. - ed. & tran. - eds. & trans. + ritstj. og þýð. + ritstj. og þýð. - edited by - edited by - translated by - edited & translated by - to - interview by + ritstýrt af + ritstýrt af + þýtt af + ritstýrt og þýtt af + til + viðtal tekið af - by - ed - ed. - trans - ed. & trans. by + eftir + ritst. + ritst. + þýtt + ritstýrt og þýtt af - January - February - March - April - May - June - July - August - September - October - November - December + janúar + febrúar + mars + apríl + maí + júní + júlí + ágúst + september + október + nóvember + desember - Jan - Feb - Mar - Apr - May - Jun - Jul - Aug - Sep - Oct - Nov - Dec + jan. + feb. + mar. + apr. + mai + jún. + júl. + ágú. + sep. + okt. + nóv. + des. - Spring - Summer - Autumn - Winter + vor + sumar + haust + vetur diff --git a/locales/locales-it-IT.xml b/locales/locales-it-IT.xml --- a/locales/locales-it-IT.xml +++ b/locales/locales-it-IT.xml @@ -55,8 +55,9 @@ BC - “ - ” + + « + » ‘ ’ diff --git a/locales/locales-ja-JP.xml b/locales/locales-ja-JP.xml --- a/locales/locales-ja-JP.xml +++ b/locales/locales-ja-JP.xml @@ -3,13 +3,13 @@ - - + + - - + + アクセス @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + 「 + 」 + 『 + 』 st diff --git a/locales/locales-kh-KH.xml b/locales/locales-kh-KH.xml deleted file mode 100644 --- a/locales/locales-kh-KH.xml +++ /dev/null @@ -1,303 +0,0 @@ - - - - - - - - - - - - - - - accessed - and - and others - anonymous - anon. - at - by - circa - c. - cited - - edition - editions - - ed. - et al. - forthcoming - from - ibid - in - in press - internet - interview - letter - no date - n.d. - online - presented at the - - reference - references - - - ref. - refs. - - retrieved - - - AD - BC - - - “ - ” - ‘ - ’ - - - st - nd - rd - th - - - ទីមួយ - ទីពីរ - ទីបី - ទីបួន - ទីប្រាំ - ទីប្រាំមួយ - ទីប្រាំពីរ - ទីប្រាំបី - ទីប្រាំបួន - ទីដប់មួយ - - - នរវិទ្យា - តារាវិទ្យា - ជីវវិទ្យា - រុក្ខវិទ្យា - គីមីវិទ្យា - វិស្វកម្ម - generic base - ភូមិវិទ្យា - ភូគព្ភវិទ្យា - ប្រវត្តិវិទ្យា - មនុស្សវិទ្យា - ភាសាវិទ្យា - អក្សរសាស្ត្រ - គណិតវិទ្យា - វេជ្ជសាស្ត្រ - ទស្សនវិទ្យា - រូបវិទ្យា - ចិត្តវិទ្យា - សង្គមវិទ្យា - វិទ្យាសាស្ត្រ - វិទ្យាសាស្ត្រនយោបាយ - សង្គមវិទ្យា - ទេវវិទ្យា - សត្តវិទ្យា - - - - សៀវភៅ - សៀវភៅ - - - ជំពូក - ជំពូក - - - កាឡោន - កាឡោន - - - តួលេខ - តួលេខ - - - folio - folios - - - ចំនួន - ចំនួន - - - បន្ទាត់ - បន្ទាត់ - - - កំណត់ចំណាំ - កំណត់ចំណាំ - - - opus - opera - - - ទំព័រ - ទំព័រ - - - កថាខណ្ឌ - កថាខណ្ឌ - - - ជំពូក - ជំពូក - - - ផ្នែក - ផ្នែក - - - sub verbo - sub verbis - - - verse - verses - - - វ៉ុល - វ៉ុល - - - - bk. - chap. - col. - fig. - f. - no. - op. - - p. - pp. - - para. - pt. - sec. - - s.v. - s.vv. - - - v. - vv. - - - vol. - vols. - - - - - - ¶¶ - - - § - §§ - - - - - - - - - editor - editors - - - - editors - - - translator - translator - - - editor & translator - editors & translators - - - - - - - - - ed. - eds. - - - ed. - eds. - - - tran. - trans. - - - ed. & tran. - eds. & trans. - - - - edited by - edited by - translated by - edited & translated by - to - interview by - - - by - ed. - ed. - trans. - ed. & trans. by - - - មករា - កុម្ភៈ - មីនា - មេសា - ឧសភា - មិថុនា - កក្កដា - សីហា - កញ្ញា - តុលា - វិច្ឆិកា - ធ្នូ - - - Jan. - Feb. - Mar. - Apr. - May - Jun. - Jul. - Aug. - Sep. - Oct. - Nov. - Dec. - - - Spring - Summer - Autumn - Winter - diff --git a/locales/locales-km-KH.xml b/locales/locales-km-KH.xml new file mode 100644 --- /dev/null +++ b/locales/locales-km-KH.xml @@ -0,0 +1,303 @@ + + + + + + + + + + + + + + + accessed + and + and others + anonymous + anon. + at + by + circa + c. + cited + + edition + editions + + ed. + et al. + forthcoming + from + ibid + in + in press + internet + interview + letter + no date + n.d. + online + presented at the + + reference + references + + + ref. + refs. + + retrieved + + + AD + BC + + + “ + ” + ‘ + ’ + + + st + nd + rd + th + + + ទីមួយ + ទីពីរ + ទីបី + ទីបួន + ទីប្រាំ + ទីប្រាំមួយ + ទីប្រាំពីរ + ទីប្រាំបី + ទីប្រាំបួន + ទីដប់មួយ + + + នរវិទ្យា + តារាវិទ្យា + ជីវវិទ្យា + រុក្ខវិទ្យា + គីមីវិទ្យា + វិស្វកម្ម + generic base + ភូមិវិទ្យា + ភូគព្ភវិទ្យា + ប្រវត្តិវិទ្យា + មនុស្សវិទ្យា + ភាសាវិទ្យា + អក្សរសាស្ត្រ + គណិតវិទ្យា + វេជ្ជសាស្ត្រ + ទស្សនវិទ្យា + រូបវិទ្យា + ចិត្តវិទ្យា + សង្គមវិទ្យា + វិទ្យាសាស្ត្រ + វិទ្យាសាស្ត្រនយោបាយ + សង្គមវិទ្យា + ទេវវិទ្យា + សត្តវិទ្យា + + + + សៀវភៅ + សៀវភៅ + + + ជំពូក + ជំពូក + + + កាឡោន + កាឡោន + + + តួលេខ + តួលេខ + + + folio + folios + + + ចំនួន + ចំនួន + + + បន្ទាត់ + បន្ទាត់ + + + កំណត់ចំណាំ + កំណត់ចំណាំ + + + opus + opera + + + ទំព័រ + ទំព័រ + + + កថាខណ្ឌ + កថាខណ្ឌ + + + ជំពូក + ជំពូក + + + ផ្នែក + ផ្នែក + + + sub verbo + sub verbis + + + verse + verses + + + វ៉ុល + វ៉ុល + + + + bk. + chap. + col. + fig. + f. + no. + op. + + p. + pp. + + para. + pt. + sec. + + s.v. + s.vv. + + + v. + vv. + + + vol. + vols. + + + + + + ¶¶ + + + § + §§ + + + + + + + + + editor + editors + + + + editors + + + translator + translator + + + editor & translator + editors & translators + + + + + + + + + ed. + eds. + + + ed. + eds. + + + tran. + trans. + + + ed. & tran. + eds. & trans. + + + + edited by + edited by + translated by + edited & translated by + to + interview by + + + by + ed. + ed. + trans. + ed. & trans. by + + + មករា + កុម្ភៈ + មីនា + មេសា + ឧសភា + មិថុនា + កក្កដា + សីហា + កញ្ញា + តុលា + វិច្ឆិកា + ធ្នូ + + + Jan. + Feb. + Mar. + Apr. + May + Jun. + Jul. + Aug. + Sep. + Oct. + Nov. + Dec. + + + Spring + Summer + Autumn + Winter + diff --git a/locales/locales-ko-KR.xml b/locales/locales-ko-KR.xml --- a/locales/locales-ko-KR.xml +++ b/locales/locales-ko-KR.xml @@ -55,6 +55,7 @@ BC + “ ” ‘ diff --git a/locales/locales-mn-MN.xml b/locales/locales-mn-MN.xml --- a/locales/locales-mn-MN.xml +++ b/locales/locales-mn-MN.xml @@ -55,10 +55,12 @@ BC - “ - ” - ‘ - ’ + + + « + » + „ + “ st diff --git a/locales/locales-nb-NO.xml b/locales/locales-nb-NO.xml --- a/locales/locales-nb-NO.xml +++ b/locales/locales-nb-NO.xml @@ -27,7 +27,7 @@ utgaver utg. - m.fl. + mfl. kommende fra ibid. diff --git a/locales/locales-nn-NO.xml b/locales/locales-nn-NO.xml --- a/locales/locales-nn-NO.xml +++ b/locales/locales-nn-NO.xml @@ -27,7 +27,7 @@ utgåver utg. - m.fl. + mfl. kommande frå ibid. diff --git a/locales/locales-pl-PL.xml b/locales/locales-pl-PL.xml --- a/locales/locales-pl-PL.xml +++ b/locales/locales-pl-PL.xml @@ -55,10 +55,11 @@ BC - “ + + „ ” - ‘ - ’ + « + » st diff --git a/locales/locales-pt-PT.xml b/locales/locales-pt-PT.xml --- a/locales/locales-pt-PT.xml +++ b/locales/locales-pt-PT.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + « + » + “ + ” st diff --git a/locales/locales-ro-RO.xml b/locales/locales-ro-RO.xml --- a/locales/locales-ro-RO.xml +++ b/locales/locales-ro-RO.xml @@ -12,23 +12,23 @@ - accesat în - şi - şi alţii + data accesării: + și + și alții anonim - anon + anon. la - by + de circa - c. + cca. citat - ediţia - ediţiile + ediția + edițiile ed et al. - în curs de apariţie + în curs de apariție din ibidem în @@ -36,47 +36,48 @@ internet interviu scrisoare - no date + fără dată f.a. online prezentat la - reference - references + referință + referințe ref. - refs. + ref. preluat în - AD - BC + d.Hr. + î.Hr. - “ + + „ ” - ‘ - ’ + « + » - st - nd - rd - th + + -lea + -lea + -lea - first - second - third - fourth - fifth - sixth - seventh - eighth - ninth - tenth + primul + al doilea + al treilea + al patrulea + al cincilea + al șaselea + al șaptelea + al optulea + al nouălea + al zecelea antropologie @@ -89,8 +90,8 @@ geografie geologie istorie - umanioare - linguistics + științe umaniste + lingvistică literatură matematică medicină @@ -98,16 +99,16 @@ fizică psihologie sociologie - ştiinţă - ştiinţe politice - ştiinţe sociale + știință + științe politice + științe sociale teologie zoologie cartea - cărţile + cărțile capitolul @@ -151,11 +152,11 @@ partea - părţile + părțile - secţiunea - secţiunile + secțiunea + secțiunile sub verbo @@ -171,31 +172,31 @@ - cart - cap - col - fig - fol - nr - op + cart. + cap. + col. + fig. + fol. + nr. + op. - p - pp + p. + pp. - par - part - sec + par. + part. + sec. s.v. s.vv. - v - vv + v. + vv. - vol - vol + vol. + vol. @@ -219,53 +220,53 @@ editor - editors + editori traducător traducători - editor & translator - editors & translators + editor & traducător + editori & traducători - aut - aut + aut. + aut. - ed - ed + ed. + ed. ed. - eds. + ed. - trad - trad + trad. + trad. - ed. & tran. - eds. & trans. + ed. & trad. + ed. & trad. - ediţie de - edited by + ediție de + ediție de traducere de - edited & translated by + ediție & traducere de în interviu de - by - ed + de + ed. ed. - trad - ed. & trans. by + trad. + ed. & trad. de ianuarie @@ -282,23 +283,23 @@ decembrie - ian - feb - mar - apr + ian. + feb. + mar. + apr. mai - iun - iul - aug - sep - oct - nov - dec + iun. + iul. + aug. + sep. + oct. + nov. + dec. - Spring - Summer - Autumn - Winter + primăvara + vara + toamna + iarna diff --git a/locales/locales-ru-RU.xml b/locales/locales-ru-RU.xml --- a/locales/locales-ru-RU.xml +++ b/locales/locales-ru-RU.xml @@ -1,5 +1,6 @@ + @@ -12,34 +13,35 @@ - вызвано + просмотрено и - and others - anonymous - anon - at - by + и др. + аноним + анон. + на + circa - c. - cited + ca. + цитируется по + цит. по - edition - editions + издание + издания - ed + изд. и др. - грядущие + ожидается от - так же + там же в - in press - internet - interview - letter - no date - нет даты + в печати + Интернет + интервью + письмо + без даты + б. д. online - presented at the + представлено на reference references @@ -51,98 +53,98 @@ извлечено - AD - BC + н. э. + до н. э. - “ - ” - ‘ - ’ + « + » + „ + “ - st - nd - rd - th + й + й + й + й - first - second - third - fourth - fifth - sixth - seventh - eighth - ninth - tenth + первый + второй + третий + четвертый + пятый + шестой + седьмой + восьмой + девятый + десятый - anthropology - astronomy - biology - botany - chemistry - engineering - generic base - geography - geology - history - humanities - linguistics - literature - math - medicine - philosophy - physics - psychology - sociology - science - political science - social science - theology - zoology + антропология + астрономия + биология + ботаника + химия + инженерное дело + общий + география + геология + история + гуманитарные науки + лингвистика + литературоведение + математика + медицина + философия + физика + психология + социология + естественные науки + политические науки + социальные науки + теология + зоология - book - books + книга + книги - chapter - chapters + глава + главы - column - columns + столбец + столбцы - figure - figures + рисунок + рисунки - folio - folios + лист + листы - number - numbers + выпуск + выпуски - линия - линии + строка + строки - note - notes + примечание + примечания - opus - opera + сочинение + сочинения - страницы + страница страницы @@ -150,52 +152,52 @@ параграфы - part - parts + часть + части - section - sections + раздел + разделы - sub verbo - sub verbis + смотри + смотри - verse - verses + стих + стихи - volume - volumes + том + тома - bk - chap - col - fig - f - ном - op + кн. + гл. + стб. + рис. + л. + № + соч. - стр-а - стр-ы + с. + с. - para - pt - sec + пара. + ч. + разд. - s.v. - s.vv. + см. + см. - v - vv + ст. + ст. - vol - vols + т. + тт. @@ -218,16 +220,16 @@ редакторы - editor - editors + ответственный редактор + ответственные редакторы переводчик переводчики - editor & translator - editors & translators + редактор и переводчик + редакторы и переводчики @@ -236,69 +238,69 @@ - ред-р - ред-ры + ред. + ред. - ed. - eds. + отв. ред. + отв. ред. - перев-к - перев-и + перев. + перев. - ed. & tran. - eds. & trans. + ред. и перев. + ред. и перев. отредактировано - edited by + отредактировано переведено - edited & translated by - to - interview by + отредактировано и переведено + к + интервью - by - ред - ed. - перев - ed. & trans. by + + ред. + отв. ред. + перев. + ред. и перев. - Январь - Февраль - Март - Апрель - Май - Июнь - Июль - Август - Сентябрь - Октябрь - Ноябрь - Декабрь + январь + февраль + март + апрель + май + июнь + июль + август + сентябрь + октябрь + ноябрь + декабрь - Янв - Фев - Мар - Апр - Май - Июн - Июл - Авг - Сен - Окт - Ноя - Дек + янв. + фев. + мар. + апр. + май + июн. + июл. + авг. + сен. + окт. + ноя. + дек. - Spring - Summer - Autumn - Winter + весна + лета + осень + зима diff --git a/locales/locales-sl-SI.xml b/locales/locales-sl-SI.xml --- a/locales/locales-sl-SI.xml +++ b/locales/locales-sl-SI.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + „ + “ + ‚ + ‘ st 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 @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + „ + “ + ‚ + ‘ st diff --git a/locales/locales-sv-SE.xml b/locales/locales-sv-SE.xml --- a/locales/locales-sv-SE.xml +++ b/locales/locales-sv-SE.xml @@ -55,9 +55,10 @@ BC - “ + + ” ” - ‘ + ’ ’ diff --git a/locales/locales-tr-TR.xml b/locales/locales-tr-TR.xml --- a/locales/locales-tr-TR.xml +++ b/locales/locales-tr-TR.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + « + » + ‹ + › st diff --git a/locales/locales-uk-UA.xml b/locales/locales-uk-UA.xml --- a/locales/locales-uk-UA.xml +++ b/locales/locales-uk-UA.xml @@ -55,8 +55,10 @@ BC - “ - ” + + + « + » ‘ ’ diff --git a/locales/locales-vi-VN.xml b/locales/locales-vi-VN.xml --- a/locales/locales-vi-VN.xml +++ b/locales/locales-vi-VN.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + « + » + ‹ + › st diff --git a/locales/locales-zh-TW.xml b/locales/locales-zh-TW.xml --- a/locales/locales-zh-TW.xml +++ b/locales/locales-zh-TW.xml @@ -55,10 +55,11 @@ BC - “ - ” - ‘ - ’ + + 「 + 」 + 『 + 』 st diff --git a/src/Text/CSL.hs b/src/Text/CSL.hs --- a/src/Text/CSL.hs +++ b/src/Text/CSL.hs @@ -26,8 +26,12 @@ -- * Reading Bibliographic Databases readBiblioFile + , BibFormat (..) + , readBiblioString , readModsFile , readModsCollectionFile + , readJsonInput + , readJsonInputString -- ** Reference Representation , Reference (..) @@ -74,6 +78,7 @@ import Text.CSL.Reference import Text.CSL.Style import Text.CSL.Input.Bibutils +import Text.CSL.Input.Json import Text.CSL.Input.MODS import Text.CSL.Output.Pandoc import Text.CSL.Output.Plain 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 @@ -16,6 +16,7 @@ module Text.CSL.Eval ( evalLayout , evalSorting + , rtfParser , last' , module Text.CSL.Eval.Common , module Text.CSL.Eval.Output @@ -44,7 +45,7 @@ evalLayout :: Layout -> EvalMode -> Bool -> [Locale] -> [MacroMap] -> [Option] -> Reference -> [Output] evalLayout (Layout _ _ es) em b l m o r - = cleanOutput result + = cleanOutput evalOut where evalOut = case evalState job initSt of [] -> if (isSorting $ em) @@ -52,16 +53,6 @@ else [noOutputError] x | title r == citeId cit ++ " not found!" -> [noBibDataError $ cit] | otherwise -> x - addAff f x c = case f c of - PlainText [] -> [] - PlainText p | x -> [Output (rtfParser emptyFormatting p) emptyFormatting, OSpace] - PlainText p -> [OSpace, Output (rtfParser emptyFormatting p) emptyFormatting] - PandocText [] -> [] - PandocText p | x -> [OPan p, OSpace] - PandocText p -> [OPan p] - result = case em of - EvalCite c -> addAff citePrefix True c ++ evalOut ++ addAff citeSuffix False c - _ -> evalOut locale = case l of [x] -> x _ -> Locale [] [] [] [] [] @@ -71,7 +62,7 @@ EvalSorting c -> c EvalBiblio s -> emptyCite { citePosition = s } initSt = EvalState (mkRefMap r) (Env cit (localeTermMap locale) m - (localeDate locale) o []) [] em b False [] False [] [] [] + (localeDate locale) o []) [] em b False [] [] False [] [] [] evalSorting :: EvalMode -> [Locale] -> [MacroMap] -> [Option] -> [Sort] -> Reference -> [Sorting] evalSorting m l ms opts ss r @@ -105,7 +96,7 @@ evalElement el | Choose i ei e <- el = evalIfThen i ei e | Macro s fm <- el = return . appendOutput fm =<< evalElements =<< getMacro s - | Const s fm <- el = return $ rtfParser fm $ unescape s + | Const s fm <- el = return $ rtfParser fm s | Number s f fm <- el = formatNumber f fm =<< getStringVar s | Variable s f fm d <- el = return . addDelim d =<< concatMapM (getVariable f fm) s | Group fm d l <- el = when' ((/=) [] <$> tryGroup l) $ @@ -115,7 +106,7 @@ | Term s f fm p <- el = formatLabel f fm p s | Names s n fm d sub <- el = modify (\st -> st { contNum = [] }) >> ifEmpty (evalNames False s n d) - (withNames el $ evalElements sub) + (withNames s el $ evalElements sub) (appendOutput fm) | Substitute (e:els) <- el = ifEmpty (consuming $ evalElement e) (getFirst els) id @@ -136,10 +127,12 @@ ifEmpty p t e = p >>= \r -> if r == [] then t else return (e r) - withNames n f = modify (\s -> s { env = (env s) - {names = n : names (env s)}}) >> f >>= \r -> - modify (\s -> s { env = (env s) - {names = tail $ names (env s)}}) >> return r + withNames e n f = modify (\s -> s { authSub = concat e + , env = (env s) + {names = n : names (env s)}}) >> f >>= \r -> + modify (\s -> s { authSub = [] + , env = (env s) + {names = tail $ names (env s)}}) >> return r getFirst [] = return [] getFirst (x:xs) = whenElse ((/=) [] <$> evalElement x) @@ -239,8 +232,10 @@ parser = parseText <|> parseMarkup parseText = do + let amper = string "&" >> notFollowedBy (char '#') >> + return [OStr "&" emptyFormatting] x <- many $ noneOf "<'\"`“‘&" - xs <- parseQuotes <|> parseMarkup + xs <- parseQuotes <|> parseMarkup <|> amper r <- manyTill anyChar eof return (OStr x emptyFormatting : xs ++ [Output (rtfParser emptyFormatting r) emptyFormatting]) @@ -355,9 +350,12 @@ where (a,b) = expandedRange sa sb res = if length a == length b - then second (filter (/= '+')) $ unzip $ - zipWith (\x y -> if x == y then (x,'+') else (x,y)) a b + then second (filter (/= '+')) $ unzip $ doit a b else (a,b) + doit (x:xs) (y:ys) = if x == y + then (x,'+') : doit xs ys + else zip (x:xs) (y:ys) + doit _ _ = [] chicagoRange :: String -> String -> (String, String) chicagoRange sa sb @@ -366,7 +364,7 @@ | '0':'0':_ <- sa' -> expandedRange sa sb | _ :'0':_ <- sa' -> minimalRange sa sb | _ :a2:as <- sa' - , b1:b2:bs <- sb' + , b1 :b2:bs <- sb' , comp as bs -> if a2 == b2 then (sa, [b2,b1]) else minimalRange sa sb @@ -381,12 +379,6 @@ sb' = reverse sb comp a b = let b' = takeWhile isDigit b in take (length b') a == b' - -unescape :: String -> String -unescape [] = [] -unescape ('&':'l':'t':';':xs) = "<" ++ unescape xs -unescape ('&':'g':'t':';':xs) = ">" ++ unescape xs -unescape (x :xs) = x : unescape xs last' :: [a] -> [a] last' = foldl (\_ x -> [x]) [] diff --git a/src/Text/CSL/Eval/Common.hs b/src/Text/CSL/Eval/Common.hs --- a/src/Text/CSL/Eval/Common.hs +++ b/src/Text/CSL/Eval/Common.hs @@ -33,6 +33,7 @@ , mode :: EvalMode , disamb :: Bool , consume :: Bool + , authSub :: String , consumed :: [String] , edtrans :: Bool , etal :: [[Output]] diff --git a/src/Text/CSL/Eval/Date.hs b/src/Text/CSL/Eval/Date.hs --- a/src/Text/CSL/Eval/Date.hs +++ b/src/Text/CSL/Eval/Date.hs @@ -17,6 +17,9 @@ import Control.Applicative ( (<$>) ) import Control.Monad.State +import Data.Char +import Data.List +import Data.Maybe import Text.CSL.Eval.Common import Text.CSL.Eval.Output @@ -44,10 +47,11 @@ al am an updateS a b = if b /= a && b /= [] then b else a case f of - NoFormDate -> return . outputList fm dl . concatMap (formatDate em k tm dp) =<< mapM getDateVar s + NoFormDate -> mapM getDateVar s >>= return . outputList fm dl . + concatMap (formatDate em k tm dp . concatMap parseRefDate) _ -> do Date _ _ lfm ldl ldp _ <- getDate f let go dps = return . outputList (updateFM fm lfm) (if ldl /= [] then ldl else dl) . - concatMap (formatDate em k tm dps) + concatMap (formatDate em k tm dps . concatMap parseRefDate) update l x@(DatePart a b c d) = case filter ((==) a . dpName) l of (DatePart _ b' c' d':_) -> DatePart a (updateS b b') @@ -80,12 +84,13 @@ end a b = map (formatDatePart True a) . return . last . diff a b $ dp coda b = map (formatDatePart False b) dp diff a b = filter (flip elem (diffDate a b) . dpName) - diffDate (RefDate ya ma _ da _ _) - (RefDate yb mb _ db _ _) = case () of - _ | ya /= yb -> ["year","month","day"] - | ma /= mb -> ["month","day"] - | da /= db -> ["day"] - | otherwise -> ["year","month","day"] + diffDate (RefDate ya ma sa da _ _) + (RefDate yb mb sb db _ _) = case () of + _ | ya /= yb -> ["year","month","day"] + | ma /= mb -> ["month","day"] + | da /= db -> ["day"] + | sa /= sb -> ["month"] + | otherwise -> ["year","month","day"] term f t = let f' = if f `elem` ["verb", "short", "verb-short", "symbol"] then read $ toRead f @@ -106,7 +111,7 @@ | "month" <- n, m /= [] = output (fm {suffix = []}) (formatMonth f m) ++ formatDelim | "day" <- n, d /= [] = output (fm {suffix = []}) (formatDay f d) ++ formatDelim | "month" <- n, m == [] - , e /= [] = output (fm {suffix = []}) $ term f ("season-0" ++ e) + , e /= [] = output (fm {suffix = []}) (term f $ "season-0" ++ e) ++ formatDelim where formatDelim = if rd == "-" then [OPan [EnDash]] else [OPan [Str rd]] @@ -168,3 +173,36 @@ where num = readNum s term t = maybe [] fst $ lookup ("long-ordinal-" ++ t, Long) tm + + +parseRefDate :: RefDate -> [RefDate] +parseRefDate r@(RefDate _ _ _ _ o c) + = if null o then return r + else let (a,b) = break (== '-') o + in if null b then return (parseRaw o) else [parseRaw a, parseRaw b] + where + parseRaw str = + case words $ check str of + [y'] | and (map isDigit y') -> RefDate y' [] [] [] o c + [s',y'] | and (map isDigit y') + , and (map isDigit s') -> RefDate y' s' [] [] o c + [s',y'] | s' `elem'` seasons -> RefDate y' [] (select s' seasons) [] o [] + [s',y'] | s' `elem'` months -> RefDate y' (select s' months) [] [] o c + [s',d',y'] | and (map isDigit s') + , and (map isDigit y') + , and (map isDigit d') -> RefDate y' s' [] d' o c + [s',d',y'] | s' `elem'` months + , and (map isDigit y') + , and (map isDigit d') -> RefDate y' (select s' months) [] d' o c + [s',d',y'] | s' `elem'` months + , and (map isDigit y') + , and (map isDigit d') -> RefDate y' (select s' months) [] d' o c + _ -> r + check [] = [] + check (x:xs) = if x `elem` ",/-" then ' ' : check xs else x : check xs + select x = show . (+ 1) . fromJust . elemIndex' x + elem' x = elem (map toLower $ take 3 x) + elemIndex' x = elemIndex (map toLower $ take 3 x) + + months = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"] + seasons = ["spr","sum","fal","win"] diff --git a/src/Text/CSL/Eval/Names.hs b/src/Text/CSL/Eval/Names.hs --- a/src/Text/CSL/Eval/Names.hs +++ b/src/Text/CSL/Eval/Names.hs @@ -17,12 +17,13 @@ import Control.Applicative ( (<$>) ) import Control.Monad.State -import Data.Char ( toUpper, isLower, isSpace ) -import Data.List ( nub ) +import Data.Char ( toUpper, isLower, isSpace ) +import Data.List ( nub ) +import Data.Maybe ( isJust ) import Text.CSL.Eval.Common import Text.CSL.Eval.Output -import Text.CSL.Output.Plain +import Text.CSL.Output.Plain ( (<>) ) import Text.CSL.Parser ( toRead ) import Text.CSL.Reference import Text.CSL.Style @@ -45,6 +46,7 @@ k <- getStringVar "ref-id" p <- gets (citePosition . cite . env) ops <- gets (options . env) + aus <- gets authSub r <- if s == "author" && ags /= [] && p == "subsequent" && isOptionSet "subsequent-author-substitute" ops then return $ output emptyFormatting $ @@ -54,8 +56,9 @@ fb <- agents "subsequent" s ags put st if res /= [] - then return . return . OContrib k s res fb =<< gets etal - else return [] + then let role = if aus == "author" then aus ++ "sub" else s + in return . return . OContrib k role res fb =<< gets etal + else return [] r' <- evalNames skipEdTrans xs nl d num <- gets contNum return $ if r /= [] && r' /= [] @@ -235,52 +238,61 @@ | Short <- f = return $ OName (show n) shortName disambdata fm | otherwise = return $ OName (show n) (longName given) disambdata fm where + when_ c o = if c /= [] then o else [] + addAffixes s sf ns = [Output ((OStr s (form sf) { prefix = [], suffix = [] }) : ns) $ + emptyFormatting { prefix = prefix (form sf) + , suffix = suffix (form sf)}] + form s = case filter (\(NamePart n' _) -> n' == s) np of - NamePart _ fm':_ -> fm' { prefix = [] - , suffix = [] } + NamePart _ fm':_ -> fm' _ -> emptyFormatting hasHyphen = not . null . filter (== '-') hyphen = if getOptionVal "initialize-with-hyphen" ops == "false" then getOptionVal "initialize-with" ops else filter (not . isSpace) $ getOptionVal "initialize-with" ops ++ "-" - initial x = if getOptionVal "initialize-with" ops /= [] && (not . and . map isLower $ x) - then addIn x $ getOptionVal "initialize-with" ops + initial x = if isJust (lookup "initialize-with" ops) + then if not . and . map isLower $ x + then addIn x $ getOptionVal "initialize-with" ops + else " " ++ case x of + _:'\'':[] -> x + _ -> x ++ " " else " " ++ x addIn x i = if hasHyphen x then head ( takeWhile (/= '-') x) : hyphen ++ head (tail $ dropWhile (/= '-') x) : i else head x : i - sortSepar = if getOptionVal "sort-separator" ops == [] - then [OStr "," (form "family"),OSpace] - else [OStr (getOptionVal "sort-separator" ops) (form "family")] - dropping = if droppingPart n /= [] then [OStr ( droppingPart n) (form "family")] else [] - nonDrop = if nonDroppingPart n /= [] then [OStr (nonDroppingPart n) (form "family")] else [] + sortSep g s = when_ g $ separator ++ addAffixes (g <+> s) "given" [] + separator = if getOptionVal "sort-separator" ops == [] + then oStr "," ++ [OSpace] + else oStr (getOptionVal "sort-separator" ops) suff = if commaSuffix n && nameSuffix n /= [] then suffCom else suffNoCom - when_ c o = if c /= [] then o else [] - suffCom = when_ (nameSuffix n) [OStr (", " ++ nameSuffix n) fm] - suffNoCom = when_ (nameSuffix n) [OSpace,OStr (nameSuffix n) fm] - given = when_ (givenName n) [OStr (unwords' . map initial $ givenName n) (form "given")] - givenLong = when_ (givenName n) [OStr (unwords' $ givenName n) (form "given")] - givenInit = when_ (givenName n) [OStr (unwords' . map initial $ givenName n) (form "given")] - family = when_ (familyName n) [OStr (familyName n) (form "family")] + suffCom = when_ (nameSuffix n) $ separator ++ [ OStr (nameSuffix n) fm] + suffNoCom = when_ (nameSuffix n) $ [OSpace, OStr (nameSuffix n) fm] - shortName = nonDrop <++> family + given = when_ (givenName n) . unwords . words . concatMap initial $ givenName n + givenLong = when_ (givenName n) . unwords' $ givenName n + family = familyName n + + shortName = [OStr (nonDroppingPart n <+> family) (form "family")] longName g = if isSorting m - then case getOptionVal "demote-non-dropping-particle" ops of - "never" -> nonDrop <++> family <++> dropping <++> g ++ suffCom - _ -> family <++> dropping <++> nonDrop <++> g ++ suffCom + then let firstPart = case getOptionVal "demote-non-dropping-particle" ops of + "never" -> nonDroppingPart n <+> family <+> droppingPart n + _ -> family <+> droppingPart n <+> nonDroppingPart n + in [OStr firstPart (form "family")] <++> [OStr g (form "given")] ++ suffCom else if (b && getOptionVal "name-as-sort-order" ops == "first") || getOptionVal "name-as-sort-order" ops == "all" - then case getOptionVal "demote-non-dropping-particle" ops of - "never" -> nonDrop <++> family ++ sortSepar ++ g <++> dropping ++ suffCom - "sort-only" -> nonDrop <++> family ++ sortSepar ++ g <++> dropping ++ suffCom - _ -> family ++ sortSepar ++ g <++> dropping <++> nonDrop ++ suffCom - else g <++> dropping <++> nonDrop <++> family ++ suff + then let (fam,par) = case getOptionVal "demote-non-dropping-particle" ops of + "never" -> (nonDroppingPart n <+> family, droppingPart n) + "sort-only" -> (nonDroppingPart n <+> family, droppingPart n) + _ -> (family, droppingPart n <+> nonDroppingPart n) + in OStr fam (form "family") : sortSep g par ++ suffCom + else oStr' g (form "given") <++> + addAffixes (droppingPart n <+> nonDroppingPart n <+> family) "family" suff disWithGiven = getOptionVal "disambiguate-add-givenname" ops == "true" initialize = not . null . getOptionVal "initialize-with" $ ops @@ -288,15 +300,15 @@ givenRule = getOptionVal "givenname-disambiguation-rule" ops disambdata = case () of _ | "all-names-with-initials" <- givenRule - , disWithGiven, Short <- f, initialize -> [longName givenInit] + , disWithGiven, Short <- f, initialize -> [longName given] | "primary-name-with-initials" <- givenRule - , disWithGiven, Short <- f, initialize, b -> [longName givenInit] + , disWithGiven, Short <- f, initialize, b -> [longName given] | disWithGiven, Short <- f, b - , "primary-name" <- givenRule -> [longName givenInit, longName givenLong] + , "primary-name" <- givenRule -> [longName given, longName givenLong] | disWithGiven, Short <- f - , "all-names" <- givenRule -> [longName givenInit, longName givenLong] + , "all-names" <- givenRule -> [longName given, longName givenLong] | disWithGiven, Short <- f - , "by-cite" <- givenRule -> [longName givenInit, longName givenLong] + , "by-cite" <- givenRule -> [longName given, longName givenLong] | disWithGiven, isLong -> [longName givenLong] | otherwise -> [] @@ -326,3 +338,10 @@ form g t b = return . output fm =<< g . period <$> getTerm (b && p) f t period = if stripPeriods fm then filter (/= '.') else id capital x = toUpper (head x) : (tail x) + +(<+>) :: String -> String -> String +[] <+> ss = ss +s <+> [] = s +s <+> ss = if last s == '\'' + then init s ++ "’" ++ ss + else s ++ " " ++ ss diff --git a/src/Text/CSL/Eval/Output.hs b/src/Text/CSL/Eval/Output.hs --- a/src/Text/CSL/Eval/Output.hs +++ b/src/Text/CSL/Eval/Output.hs @@ -15,6 +15,7 @@ module Text.CSL.Eval.Output where +import Text.CSL.Output.Plain import Text.CSL.Style output :: Formatting -> String -> [Output] @@ -46,7 +47,12 @@ where check x xs | ONull <- x = xs - | otherwise = x : ODel d : xs + | otherwise = let text = renderPlainStrict $ formatOutputList [x] + in if d /= [] && text /= [] + then if head d == last text && head d `elem` ".,;:!?" + then x : ODel (tail d) : xs + else x : ODel d : xs + else x : ODel d : xs noOutputError :: Output noOutputError = OStr "[CSL STYLE ERROR: reference with no printed form.]" emptyFormatting @@ -54,6 +60,13 @@ noBibDataError :: Cite -> Output noBibDataError c = OStr ("[CSL BIBLIOGRAPHIC DATA ERROR: reference " ++ show (citeId c) ++ " not found.]") emptyFormatting + +oStr :: String -> [Output] +oStr s = oStr' s emptyFormatting + +oStr' :: String -> Formatting -> [Output] +oStr' [] _ = [] +oStr' s f = [OStr s f] (<++>) :: [Output] -> [Output] -> [Output] [] <++> o = o diff --git a/src/Text/CSL/Input/Bibutils.hs b/src/Text/CSL/Input/Bibutils.hs --- a/src/Text/CSL/Input/Bibutils.hs +++ b/src/Text/CSL/Input/Bibutils.hs @@ -13,10 +13,13 @@ module Text.CSL.Input.Bibutils ( readBiblioFile + , readBiblioString + , BibFormat (..) ) where import Data.Char import System.FilePath ( takeExtension ) +import Text.CSL.Pickle import Text.CSL.Reference import Text.CSL.Input.Json import Text.CSL.Input.MODS @@ -40,8 +43,7 @@ readBiblioFile f = case getExt f of ".mods" -> readBiblioFile' f mods_in - ".bib" -> readBiblioFile' f bibtex_in - ".bbx" -> readBiblioFile' f biblatex_in + ".bib" -> readBiblioFile' f biblatex_in ".ris" -> readBiblioFile' f ris_in ".enl" -> readBiblioFile' f endnote_in ".xml" -> readBiblioFile' f endnotexml_in @@ -60,10 +62,44 @@ "citeproc-hs was not compiled with bibutils support." #endif -getExt :: String -> String -getExt = takeExtension . map toLower +data BibFormat + = Mods + | Json +#ifdef USE_BIBUTILS + | Bibtex + | BibLatex + | Ris + | Endnote + | EndnotXml + | Isi + | Medline + | Copac +#endif +readBiblioString :: BibFormat -> String -> IO [Reference] +readBiblioString b s + | Mods <- b = return $ readXmlString xpModsCollection s + | Json <- b = return $ readJsonInputString s #ifdef USE_BIBUTILS + | Bibtex <- b = go bibtex_in + | BibLatex <- b = go biblatex_in + | Ris <- b = go ris_in + | Endnote <- b = go endnote_in + | EndnotXml <- b = go endnotexml_in + | Isi <- b = go isi_in + | Medline <- b = go medline_in + | Copac <- b = go copac_in +#endif + | otherwise = error "in readBiblioString" +#ifdef USE_BIBUTILS + where + go f = withTempDir "citeproc" $ \tdir -> do + let tfile = tdir "bibutils-tmp.biblio" + writeFile tfile s + readBiblioFile' tfile f +#endif + +#ifdef USE_BIBUTILS readBiblioFile' :: FilePath -> BiblioIn -> IO [Reference] readBiblioFile' fin bin | bin == mods_in = readModsCollectionFile fin @@ -97,3 +133,6 @@ then createTempDir (num + 1) baseName else ioError e #endif + +getExt :: String -> String +getExt = takeExtension . map toLower diff --git a/src/Text/CSL/Input/Json.hs b/src/Text/CSL/Input/Json.hs --- a/src/Text/CSL/Input/Json.hs +++ b/src/Text/CSL/Input/Json.hs @@ -9,116 +9,63 @@ -- Stability : unstable -- Portability : unportable -- --- A module for reading Frank's citeproc-js testsuite. +-- A module for reading Json CSL data. -- ----------------------------------------------------------------------------- -module Text.CSL.Input.Json - ( toTest - , runTS - , test, test',test_ - , runTest - , Test (..) - , mapJSArray - , readJsonInput - ) where +module Text.CSL.Input.Json where import Control.Arrow import Control.Monad.State import Data.Generics import Data.Char (toLower, toUpper) -import Foreign -import Data.IORef import Data.List -import Data.Maybe (isJust) import Data.Ratio -import Data.Time -import System.Directory -import System.Locale -import Text.ParserCombinators.Parsec - import Text.JSON.Generic import Text.JSON.String ( runGetJSON, readJSTopType ) -import Paths_citeproc_hs ( getDataFileName ) -import Text.CSL.Output.Pandoc -import Text.CSL.Output.Plain import Text.CSL.Reference -import Text.CSL.Pickle ( readXmlString - , readXmlFile ) -import Text.CSL.Parser ( xpStyle, xpLocale, langBase) -import Text.CSL.Proc import Text.CSL.Style -import Text.Pandoc.Definition -data Test - = Test - { testMode :: String - , testInput :: [Reference] - , testCSL :: Style - , testResult :: String - , testBibSect :: BibOpts - , testCitItems :: Maybe Citations - , testCitations :: Maybe Citations - } deriving ( Show ) - -toTest :: JSValue -> Test -toTest ob = Test mode input style result bibsection cites cites' - where - getObj f = case procJSObject f ob of - JSObject o -> fromJSObject o - _ -> error "error #217" - object = getObj id - objectI = getObj editJsonInput - objectC = getObj editJsonCiteItems - - look s = case lookup s object of - Just (JSString x) -> fromJSString x - _ -> error $ "in test " ++ s ++ " section." - style = readXmlString xpStyle $ look "csl" - mode = look "mode" - result = look "result" +readJsonInput :: FilePath -> IO [Reference] +readJsonInput f = readJsonInputString `fmap` readFile f - bibsection = case lookup "bibsection" objectI of - Just (JSObject o) -> getBibOpts $ fromJSObject o - _ -> Select [] [] +readJsonInputString :: String -> [Reference] +readJsonInputString s + = let jrefs = procJSObject editJsonInput $ readJsonString s + refs r = case readJSData r of + Ok ref -> ref + Error er -> error ("readJSData: " ++ er) + in case jrefs of + JSObject o -> map (refs . snd) $ fromJSObject o + JSArray ar -> map (refs ) $ ar + _ -> error $ "citeproc: error in reading the Json bibliographic data." - cites = case lookup "citation_items" objectC of - Just (JSArray cs) -> Just $ map readCite cs - _ -> Nothing - cites' = case lookup "citations" objectC of - Just (JSArray cs) -> Just $ map readJsonCitations cs - _ -> Nothing - readCite c = case readJSData c of - Ok cite -> cite - Error er -> error ("citationItems: " ++ er) +readJsonFile :: FilePath -> IO JSValue +readJsonFile f = readJsonString `fmap` readFile f - refs r = case readJSData r of - Ok ref -> ref - Error er -> error ("readJSData: " ++ er) +readJsonString :: String -> JSValue +readJsonString = + let rmCom = unlines . filter (\x -> not (" *" `isPrefixOf` x || "/*" `isPrefixOf` x)) . lines + in either error id . runGetJSON readJSTopType . rmCom - input = case lookup "input" objectI of - Just (JSArray ar) -> map refs ar - _ -> error $ "in test input section." - getFieldValue o - | JSObject os <- o - , [("field",JSString f),("value",JSString v)] <- fromJSObject os - = (fromJSString f, fromJSString v) - | otherwise = error "bibsection: could not parse fields and values" - getBibOpts o = let getSec s = case lookup s o of - Just (JSArray ar) -> map getFieldValue ar - _ -> [] - select = getSec "select" - include = getSec "include" - exclude = getSec "exclude" - quash = getSec "quash" - in case () of - _ | select /= [] -> Select select quash - | include /= [] -> Include include quash - | exclude /= [] -> Exclude exclude quash - | quash /= [] -> Select [] quash - | otherwise -> Select [] [] +readJsonCitations :: JSValue -> [Cite] +readJsonCitations jv + | JSArray (JSObject o:_) <- jv + , Just (JSArray ar) <- lookup "citationItems" (fromJSObject o ) + , Just (JSObject o') <- lookup "properties" (fromJSObject o ) + , idx <- lookup "noteIndex" (fromJSObject o') + = map (readCite $ readCitNum $ fmap toString idx) ar + | otherwise = error ("error in reading CITATIONS:\n" ++ show jv) + where + readCitNum j + | Just (JSString js) <- j = fromJSString js + | otherwise = [] + readCite :: String -> JSValue -> Cite + readCite n c = case readJSData c of + Ok cite -> cite { citeNoteNumber = n } + Error er -> error ("citations: " ++ er) editJsonCiteItems :: (String, JSValue) -> (String, JSValue) editJsonCiteItems (s,j) @@ -192,23 +139,6 @@ ,JSObject . toJSObject $ zipDate y'] _ -> [JSObject . toJSObject $ rest []] -readJsonCitations :: JSValue -> [Cite] -readJsonCitations jv - | JSArray (JSObject o:_) <- jv - , Just (JSArray ar) <- lookup "citationItems" (fromJSObject o ) - , Just (JSObject o') <- lookup "properties" (fromJSObject o ) - , idx <- lookup "noteIndex" (fromJSObject o') - = map (readCite $ readCitNum $ fmap toString idx) ar - | otherwise = error ("error in reading CITATIONS:\n" ++ show jv) - where - readCitNum j - | Just (JSString js) <- j = fromJSString js - | otherwise = [] - readCite :: String -> JSValue -> Cite - readCite n c = case readJSData c of - Ok cite -> cite { citeNoteNumber = n } - Error er -> error ("citations: " ++ er) - toString :: JSValue -> JSValue toString x | JSString js <- x = JSString js @@ -290,186 +220,3 @@ emptyRefDate = toJSON $ RefDate [] [] [] [] [] [] emptyPerson = toJSON $ Agent [] [] [] [] [] [] False emptyCite' = toJSON $ emptyCite - -readJsonFile :: FilePath -> IO JSValue -readJsonFile f = readJsonString `fmap` readFile f - -readJsonString :: String -> JSValue -readJsonString = - let rmCom = unlines . filter (\x -> not (" *" `isPrefixOf` x || "/*" `isPrefixOf` x)) . lines - in either error id . runGetJSON readJSTopType . rmCom - -readJsonInput :: FilePath -> IO [Reference] -readJsonInput f = do - js <- readJsonFile f - let jrefs = procJSObject editJsonInput js - refs r = case readJSData r of - Ok ref -> ref - Error er -> error ("readJSData: " ++ er) - case jrefs of - JSObject o -> return . map (refs . snd) $ fromJSObject o - JSArray ar -> return . map (refs ) $ ar - _ -> error $ "citeproc: error in reading the Json bibliographic data." - -readTestFile :: FilePath -> IO JSValue -readTestFile f = do - s <- readFile f - let fields = ["CSL","RESULT","MODE","INPUT","CITATION-ITEMS","CITATIONS","BIBSECTION","BIBENTRIES"] - format = map (toLower . \x -> if x == '-' then '_' else x) - return . toJson . zip (map format fields) . map (fieldsParser s) $ fields - -toJson :: [(String,String)] -> JSValue -toJson = JSObject . toJSObject . map getIt - where - getIt (s,j) - | s `elem` ["result","csl","mode"] = (,) s . JSString $ toJSString j - | s `elem` ["bibentries"] = (,) s . JSBool $ False - | j == [] = (,) s . JSBool $ False - | otherwise = (,) s . either error id . resultToEither $ decode j - -fieldsParser :: String -> String -> String -fieldsParser s f = either (const []) id $ parse (fieldParser f) "" s - -fieldParser :: String -> Parser String -fieldParser s = manyTill anyChar (try $ fieldMarkS) >> - manyTill anyChar (try $ fieldMarkE) - where - fieldMarkS = string ">>" >> many (oneOf "= ") >> string s >> many (oneOf "= ") >> string ">>\n" - fieldMarkE = string "\n<<" >> many (oneOf "= ") >> string s >> many (oneOf "= ") >> string "<<\n" - -pandocBib :: [String] -> String -pandocBib [] = [] -pandocBib s - = "
\n" ++ - concatMap (\x -> " " ++ "
" ++ x ++ "
\n") s ++ - "
" - -pandocToHTML :: [Inline] -> String -pandocToHTML [] = [] -pandocToHTML (i:xs) - | Str s <- i = (entityToChar $ check s) ++ pandocToHTML xs - | Emph is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs - | SmallCaps is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs - | Strong is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs - | Superscript is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs - | Subscript is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs - | Space <- i = " " ++ pandocToHTML xs - | EnDash <- i = "–" ++ pandocToHTML xs - | Ellipses <- i = "…" ++ pandocToHTML xs - | Quoted t is <- i = case t of - DoubleQuote -> "“" ++ pandocToHTML is ++ "”" ++ pandocToHTML xs - SingleQuote -> "‘" ++ pandocToHTML is ++ "’" ++ pandocToHTML xs - | Link is x <- i = case snd x of - "emph" -> "" ++ - pandocToHTML is ++ "" ++ pandocToHTML xs - "strong" -> "" ++ - pandocToHTML is ++ "" ++ pandocToHTML xs - "nodecor" -> "" ++ - pandocToHTML is ++ "" ++ pandocToHTML xs - "baseline" -> "" ++ - pandocToHTML is ++ "" ++ pandocToHTML xs - _ -> pandocToHTML is ++ pandocToHTML xs - - | otherwise = [] - where - check ('&':[]) = "&" - check ('<':ys) = "<" ++ check ys - check ('>':ys) = ">" ++ check ys - check (y :ys) = y : check ys - check [] = [] - -unlines' :: [String] -> String -unlines' [] = [] -unlines' (x:[]) = x -unlines' (x:xs) = x ++ "\n" ++ unlines' xs - -localeCache :: IORef [(String, Locale)] -localeCache = unsafePerformIO $ newIORef [] - -getCachedLocale :: String -> IO [Locale] -getCachedLocale n = maybe [] return `fmap` lookup n `fmap` readIORef localeCache - -putCachedLocale :: String -> Locale -> IO () -putCachedLocale n t = modifyIORef localeCache $ \l -> (n, t) : l - -runTest :: Test -> IO (Bool,String) -runTest t = do - let locale = case styleDefaultLocale $ testCSL t of - x | length x == 2 -> maybe (error $ x ++ " doesn't seem a valid locale") - id (lookup x langBase) - | otherwise -> take 5 x - ls' <- getCachedLocale locale - ls <- case ls' of - [] -> do l <- getDataFileName ("locales/locales-" ++ locale ++ ".xml") - r <- readXmlFile xpLocale l - putCachedLocale locale r - return r - [x] -> return x - _ -> return $ Locale [] [] [] [] [] - let opts = procOpts { bibOpts = testBibSect t} - style' = testCSL t - style = style' {styleLocale = mergeLocales (styleDefaultLocale style') ls $ styleLocale style'} - cites = case (testCitations t, testCitItems t) of - (Just cs, _ ) -> cs - (_, Just cs) -> cs - _ -> [map (\r -> emptyCite { citeId = refId r }) $ testInput t] - (BD cits bib) = citeproc opts style (testInput t) cites - fixCits = if isJust (testCitations t) - then flip (zipWith $ \c n -> ">>[" ++ show n ++ "] " ++ c) ([0..] :: [Int]) - else id - output = case testMode t of - "citation" -> unlines' . fixCits . map (pandocToHTML . renderPandoc_ style) $ cits - _ -> pandocBib . map (pandocToHTML . renderPandoc_ style) $ bib - return (output == testResult t, output) - -test :: FilePath -> IO Bool -test = doTest readJsonFile 0 - -test' :: Int -> FilePath -> IO Bool -test' = doTest readJsonFile - -test_ :: Int -> FilePath -> IO Bool -test_ = doTest readTestFile - -doTest :: (FilePath -> IO JSValue) -> Int -> FilePath -> IO Bool -doTest rf v f = do - when (v >= 2) $ putStrLn f - t <- toTest `fmap` rf f - (r,o) <- runTest t - if r then return () - else do let putStrLn' = when (v >= 1) . putStrLn - putStrLn $ (tail . takeWhile (/= '.') . dropWhile (/= '_')) f ++ " failed!" - putStrLn' "++++++++++++++++++++++++++++++++++++++++++++++++++++++++" - putStrLn' $ f ++ " failed!" - putStrLn' "Expected:" - putStrLn' $ (testResult t) - putStrLn' "\nGot:" - putStrLn' $ o - when (v >= 3) $ putStrLn (show t) - putStrLn' "++++++++++++++++++++++++++++++++++++++++++++++++++++++++" - return r - -runTS :: [String] -> Int -> FilePath -> IO () -runTS gs v f = do - st <- getCurrentTime - putStrLn $ (++) (formatTime defaultTimeLocale "%H:%M:%S" st) $ " <--------------START" - dc <- sort `fmap` filter (isInfixOf ".json") `fmap` getDirectoryContents f - let groupTests = map (head . map fst &&& map snd) . - groupBy (\x y -> fst x == fst y) . - map (takeWhile (/= '_') &&& tail . dropWhile (/= '_')) - runGroups g = do putStrLn "------------------------------------------------------------" - putStrLn $ "GROUP \"" ++ fst g ++ "\" has " ++ show (length $ snd g) ++ " tests to run" - putStrLn "------------------------------------------------------------" - r' <- mapM (test' v . (++) (f ++ fst g ++ "_")) $ snd g - return r' - filterGroup = if gs /= [] then filter (flip elem gs . fst) else id - r <- mapM runGroups $ filterGroup $ groupTests dc - putStrLn " ------------------------------------------------------------" - putStrLn "| TEST SUMMARY:" - putStrLn "------------------------------------------------------------" - putStrLn $ "\t" ++ (show $ sum $ map length r) ++ " tests in " ++ (show $ length r) ++ " groups" - putStrLn $ "\t" ++ (show $ sum $ map (length . filter id ) r) ++ " successes" - putStrLn $ "\t" ++ (show $ sum $ map (length . filter not) r) ++ " failures" - et <- getCurrentTime - putStrLn $ (++) (formatTime defaultTimeLocale "%H:%M:%S" et) $ " <--------------END" - putStrLn $ "Time: " ++ show (diffUTCTime et st) 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 @@ -44,11 +44,11 @@ xpReference :: PU Reference xpReference = xpWrap ( \ ( ref - , (ck,ty,ti) + , (ck,ty,ti,i,d) ,((au,ed,tr),(re,it,pu'),(co,ce)) ,((di',pg,vl,is),(nu,sc,ch)) , (di,pu,pp) - , (ac,uri) + , ((ac,uri),no) ) -> ref { refId = ck `betterThen` take 10 (concat $ words ti) , refType = if refType ref /= NoType then refType ref else ty @@ -63,7 +63,10 @@ , publisherPlace = pp `betterThen` publisherPlace ref , containerAuthor = containerAuthor ref , url = uri + , note = no , accessed = ac + , isbn = i + , doi = d , issued = issued ref `betterThen` di `betterThen` di' , page = page ref `betterThen` pg , volume = volume ref `betterThen` vl @@ -76,18 +79,19 @@ `betterThen` (foldr (<+>) [] . map show $ pu') } , \r -> ( r - , (refId r, refType r, title r) + , (refId r, refType r, title r, isbn r, doi r) ,((author r, editor r, translator r) ,(recipient r, interviewer r, emptyAgents ) ,(composer r, collectionEditor r)) - ,((issued r, page r, volume r, issue r) - ,(number r, section r, chapterNumber r)) + ,((issued r, page r, volume r, issue r) + ,(number r, section r, chapterNumber r)) , (issued r, emptyAgents, publisherPlace r) - , (accessed r, url r) + ,((accessed r, url r), note r) )) $ xp6Tuple (xpDefault emptyReference xpRelatedItem) - (xpTriple xpCiteKey xpRefType xpTitle ) - xpAgents xpPart xpOrigin xpUrl + (xp5Tuple xpCiteKey xpRefType xpTitle xpIsbn xpDoi) + xpAgents xpPart xpOrigin + (xpPair xpUrl xpNote) xpCiteKey :: PU String xpCiteKey @@ -221,10 +225,11 @@ | otherwise = parse gn "" False where parse g s b = Agent (getGiven g) (getDrop g) (getNonDrop fn) (getFamily fn) s [] b - getDrop = unwords . filter (and . map isLower) - getGiven = filter (not . and . map isLower) - getNonDrop = getDrop . words - getFamily = unwords . getGiven . words + setInit s = if length s == 1 then s ++ "." else s + getDrop = unwords . reverse . takeWhile (and . map isLower) . reverse + getGiven = map setInit . reverse . dropWhile (and . map isLower) . reverse + getNonDrop = unwords . takeWhile (and . map isLower) . words + getFamily = unwords . dropWhile (and . map isLower) . words xpNameData :: PU ([String],String) xpNameData @@ -294,6 +299,19 @@ xpPair (xpWrap (readDate,show) $ xpDefault [] $ xpAttr "dateLastAccessed" xpText) (xpDefault [] $ xpElem "url" xpText) + +xpIsbn :: PU String +xpIsbn = xpDefault [] $ xpIdentifier "isbn" + +xpDoi :: PU String +xpDoi = xpDefault [] $ xpIdentifier "doi" + +xpIdentifier :: String -> PU String +xpIdentifier i + = xpIElem "identifier" $ xpAddFixedAttr "type" i xpText + +xpNote :: PU (String) +xpNote = xpDefault [] $ xpIElem "note" xpText readDate :: String -> [RefDate] readDate s = if takeWhile isDigit s /= [] 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 @@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards, CPP #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | @@ -16,12 +17,20 @@ module Text.CSL.Parser where -import Paths_citeproc_hs ( getDataFileName ) import Text.CSL.Reference ( readNum ) import Text.CSL.Style import Text.CSL.Pickle +#ifdef EMBED_DATA_FILES +import Data.FileEmbed +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 ( toString ) +#else +import Paths_citeproc_hs ( getDataFileName ) +import System.Directory ( doesFileExist ) +#endif import Data.Char ( isUpper, toUpper, toLower ) +import Data.Maybe ( catMaybes ) #ifdef USE_NETWORK import Network.HTTP ( getResponseBody, mkRequest, RequestMethod(..) ) @@ -49,14 +58,37 @@ l <- readLocaleFile (styleDefaultLocale s) return s { styleLocale = mergeLocales (styleDefaultLocale s) l (styleLocale s)} + +#ifdef EMBED_DATA_FILES +localeFiles :: [(FilePath, BS.ByteString)] +localeFiles = $(embedDir "locales/") +#endif + readLocaleFile :: String -> IO Locale readLocaleFile s = do +#ifdef EMBED_DATA_FILES f <- case s of + x | length x == 2 -> let fn = ("locales-" ++ + maybe (error $ x ++ " doesn't seem a valid locale") + id (lookup x langBase) ++ ".xml") + in case lookup fn localeFiles of + Just x' -> return x' + _ -> error "could not load the locale file" + | otherwise -> case lookup ("locales-" ++ take 5 x ++ ".xml") localeFiles of + Just x' -> return x' + _ -> error "could not load the locale file" + return $ readXmlString xpLocale (toString f) +#else + f <- case s of x | length x == 2 -> getDataFileName ("locales/locales-" ++ maybe (error $ x ++ " doesn't seem a valid locale") id (lookup x langBase) ++ ".xml") | otherwise -> getDataFileName ("locales/locales-" ++ take 5 x ++ ".xml") - readXmlFile xpLocale f + b <- doesFileExist f + if b + then readXmlFile xpLocale f + else readLocaleFile $ take 2 s +#endif instance XmlPickler Layout where xpickle = xpWrap (uncurry3 Layout, \(Layout f d e) -> (f,d,e)) $ @@ -290,27 +322,32 @@ xpNameFormat :: PU [Option] xpNameFormat = xpWrap (\(a,b,c,d,e) -> - filter ((/=) [] . snd) $ [("and",a) - ,("delimiter-precedes-last",b) - ,("sort-separator",c) - ,("initialize-with",d) - ,("name-as-sort-order",e)], const ([],[],[],[],[])) $ - xp5Tuple (xpAttrText' "and") - (xpAttrText' "delimiter-precedes-last") - (xpAttrText' "sort-separator") - (xpAttrText' "initialize-with") - (xpAttrText' "name-as-sort-order") + catMaybes [ checkOpt "and" a + , checkOpt "delimiter-precedes-last" b + , checkOpt "sort-separator" c + , checkOpt "initialize-with" d + , checkOpt "name-as-sort-order" e + ] , const (Nothing, Nothing, Nothing, Nothing, Nothing)) $ + xp5Tuple (getOpt "and") + (getOpt "delimiter-precedes-last") + (getOpt "sort-separator") + (getOpt "initialize-with") + (getOpt "name-as-sort-order") + where + getOpt n = xpOption $ xpAttr n xpText + checkOpt _ Nothing = Nothing + checkOpt n (Just s) = Just (n,s) xpNameAttrs :: PU NameAttrs xpNameAttrs = xpWrap (\((a,b,c,d,e),(f,g)) -> - filter ((/=) [] . snd) $ [("et-al-min",a) - ,("et-al-use-first",b) - ,("et-al-subsequent-min",c) - ,("et-al-subsequent-use-first",d) - ,("et-al-use-last",e) - ,("delimiter-precedes-et-al",f)] ++ g + filter ((/=) [] . snd) [("et-al-min",a) + ,("et-al-use-first",b) + ,("et-al-subsequent-min",c) + ,("et-al-subsequent-use-first",d) + ,("et-al-use-last",e) + ,("delimiter-precedes-et-al",f)] ++ g , const (([],[],[],[],[]),([],[]))) $ xpPair (xp5Tuple (xpAttrText' "et-al-min") (xpAttrText' "et-al-use-first") @@ -419,9 +456,10 @@ = xpWrap ( \((a,n,fm),d,sb) -> Names (words a) n fm d sb , \(Names a n fm d sb) -> ((unwords a,n,fm),d,sb)) $ xpElem "names" $ xpTriple names xpDelimiter xpickle - where names = xpTriple (xpAttrText "variable") xpName xpickle - xpName = xpChoice xpZero xpickle check - check l = if any isName l then xpLift l else xpZero + where names = xpTriple (xpAttrText "variable") xpName xpickle + xpName = xpChoice xpZero xpickle check + check [] = xpLift [Name NotSet emptyFormatting [] [] []] + check l = if any isName l then xpLift l else xpZero xpShortNames :: PU Element xpShortNames diff --git a/src/Text/CSL/Pickle.hs b/src/Text/CSL/Pickle.hs --- a/src/Text/CSL/Pickle.hs +++ b/src/Text/CSL/Pickle.hs @@ -274,7 +274,7 @@ = do t <- getCont st s <- getText t - return (Just s, dropCont st) + return (Just (unescape s), dropCont st) xpText0 :: PU String xpText0 @@ -376,6 +376,13 @@ uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f uncurry5 f (a,b,c,d,e) = f a b c d e + +unescape :: String -> String +unescape [] = [] +unescape ('&':'l':'t': ';':xs) = "<" ++ unescape xs +unescape ('&':'g':'t': ';':xs) = ">" ++ unescape xs +unescape ('&':'a':'m':'p':';':xs) = "&" ++ unescape xs +unescape (x: xs) = x : unescape xs readXmlString :: Show a => PU a -> String -> a readXmlString xp str = 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 @@ -171,8 +171,8 @@ | otherwise = formatCits id cs where formatAuth = formatOutput . localMod - formatCits g = formatOutputList . appendOutput formatting . - addAffixes f . addDelim d . map localMod . g + formatCits g = formatOutputList . appendOutput formatting . addAffixes f . + addDelim d . map (fst &&& localMod >>> uncurry format) . g formatting = if co /= [] then emptyFormatting else unsetAffixes f @@ -183,6 +183,19 @@ then flip (,) o c { authorInText = False , suppressAuthor = True } else flip (,) o c + format c x = if isNumStyle [x] + then x + else flip Output emptyFormatting $ + addCiteAff citePrefix True c ++ [x] ++ + addCiteAff citeSuffix False c + addCiteAff g x c = + case g c of + PlainText [] -> [] + PlainText p | x -> [Output (rtfParser emptyFormatting p) emptyFormatting, OSpace] + PlainText p -> [OSpace, Output (rtfParser emptyFormatting p) emptyFormatting] + PandocText [] -> [] + PandocText p | x -> [OPan p, OSpace] + PandocText p -> [OPan p] addAffixes :: Formatting -> [Output] -> [Output] addAffixes f os @@ -217,9 +230,17 @@ x -> case trim x of [] -> ONull x' -> Output x' emptyFormatting + hasOutput o + | Output [] _ <- o = [False] + | ODel _ <- o = [False] + | OSpace <- o = [False] + | ONull <- o = [False] + | otherwise = [True] trim [] = [] trim (o:os) - | Output ot f <- o = Output (trim ot) f : os + | Output ot f <- o = if or (query hasOutput ot) + then Output (trim ot) f : os + else Output ot f : trim os | ODel _ <- o = trim os | OSpace <- o = trim os | OStr x f <- o = OStr x (if isPunct (prefix f) @@ -235,6 +256,8 @@ , OSpace, o] emptyFormatting | OContrib _ "author" _ _ _ <- o = o + | OContrib _ "authorsub" + _ _ _ <- o = o | Output ot f <- o = Output (cleanOutput $ map contribOnly ot) f | otherwise = ONull rmContrib [] = [] @@ -243,9 +266,18 @@ rmContrib (o:os) | Output ot f <- o = Output (rmContrib ot) f : rmContrib os | OContrib _ "author" - _ _ _ <- o = rmContrib os - | otherwise = o : rmContrib os - isNumStyle = null . query authorOrDate + _ _ _ <- o = rmContrib os + | OContrib _ "authorsub" + _ _ _ <- o = rmContrib os + | otherwise = o : rmContrib os + getRefTerm :: TermMap -> String + getRefTerm t + | (("reference", Long), (x,_)) <- t = capitalize x + | otherwise = [] + +isNumStyle :: [Output] -> Bool +isNumStyle = null . query authorOrDate + where authorOrDate o | OContrib {} <- o = ['a'] | OYear {} <- o = ['a'] @@ -253,7 +285,3 @@ | OStr {} <- o = ['a'] | OPan {} <- o = ['a'] | otherwise = [] - getRefTerm :: TermMap -> String - getRefTerm t - | (("reference", Long), (x,_)) <- t = capitalize x - | otherwise = [] diff --git a/src/Text/CSL/Test.hs b/src/Text/CSL/Test.hs new file mode 100644 --- /dev/null +++ b/src/Text/CSL/Test.hs @@ -0,0 +1,297 @@ +{-# LANGUAGE PatternGuards, CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.CSL.Test +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- A module for reading Frank's citeproc-js testsuite. +-- +----------------------------------------------------------------------------- + +module Text.CSL.Test + ( toTest + , runTS + , test, test',test_ + , runTest + , Test (..) + ) where + +import Control.Arrow +import Control.Monad.State +import Data.Char (toLower) +import Data.List +import Data.Maybe (isJust) +import Data.Time +import System.Directory +import System.Locale + +import Text.ParserCombinators.Parsec + +import Text.JSON.Generic + +import Text.CSL.Input.Json +import Text.CSL.Output.Pandoc +import Text.CSL.Output.Plain +import Text.CSL.Reference +import Text.CSL.Pickle ( readXmlString ) +import Text.CSL.Parser ( xpStyle, xpLocale, langBase ) +import Text.CSL.Proc +import Text.CSL.Style +import Text.Pandoc.Definition +#ifdef EMBED_DATA_FILES +import qualified Data.ByteString.UTF8 as BS ( toString ) +import Text.CSL.Parser ( localeFiles ) +#else +import Foreign +import Data.IORef +import Paths_citeproc_hs ( getDataFileName ) +import Text.CSL.Parser ( readLocaleFile ) +import Text.CSL.Pickle ( readXmlFile ) +#endif + +data Test + = Test + { testMode :: String + , testInput :: [Reference] + , testCSL :: Style + , testResult :: String + , testBibSect :: BibOpts + , testCitItems :: Maybe Citations + , testCitations :: Maybe Citations + } deriving ( Show ) + +toTest :: JSValue -> Test +toTest ob = Test mode input style result bibsection cites cites' + where + getObj f = case procJSObject f ob of + JSObject o -> fromJSObject o + _ -> error "error #217" + object = getObj id + objectI = getObj editJsonInput + objectC = getObj editJsonCiteItems + + look s = case lookup s object of + Just (JSString x) -> fromJSString x + _ -> error $ "in test " ++ s ++ " section." + style = readXmlString xpStyle $ look "csl" + mode = look "mode" + result = look "result" + + bibsection = case lookup "bibsection" objectI of + Just (JSObject o) -> getBibOpts $ fromJSObject o + _ -> Select [] [] + + cites = case lookup "citation_items" objectC of + Just (JSArray cs) -> Just $ map readCite cs + _ -> Nothing + cites' = case lookup "citations" objectC of + Just (JSArray cs) -> Just $ map readJsonCitations cs + _ -> Nothing + readCite c = case readJSData c of + Ok cite -> cite + Error er -> error ("citationItems: " ++ er) + + refs r = case readJSData r of + Ok ref -> ref + Error er -> error ("readJSData: " ++ er) + + input = case lookup "input" objectI of + Just (JSArray ar) -> map refs ar + _ -> error $ "in test input section." + getFieldValue o + | JSObject os <- o + , [("field",JSString f),("value",JSString v)] <- fromJSObject os + = (fromJSString f, fromJSString v) + | otherwise = error "bibsection: could not parse fields and values" + getBibOpts o = let getSec s = case lookup s o of + Just (JSArray ar) -> map getFieldValue ar + _ -> [] + select = getSec "select" + include = getSec "include" + exclude = getSec "exclude" + quash = getSec "quash" + in case () of + _ | select /= [] -> Select select quash + | include /= [] -> Include include quash + | exclude /= [] -> Exclude exclude quash + | quash /= [] -> Select [] quash + | otherwise -> Select [] [] + +readTestFile :: FilePath -> IO JSValue +readTestFile f = do + s <- readFile f + let fields = ["CSL","RESULT","MODE","INPUT","CITATION-ITEMS","CITATIONS","BIBSECTION","BIBENTRIES"] + format = map (toLower . \x -> if x == '-' then '_' else x) + return . toJson . zip (map format fields) . map (fieldsParser s) $ fields + +toJson :: [(String,String)] -> JSValue +toJson = JSObject . toJSObject . map getIt + where + getIt (s,j) + | s `elem` ["result","csl","mode"] = (,) s . JSString $ toJSString j + | s `elem` ["bibentries"] = (,) s . JSBool $ False + | j == [] = (,) s . JSBool $ False + | otherwise = (,) s . either error id . resultToEither $ decode j + +fieldsParser :: String -> String -> String +fieldsParser s f = either (const []) id $ parse (fieldParser f) "" s + +fieldParser :: String -> Parser String +fieldParser s = manyTill anyChar (try $ fieldMarkS) >> + manyTill anyChar (try $ fieldMarkE) + where + fieldMarkS = string ">>" >> many (oneOf "= ") >> string s >> many (oneOf "= ") >> string ">>\n" + fieldMarkE = string "\n<<" >> many (oneOf "= ") >> string s >> many (oneOf "= ") >> string "<<\n" + +pandocBib :: [String] -> String +pandocBib [] = [] +pandocBib s + = "
\n" ++ + concatMap (\x -> " " ++ "
" ++ x ++ "
\n") s ++ + "
" + +pandocToHTML :: [Inline] -> String +pandocToHTML [] = [] +pandocToHTML (i:xs) + | Str s <- i = (check . entityToChar $ s) ++ pandocToHTML xs + | Emph is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs + | SmallCaps is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs + | Strong is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs + | Superscript is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs + | Subscript is <- i = "" ++ pandocToHTML is ++ "" ++ pandocToHTML xs + | Space <- i = " " ++ pandocToHTML xs + | EnDash <- i = "–" ++ pandocToHTML xs + | Ellipses <- i = "…" ++ pandocToHTML xs + | Quoted t is <- i = case t of + DoubleQuote -> "“" ++ pandocToHTML is ++ "”" ++ pandocToHTML xs + SingleQuote -> "‘" ++ pandocToHTML is ++ "’" ++ pandocToHTML xs + | Link is x <- i = case snd x of + "emph" -> "" ++ + pandocToHTML is ++ "" ++ pandocToHTML xs + "strong" -> "" ++ + pandocToHTML is ++ "" ++ pandocToHTML xs + "nodecor" -> "" ++ + pandocToHTML is ++ "" ++ pandocToHTML xs + "baseline" -> "" ++ + pandocToHTML is ++ "" ++ pandocToHTML xs + _ -> pandocToHTML is ++ pandocToHTML xs + + | otherwise = [] + where + check ('&':[]) = "&" + check ('<':ys) = "<" ++ check ys + check ('>':ys) = ">" ++ check ys + check (y :ys) = y : check ys + check [] = [] + +unlines' :: [String] -> String +unlines' [] = [] +unlines' (x:[]) = x +unlines' (x:xs) = x ++ "\n" ++ unlines' xs + +#ifndef EMBED_DATA_FILES +localeCache :: IORef [(String, Locale)] +localeCache = unsafePerformIO $ newIORef [] + +getCachedLocale :: String -> IO [Locale] +getCachedLocale n = maybe [] return `fmap` lookup n `fmap` readIORef localeCache + +putCachedLocale :: String -> Locale -> IO () +putCachedLocale n t = modifyIORef localeCache $ \l -> (n, t) : l +#endif + +runTest :: Test -> IO (Bool,String) +runTest t = do + let locale = case styleDefaultLocale $ testCSL t of + x | length x == 2 -> maybe (error $ x ++ " doesn't seem a valid locale") + id (lookup x langBase) + | otherwise -> take 5 x +#ifdef EMBED_DATA_FILES + ls <- case lookup ("locales-" ++ locale ++ ".xml") localeFiles of + Just x' -> return $ readXmlString xpLocale (BS.toString x') + _ -> return $ Locale [] [] [] [] [] +#else + ls' <- getCachedLocale locale + ls <- case ls' of + [] -> do l <- getDataFileName ("locales/locales-" ++ locale ++ ".xml") + b <- doesFileExist l + r <- if b + then readXmlFile xpLocale l + else readLocaleFile $ take 2 locale + putCachedLocale locale r + return r + [x] -> return x + _ -> return $ Locale [] [] [] [] [] +#endif + let opts = procOpts { bibOpts = testBibSect t} + style' = testCSL t + style = style' {styleLocale = mergeLocales (styleDefaultLocale style') ls $ styleLocale style'} + cites = case (testCitations t, testCitItems t) of + (Just cs, _ ) -> cs + (_, Just cs) -> cs + _ -> [map (\r -> emptyCite { citeId = refId r }) $ testInput t] + (BD cits bib) = citeproc opts style (testInput t) cites + fixCits = if isJust (testCitations t) + then flip (zipWith $ \c n -> ">>[" ++ show n ++ "] " ++ c) ([0..] :: [Int]) + else id + output = case testMode t of + "citation" -> unlines' . fixCits . map (pandocToHTML . renderPandoc_ style) $ cits + _ -> pandocBib . map (pandocToHTML . renderPandoc_ style) $ bib + return (output == testResult t, output) + +test :: FilePath -> IO Bool +test = doTest readJsonFile 0 + +test' :: Int -> FilePath -> IO Bool +test' = doTest readJsonFile + +test_ :: Int -> FilePath -> IO Bool +test_ = doTest readTestFile + +doTest :: (FilePath -> IO JSValue) -> Int -> FilePath -> IO Bool +doTest rf v f = do + when (v >= 2) $ putStrLn f + t <- toTest `fmap` rf f + (r,o) <- runTest t + if r then return () + else do let putStrLn' = when (v >= 1) . putStrLn + putStrLn $ (tail . takeWhile (/= '.') . dropWhile (/= '_')) f ++ " failed!" + putStrLn' "++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + putStrLn' $ f ++ " failed!" + putStrLn' "Expected:" + putStrLn' $ (testResult t) + putStrLn' "\nGot:" + putStrLn' $ o + when (v >= 3) $ putStrLn (show t) + putStrLn' "++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + return r + +runTS :: [String] -> Int -> FilePath -> IO () +runTS gs v f = do + st <- getCurrentTime + putStrLn $ (++) (formatTime defaultTimeLocale "%H:%M:%S" st) $ " <--------------START" + dc <- sort `fmap` filter (isInfixOf ".json") `fmap` getDirectoryContents f + let groupTests = map (head . map fst &&& map snd) . + groupBy (\x y -> fst x == fst y) . + map (takeWhile (/= '_') &&& tail . dropWhile (/= '_')) + runGroups g = do putStrLn "------------------------------------------------------------" + putStrLn $ "GROUP \"" ++ fst g ++ "\" has " ++ show (length $ snd g) ++ " tests to run" + putStrLn "------------------------------------------------------------" + r' <- mapM (test' v . (++) (f ++ fst g ++ "_")) $ snd g + return r' + filterGroup = if gs /= [] then filter (flip elem gs . fst) else id + r <- mapM runGroups $ filterGroup $ groupTests dc + putStrLn " ------------------------------------------------------------" + putStrLn "| TEST SUMMARY:" + putStrLn "------------------------------------------------------------" + putStrLn $ "\t" ++ (show $ sum $ map length r) ++ " tests in " ++ (show $ length r) ++ " groups" + putStrLn $ "\t" ++ (show $ sum $ map (length . filter id ) r) ++ " successes" + putStrLn $ "\t" ++ (show $ sum $ map (length . filter not) r) ++ " failures" + et <- getCurrentTime + putStrLn $ (++) (formatTime defaultTimeLocale "%H:%M:%S" et) $ " <--------------END" + putStrLn $ "Time: " ++ show (diffUTCTime et st) diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -1,5 +1,5 @@ import System.Environment -import Text.CSL.Input.Json +import Text.CSL.Test -- a dir with a final slash testDir = "citeproc-test/processor-tests/machines/"