{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Input.Bibtex
-- Copyright   :  (c) John MacFarlane
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  John MacFarlane <fiddlosopher@gmail.com>
-- Stability   :  unstable-- Portability :  unportable
--
-----------------------------------------------------------------------------

module Text.Pandoc.Citeproc.BibTeX
    ( Variant(..)
    , readBibtexString
    , writeBibtexString
    )
    where

import Text.Pandoc.Definition
import Text.Pandoc.Builder as B
import Text.Pandoc.Readers.LaTeX (readLaTeX)
import Text.Pandoc.Extensions (Extension(..), extensionsFromList)
import Text.Pandoc.Options (ReaderOptions(..), WriterOptions)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Shared (stringify)
import Text.Pandoc.Writers.LaTeX (writeLaTeX)
import Text.Pandoc.Class (runPure)
import qualified Text.Pandoc.Walk       as Walk
import Citeproc.Types
import Citeproc.Pandoc ()
import Text.Pandoc.Citeproc.Util (toIETF)
import Text.Pandoc.Citeproc.Data (biblatexStringMap)
import Data.Default
import           Data.Text              (Text)
import qualified Data.Text              as T
import qualified Data.Map               as Map
import           Data.Maybe
import           Text.Pandoc.Parsing hiding ((<|>), many)
import           Control.Applicative
import           Data.List.Split        (splitOn, splitWhen, wordsBy)
import           Control.Monad.RWS      hiding ((<>))
import qualified Data.Sequence          as Seq
import           Data.Char              (isAlphaNum, isDigit, isLetter,
                                         isUpper, toLower, toUpper,
                                         isLower, isPunctuation)
import           Data.List              (foldl', intercalate, intersperse)
import           Safe                   (readMay)
import           Text.Printf            (printf)
import           Text.DocLayout         (literal, hsep, nest, hang, Doc(..),
                                         braces, ($$), cr)

data Variant = Bibtex | Biblatex
  deriving (Int -> Variant -> ShowS
[Variant] -> ShowS
Variant -> String
(Int -> Variant -> ShowS)
-> (Variant -> String) -> ([Variant] -> ShowS) -> Show Variant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variant] -> ShowS
$cshowList :: [Variant] -> ShowS
show :: Variant -> String
$cshow :: Variant -> String
showsPrec :: Int -> Variant -> ShowS
$cshowsPrec :: Int -> Variant -> ShowS
Show, Variant -> Variant -> Bool
(Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool) -> Eq Variant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variant -> Variant -> Bool
$c/= :: Variant -> Variant -> Bool
== :: Variant -> Variant -> Bool
$c== :: Variant -> Variant -> Bool
Eq, Eq Variant
Eq Variant
-> (Variant -> Variant -> Ordering)
-> (Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool)
-> (Variant -> Variant -> Variant)
-> (Variant -> Variant -> Variant)
-> Ord Variant
Variant -> Variant -> Bool
Variant -> Variant -> Ordering
Variant -> Variant -> Variant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Variant -> Variant -> Variant
$cmin :: Variant -> Variant -> Variant
max :: Variant -> Variant -> Variant
$cmax :: Variant -> Variant -> Variant
>= :: Variant -> Variant -> Bool
$c>= :: Variant -> Variant -> Bool
> :: Variant -> Variant -> Bool
$c> :: Variant -> Variant -> Bool
<= :: Variant -> Variant -> Bool
$c<= :: Variant -> Variant -> Bool
< :: Variant -> Variant -> Bool
$c< :: Variant -> Variant -> Bool
compare :: Variant -> Variant -> Ordering
$ccompare :: Variant -> Variant -> Ordering
$cp1Ord :: Eq Variant
Ord)

-- | Parse BibTeX or BibLaTeX into a list of 'Reference's.
readBibtexString :: ToSources a
                 => Variant           -- ^ bibtex or biblatex
                 -> Locale            -- ^ Locale
                 -> (Text -> Bool)    -- ^ Filter on citation ids
                 -> a                 -- ^ bibtex/biblatex text
                 -> Either ParseError [Reference Inlines]
readBibtexString :: Variant
-> Locale
-> (Text -> Bool)
-> a
-> Either ParseError [Reference Inlines]
readBibtexString Variant
variant Locale
locale Text -> Bool
idpred a
contents = do
  case Parsec Sources (Lang, StringMap) [Reference Inlines]
-> (Lang, StringMap)
-> String
-> Sources
-> Either ParseError [Reference Inlines]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser (((Variant -> [Item] -> [Item]
resolveCrossRefs Variant
variant ([Item] -> [Item])
-> ParsecT Sources (Lang, StringMap) Identity [Item]
-> ParsecT Sources (Lang, StringMap) Identity [Item]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources (Lang, StringMap) Identity [Item]
bibEntries) ParsecT Sources (Lang, StringMap) Identity [Item]
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity [Item]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources (Lang, StringMap) Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) ParsecT Sources (Lang, StringMap) Identity [Item]
-> ([Item] -> Parsec Sources (Lang, StringMap) [Reference Inlines])
-> Parsec Sources (Lang, StringMap) [Reference Inlines]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                   (Item
 -> ParsecT Sources (Lang, StringMap) Identity (Reference Inlines))
-> [Item] -> Parsec Sources (Lang, StringMap) [Reference Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Locale
-> Variant
-> Item
-> ParsecT Sources (Lang, StringMap) Identity (Reference Inlines)
itemToReference Locale
locale Variant
variant) ([Item] -> Parsec Sources (Lang, StringMap) [Reference Inlines])
-> ([Item] -> [Item])
-> [Item]
-> Parsec Sources (Lang, StringMap) [Reference Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      (Item -> Bool) -> [Item] -> [Item]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Item
item -> Text -> Bool
idpred (Item -> Text
identifier Item
item) Bool -> Bool -> Bool
&&
                                        Item -> Text
entryType Item
item Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"xdata"))
           (Lang -> Maybe Lang -> Lang
forall a. a -> Maybe a -> a
fromMaybe Lang
defaultLang (Maybe Lang -> Lang) -> Maybe Lang -> Lang
forall a b. (a -> b) -> a -> b
$ Locale -> Maybe Lang
localeLanguage Locale
locale, StringMap
forall k a. Map k a
Map.empty)
           String
"" (a -> Sources
forall a. ToSources a => a -> Sources
toSources a
contents) of
          Left ParseError
err -> ParseError -> Either ParseError [Reference Inlines]
forall a b. a -> Either a b
Left ParseError
err
          Right [Reference Inlines]
xs -> [Reference Inlines] -> Either ParseError [Reference Inlines]
forall (m :: * -> *) a. Monad m => a -> m a
return [Reference Inlines]
xs

-- | Write BibTeX or BibLaTeX given given a 'Reference'.
writeBibtexString :: WriterOptions       -- ^ options (for writing LaTex)
                  -> Variant             -- ^ bibtex or biblatex
                  -> Maybe Lang          -- ^ Language
                  -> Reference Inlines   -- ^ Reference to write
                  -> Doc Text
writeBibtexString :: WriterOptions
-> Variant -> Maybe Lang -> Reference Inlines -> Doc Text
writeBibtexString WriterOptions
opts Variant
variant Maybe Lang
mblang Reference Inlines
ref =
  Doc Text
"@" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
bibtexType Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ItemId -> Text
unItemId (Reference Inlines -> ItemId
forall a. Reference a -> ItemId
referenceId Reference Inlines
ref)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
","
  Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 ([Text] -> Doc Text
renderFields [Text]
fs)
  Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"}" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr

 where
  bibtexType :: Doc Text
bibtexType =
    case Reference Inlines -> Text
forall a. Reference a -> Text
referenceType Reference Inlines
ref of
      Text
"article-magazine"  -> Doc Text
"article"
      Text
"article-newspaper" -> Doc Text
"article"
      Text
"article-journal"   -> Doc Text
"article"
      Text
"book"              -> Doc Text
"book"
      Text
"pamphlet"          -> Doc Text
"booklet"
      Text
"dataset" | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"dataset"
      Text
"webpage" | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"online"
      Text
"chapter"           -> case Text -> Maybe (Val Inlines)
getVariable Text
"editor" of
                                Just Val Inlines
_  -> Doc Text
"incollection"
                                Maybe (Val Inlines)
Nothing -> Doc Text
"inbook"
      Text
"entry-encyclopedia" | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"inreference"
                           | Bool
otherwise -> Doc Text
"inbook"
      Text
"paper-conference"  -> Doc Text
"inproceedings"
      Text
"thesis" -> case Text -> Maybe Text
getVariableAsText Text
"genre" of
                    Just Text
"mathesis" -> Doc Text
"mastersthesis"
                    Maybe Text
_               -> Doc Text
"phdthesis"
      Text
"patent"            | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"patent"
      Text
"report"            | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"report"
                          | Bool
otherwise -> Doc Text
"techreport"
      Text
"speech"            -> Doc Text
"unpublished"
      Text
"manuscript"        -> Doc Text
"unpublished"
      Text
"graphic"           | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"artwork"
      Text
"song"              | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"music"
      Text
"legal_case"        | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"jurisdictionN"
      Text
"legislation"       | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"legislation"
      Text
"treaty"            | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"legal"
      Text
"personal_communication" | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"letter"
      Text
"motion_picture"    | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"movie"
      Text
"review"             | Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Biblatex -> Doc Text
"review"
      Text
_                   -> Doc Text
"misc"

  mbSubtype :: Maybe Text
mbSubtype =
    case Reference Inlines -> Text
forall a. Reference a -> Text
referenceType Reference Inlines
ref of
      Text
"article-magazine"  -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"magazine"
      Text
"article-newspaper" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"newspaper"
      Text
_ -> Maybe Text
forall a. Maybe a
Nothing

  fs :: [Text]
fs =
    case Variant
variant of
      Variant
Biblatex ->
           [ Text
"author"
           , Text
"editor"
           , Text
"translator"
           , Text
"publisher"
           , Text
"title"
           , Text
"booktitle"
           , Text
"journal"
           , Text
"series"
           , Text
"edition"
           , Text
"volume"
           , Text
"volumes"
           , Text
"number"
           , Text
"pages"
           , Text
"date"
           , Text
"eventdate"
           , Text
"urldate"
           , Text
"address"
           , Text
"url"
           , Text
"doi"
           , Text
"isbn"
           , Text
"issn"
           , Text
"type"
           , Text
"entrysubtype"
           , Text
"note"
           , Text
"langid"
           , Text
"abstract"
           , Text
"keywords"
           , Text
"annote"
           ]
      Variant
Bibtex ->
           [ Text
"author"
           , Text
"editor"
           , Text
"translator"
           , Text
"publisher"
           , Text
"title"
           , Text
"booktitle"
           , Text
"journal"
           , Text
"series"
           , Text
"edition"
           , Text
"volume"
           , Text
"number"
           , Text
"pages"
           , Text
"year"
           , Text
"month"
           , Text
"address"
           , Text
"type"
           , Text
"note"
           , Text
"annote"
           ]

  valToInlines :: Val Inlines -> Inlines
valToInlines (TextVal Text
t) = Text -> Inlines
B.text Text
t
  valToInlines (FancyVal Inlines
ils) = Inlines
ils
  valToInlines (NumVal Int
n) = Text -> Inlines
B.text (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n)
  valToInlines (NamesVal [Name]
names) =
    [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.text Text
"and" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space)
            ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ (Name -> Inlines) -> [Name] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Inlines
renderName [Name]
names
  valToInlines (DateVal Date
date) = Text -> Inlines
B.text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$
    case Date -> Maybe Text
dateLiteral Date
date of
      Just Text
t  -> Text
t
      Maybe Text
Nothing -> Text -> [Text] -> Text
T.intercalate Text
"/" ((DateParts -> Text) -> [DateParts] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DateParts -> Text
renderDatePart (Date -> [DateParts]
dateParts Date
date)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    (if Date -> Bool
dateCirca Date
date then Text
"~" else Text
forall a. Monoid a => a
mempty)

  renderDatePart :: DateParts -> Text
renderDatePart (DateParts [Int]
xs) = Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                                    (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d") [Int]
xs

  renderName :: Name -> Inlines
renderName Name
name =
    case Name -> Maybe Text
nameLiteral Name
name of
      Just Text
t  -> Text -> Inlines
B.text Text
t
      Maybe Text
Nothing -> [Maybe Text] -> Inlines
spacedMaybes
                  [ Name -> Maybe Text
nameNonDroppingParticle Name
name
                  , Name -> Maybe Text
nameFamily Name
name
                  , if Name -> Bool
nameCommaSuffix Name
name
                        then (Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe Text
nameSuffix Name
name
                        else Name -> Maybe Text
nameSuffix Name
name ]
                  Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                  [Maybe Text] -> Inlines
spacedMaybes
                   [ (Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe Text
nameGiven Name
name,
                     Name -> Maybe Text
nameDroppingParticle Name
name ]

  mblang' :: Maybe Lang
mblang' = case Text -> Maybe Text
getVariableAsText Text
"language" of
              Just Text
l  -> (String -> Maybe Lang)
-> (Lang -> Maybe Lang) -> Either String Lang -> Maybe Lang
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Lang -> String -> Maybe Lang
forall a b. a -> b -> a
const Maybe Lang
forall a. Maybe a
Nothing) Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Either String Lang -> Maybe Lang)
-> Either String Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Either String Lang
parseLang Text
l
              Maybe Text
Nothing -> Maybe Lang
mblang

  titlecase :: Inlines -> Inlines
titlecase = case Maybe Lang
mblang' of
                Just Lang
lang | Lang -> Text
langLanguage Lang
lang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"en"
                                   -> Inlines -> Inlines
titlecase'
                Maybe Lang
Nothing            -> Inlines -> Inlines
titlecase'
                Maybe Lang
_                  ->
                  case Variant
variant of
                    Variant
Bibtex         -> Attr -> Inlines -> Inlines
B.spanWith Attr
nullAttr
                     -- BibTex lacks a language field, so we wrap non-English
                     -- titles in {} to protect case.
                    Variant
Biblatex       -> Inlines -> Inlines
forall a. a -> a
id

  titlecase' :: Inlines -> Inlines
titlecase' = Maybe Lang -> TextCase -> Inlines -> Inlines
forall a. CiteprocOutput a => Maybe Lang -> TextCase -> a -> a
addTextCase Maybe Lang
mblang' TextCase
TitleCase (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (\Inlines
ils -> [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList
               (case Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
ils of
                  Str Text
t : [Inline]
xs -> Text -> Inline
Str Text
t Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
Walk.walk Inline -> Inline
spanAroundCapitalizedWords [Inline]
xs
                  [Inline]
xs         -> (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
Walk.walk Inline -> Inline
spanAroundCapitalizedWords [Inline]
xs))

  -- protect capitalized words when we titlecase
  spanAroundCapitalizedWords :: Inline -> Inline
spanAroundCapitalizedWords (Str Text
t)
    | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isLetter Char
c)) Text
t) =
       Attr -> [Inline] -> Inline
Span (Text
"",[Text
"nocase"],[]) [Text -> Inline
Str Text
t]
  spanAroundCapitalizedWords Inline
x = Inline
x

  spacedMaybes :: [Maybe Text] -> Inlines
spacedMaybes = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Maybe Text] -> [Inlines]) -> [Maybe Text] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space ([Inlines] -> [Inlines])
-> ([Maybe Text] -> [Inlines]) -> [Maybe Text] -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Maybe Inlines) -> [Maybe Text] -> [Inlines]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Text -> Inlines) -> Maybe Text -> Maybe Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Inlines
B.text)

  toLaTeX :: Inlines -> Maybe (Doc Text)
toLaTeX Inlines
x =
    case PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure (WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX WriterOptions
opts (Pandoc -> PandocPure Text) -> Pandoc -> PandocPure Text
forall a b. (a -> b) -> a -> b
$ Blocks -> Pandoc
doc (Inlines -> Blocks
B.plain Inlines
x)) of
           Left PandocError
_  -> Maybe (Doc Text)
forall a. Maybe a
Nothing
           Right Text
t -> Doc Text -> Maybe (Doc Text)
forall a. a -> Maybe a
Just (Doc Text -> Maybe (Doc Text)) -> Doc Text -> Maybe (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ([Doc Text] -> Doc Text)
-> ([Text] -> [Doc Text]) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Doc Text) -> [Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
t

  renderField :: Text -> Maybe (Doc Text)
  renderField :: Text -> Maybe (Doc Text)
renderField Text
name =
    (((Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
name) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
" = " (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces)
      (Doc Text -> Doc Text) -> Maybe (Doc Text) -> Maybe (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Doc Text)
getContentsFor Text
name

  getVariable :: Text -> Maybe (Val Inlines)
getVariable Text
v = Variable -> Reference Inlines -> Maybe (Val Inlines)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable (Text -> Variable
toVariable Text
v) Reference Inlines
ref

  getVariableAsText :: Text -> Maybe Text
getVariableAsText Text
v = (Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inlines -> Text)
-> (Val Inlines -> Inlines) -> Val Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines) (Val Inlines -> Text) -> Maybe (Val Inlines) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Val Inlines)
getVariable Text
v

  getYear :: Val a -> Maybe (Doc Text)
getYear Val a
val =
    case Val a
val of
       DateVal Date
date ->
         case Date -> Maybe Text
dateLiteral Date
date of
           Just Text
t -> Inlines -> Maybe (Doc Text)
toLaTeX (Text -> Inlines
B.text Text
t)
           Maybe Text
Nothing ->
             case Date -> [DateParts]
dateParts Date
date of
               [DateParts (Int
y1:[Int]
_), DateParts (Int
y2:[Int]
_)] ->
                 Doc Text -> Maybe (Doc Text)
forall a. a -> Maybe a
Just (Doc Text -> Maybe (Doc Text)) -> Doc Text -> Maybe (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (String -> Text
T.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04d" Int
y1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                        String -> Text
T.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04d" Int
y2))
               [DateParts (Int
y1:[Int]
_)] ->
                 Doc Text -> Maybe (Doc Text)
forall a. a -> Maybe a
Just (Doc Text -> Maybe (Doc Text)) -> Doc Text -> Maybe (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (String -> Text
T.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04d" Int
y1))
               [DateParts]
_ -> Maybe (Doc Text)
forall a. Maybe a
Nothing
       Val a
_ -> Maybe (Doc Text)
forall a. Maybe a
Nothing

  toMonth :: a -> Text
toMonth a
1 = Text
"jan"
  toMonth a
2 = Text
"feb"
  toMonth a
3 = Text
"mar"
  toMonth a
4 = Text
"apr"
  toMonth a
5 = Text
"may"
  toMonth a
6 = Text
"jun"
  toMonth a
7 = Text
"jul"
  toMonth a
8 = Text
"aug"
  toMonth a
9 = Text
"sep"
  toMonth a
10 = Text
"oct"
  toMonth a
11 = Text
"nov"
  toMonth a
12 = Text
"dec"
  toMonth a
x  = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x

  getMonth :: Val a -> Maybe (Doc Text)
getMonth Val a
val =
    case Val a
val of
       DateVal Date
date ->
         case Date -> [DateParts]
dateParts Date
date of
           [DateParts (Int
_:Int
m1:[Int]
_), DateParts (Int
_:Int
m2:[Int]
_)] ->
             Doc Text -> Maybe (Doc Text)
forall a. a -> Maybe a
Just (Doc Text -> Maybe (Doc Text)) -> Doc Text -> Maybe (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. (Eq a, Num a, Show a) => a -> Text
toMonth Int
m1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. (Eq a, Num a, Show a) => a -> Text
toMonth Int
m2)
           [DateParts (Int
_:Int
m1:[Int]
_)] -> Doc Text -> Maybe (Doc Text)
forall a. a -> Maybe a
Just (Doc Text -> Maybe (Doc Text)) -> Doc Text -> Maybe (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. (Eq a, Num a, Show a) => a -> Text
toMonth Int
m1)
           [DateParts]
_ -> Maybe (Doc Text)
forall a. Maybe a
Nothing
       Val a
_ -> Maybe (Doc Text)
forall a. Maybe a
Nothing

  getContentsFor :: Text -> Maybe (Doc Text)
  getContentsFor :: Text -> Maybe (Doc Text)
getContentsFor Text
"type" =
    Text -> Maybe Text
getVariableAsText Text
"genre" Maybe Text -> (Text -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
       \case
          Text
"mathesis"  -> Doc Text -> Maybe (Doc Text)
forall a. a -> Maybe a
Just Doc Text
"mastersthesis"
          Text
"phdthesis" -> Doc Text -> Maybe (Doc Text)
forall a. a -> Maybe a
Just Doc Text
"phdthesis"
          Text
_           -> Maybe (Doc Text)
forall a. Maybe a
Nothing
  getContentsFor Text
"entrysubtype" = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Maybe Text -> Maybe (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mbSubtype
  getContentsFor Text
"journal"
    | Doc Text
bibtexType Doc Text -> [Doc Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Doc Text
"article", Doc Text
"periodical", Doc Text
"suppperiodical", Doc Text
"review"]
      = Text -> Maybe (Val Inlines)
getVariable Text
"container-title" Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
    | Bool
otherwise = Maybe (Doc Text)
forall a. Maybe a
Nothing
  getContentsFor Text
"booktitle"
    | Doc Text
bibtexType Doc Text -> [Doc Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
       [Doc Text
"inbook",Doc Text
"incollection",Doc Text
"inproceedings",Doc Text
"inreference",Doc Text
"bookinbook"]
    = (Text -> Maybe (Val Inlines)
getVariable Text
"volume-title" Maybe (Val Inlines) -> Maybe (Val Inlines) -> Maybe (Val Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe (Val Inlines)
getVariable Text
"container-title")
                               Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
    | Bool
otherwise = Maybe (Doc Text)
forall a. Maybe a
Nothing
  getContentsFor Text
"series" = Text -> Maybe (Val Inlines)
getVariable Text
"collection-title"
                               Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
  getContentsFor Text
"address" = Text -> Maybe (Val Inlines)
getVariable Text
"publisher-place"
                               Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
  getContentsFor Text
"date"  = Text -> Maybe (Val Inlines)
getVariable Text
"issued" Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
  getContentsFor Text
"eventdate" = Text -> Maybe (Val Inlines)
getVariable Text
"event-date" Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
  getContentsFor Text
"urldate"  = Text -> Maybe (Val Inlines)
getVariable Text
"accessed" Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
  getContentsFor Text
"year"  = Text -> Maybe (Val Inlines)
getVariable Text
"issued" Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val Inlines -> Maybe (Doc Text)
forall a. Val a -> Maybe (Doc Text)
getYear
  getContentsFor Text
"month"  = Text -> Maybe (Val Inlines)
getVariable Text
"issued" Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val Inlines -> Maybe (Doc Text)
forall a. Val a -> Maybe (Doc Text)
getMonth
  getContentsFor Text
"pages"  = Text -> Maybe (Val Inlines)
getVariable Text
"page" Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
  getContentsFor Text
"langid"  = Text -> Maybe (Val Inlines)
getVariable Text
"language" Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
  getContentsFor Text
"number" = (Text -> Maybe (Val Inlines)
getVariable Text
"number"
                         Maybe (Val Inlines) -> Maybe (Val Inlines) -> Maybe (Val Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe (Val Inlines)
getVariable Text
"collection-number"
                         Maybe (Val Inlines) -> Maybe (Val Inlines) -> Maybe (Val Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe (Val Inlines)
getVariable Text
"issue") Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines

  getContentsFor Text
x = Text -> Maybe (Val Inlines)
getVariable Text
x Maybe (Val Inlines)
-> (Val Inlines -> Maybe (Doc Text)) -> Maybe (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    if Text -> Bool
forall a. (Eq a, IsString a) => a -> Bool
isURL Text
x
       then Doc Text -> Maybe (Doc Text)
forall a. a -> Maybe a
Just (Doc Text -> Maybe (Doc Text))
-> (Val Inlines -> Doc Text) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text)
-> (Val Inlines -> Text) -> Val Inlines -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inlines -> Text)
-> (Val Inlines -> Inlines) -> Val Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val Inlines -> Inlines
valToInlines
       else Inlines -> Maybe (Doc Text)
toLaTeX (Inlines -> Maybe (Doc Text))
-> (Val Inlines -> Inlines) -> Val Inlines -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"title"
                then Inlines -> Inlines
titlecase
                else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines)
-> (Val Inlines -> Inlines) -> Val Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Val Inlines -> Inlines
valToInlines

  isURL :: a -> Bool
isURL a
x = a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"url",a
"doi",a
"issn",a
"isbn"]

  renderFields :: [Text] -> Doc Text
renderFields = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> ([Text] -> [Doc Text]) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Doc Text
"," Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr) ([Doc Text] -> [Doc Text])
-> ([Text] -> [Doc Text]) -> [Text] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Doc Text)) -> [Text] -> [Doc Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe (Doc Text)
renderField

defaultLang :: Lang
defaultLang :: Lang
defaultLang = Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> [(Text, [(Text, Text)])]
-> [Text]
-> Lang
Lang Text
"en" Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"US") [] [] []

-- a map of bibtex "string" macros
type StringMap = Map.Map Text Text

type BibParser = Parser Sources (Lang, StringMap)

data Item = Item{ Item -> Text
identifier :: Text
                , Item -> SourcePos
sourcePos  :: SourcePos
                , Item -> Text
entryType  :: Text
                , Item -> StringMap
fields     :: Map.Map Text Text
                }
                deriving (Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show, Eq Item
Eq Item
-> (Item -> Item -> Ordering)
-> (Item -> Item -> Bool)
-> (Item -> Item -> Bool)
-> (Item -> Item -> Bool)
-> (Item -> Item -> Bool)
-> (Item -> Item -> Item)
-> (Item -> Item -> Item)
-> Ord Item
Item -> Item -> Bool
Item -> Item -> Ordering
Item -> Item -> Item
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Item -> Item -> Item
$cmin :: Item -> Item -> Item
max :: Item -> Item -> Item
$cmax :: Item -> Item -> Item
>= :: Item -> Item -> Bool
$c>= :: Item -> Item -> Bool
> :: Item -> Item -> Bool
$c> :: Item -> Item -> Bool
<= :: Item -> Item -> Bool
$c<= :: Item -> Item -> Bool
< :: Item -> Item -> Bool
$c< :: Item -> Item -> Bool
compare :: Item -> Item -> Ordering
$ccompare :: Item -> Item -> Ordering
$cp1Ord :: Eq Item
Ord, Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq)

itemToReference :: Locale -> Variant -> Item -> BibParser (Reference Inlines)
itemToReference :: Locale
-> Variant
-> Item
-> ParsecT Sources (Lang, StringMap) Identity (Reference Inlines)
itemToReference Locale
locale Variant
variant Item
item = do
  SourcePos -> ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (Item -> SourcePos
sourcePos Item
item)
  Item
-> Bib (Reference Inlines)
-> ParsecT Sources (Lang, StringMap) Identity (Reference Inlines)
forall a. Item -> Bib a -> BibParser a
bib Item
item (Bib (Reference Inlines)
 -> ParsecT Sources (Lang, StringMap) Identity (Reference Inlines))
-> Bib (Reference Inlines)
-> ParsecT Sources (Lang, StringMap) Identity (Reference Inlines)
forall a b. (a -> b) -> a -> b
$ do
    let lang :: Lang
lang = Lang -> Maybe Lang -> Lang
forall a. a -> Maybe a -> a
fromMaybe Lang
defaultLang (Maybe Lang -> Lang) -> Maybe Lang -> Lang
forall a b. (a -> b) -> a -> b
$ Locale -> Maybe Lang
localeLanguage Locale
locale
    (BibState -> BibState) -> RWST Item () BibState BibParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((BibState -> BibState) -> RWST Item () BibState BibParser ())
-> (BibState -> BibState) -> RWST Item () BibState BibParser ()
forall a b. (a -> b) -> a -> b
$ \BibState
st -> BibState
st{ localeLang :: Lang
localeLang = Lang
lang,
                        untitlecase :: Bool
untitlecase = Lang -> Text
langLanguage Lang
lang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"en" }

    Text
id' <- (Item -> Text) -> RWST Item () BibState BibParser Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Item -> Text
identifier
    Maybe Text
otherIds <- (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"ids")
                  RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    (Text
reftype, Maybe Text
genre) <- Bib (Text, Maybe Text)
getTypeAndGenre
    -- hyphenation:
    let getLangId :: RWST Item () BibState BibParser Text
getLangId = do
             Text
langid <- Text -> Text
T.strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"langid"
             Text
idopts <- Text -> Text
T.strip (Text -> Text) -> (Inlines -> Text) -> Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Inlines -> Text) -> Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inlines -> Text)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                           Text -> RWST Item () BibState BibParser Inlines
getField Text
"langidopts" RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
             case (Text
langid, Text
idopts) of
                  (Text
"english",Text
"variant=british")    -> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"british"
                  (Text
"english",Text
"variant=american")   -> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"american"
                  (Text
"english",Text
"variant=us")         -> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"american"
                  (Text
"english",Text
"variant=usmax")      -> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"american"
                  (Text
"english",Text
"variant=uk")         -> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"british"
                  (Text
"english",Text
"variant=australian") -> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"australian"
                  (Text
"english",Text
"variant=newzealand") -> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"newzealand"
                  (Text
x,Text
_)                            -> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
    Maybe Text
hyphenation <- (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toIETF (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     (RWST Item () BibState BibParser Text
getLangId RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Text
getRawField Text
"hyphenation"))
                  RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    (BibState -> BibState) -> RWST Item () BibState BibParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((BibState -> BibState) -> RWST Item () BibState BibParser ())
-> (BibState -> BibState) -> RWST Item () BibState BibParser ()
forall a b. (a -> b) -> a -> b
$ \BibState
s -> BibState
s{ untitlecase :: Bool
untitlecase = BibState -> Bool
untitlecase BibState
s Bool -> Bool -> Bool
&&
                                      case Maybe Text
hyphenation of
                                        Just Text
x -> Text
"en-" Text -> Text -> Bool
`T.isPrefixOf` Text
x
                                        Maybe Text
_ -> Bool
True }


    [(Text, Text)]
opts <- (Text -> [(Text, Text)]
parseOptions (Text -> [(Text, Text)])
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"options") RWST Item () BibState BibParser [(Text, Text)]
-> RWST Item () BibState BibParser [(Text, Text)]
-> RWST Item () BibState BibParser [(Text, Text)]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [(Text, Text)] -> RWST Item () BibState BibParser [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    Text
et <- (Item -> Text) -> RWST Item () BibState BibParser Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Item -> Text
entryType

    -- titles
    let isArticle :: Bool
isArticle = Text
et Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
                     [Text
"article", Text
"periodical", Text
"suppperiodical", Text
"review"]
    let isPeriodical :: Bool
isPeriodical = Text
et Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"periodical"
    let isChapterlike :: Bool
isChapterlike = Text
et Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
           [Text
"inbook",Text
"incollection",Text
"inproceedings",Text
"inreference",Text
"bookinbook"]

    let getFieldMaybe :: Text -> RWST Item () BibState BibParser (Maybe Inlines)
getFieldMaybe Text
f = (Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField Text
f) RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing

    -- names
    let getNameList' :: Text -> RWST Item () BibState BibParser (Maybe [Name])
getNameList' Text
f = [Name] -> Maybe [Name]
forall a. a -> Maybe a
Just ([Name] -> Maybe [Name])
-> RWST Item () BibState BibParser [Name]
-> RWST Item () BibState BibParser (Maybe [Name])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         [(Text, Text)] -> Text -> RWST Item () BibState BibParser [Name]
getNameList ((Text
"bibtex", case Variant
variant of
                                      Variant
Bibtex   -> Text
"true"
                                      Variant
Biblatex -> Text
"false") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
opts) Text
f

    Maybe [Name]
author' <- Text -> RWST Item () BibState BibParser (Maybe [Name])
getNameList' Text
"author" RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Name] -> RWST Item () BibState BibParser (Maybe [Name])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Name]
forall a. Maybe a
Nothing
    Maybe [Name]
containerAuthor' <- Text -> RWST Item () BibState BibParser (Maybe [Name])
getNameList' Text
"bookauthor" RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Name] -> RWST Item () BibState BibParser (Maybe [Name])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Name]
forall a. Maybe a
Nothing
    Maybe [Name]
translator' <- Text -> RWST Item () BibState BibParser (Maybe [Name])
getNameList' Text
"translator" RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Name] -> RWST Item () BibState BibParser (Maybe [Name])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Name]
forall a. Maybe a
Nothing
    Text
editortype <- Text -> RWST Item () BibState BibParser Text
getRawField Text
"editortype" RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty
    Maybe [Name]
editor'' <- Text -> RWST Item () BibState BibParser (Maybe [Name])
getNameList' Text
"editor" RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Name] -> RWST Item () BibState BibParser (Maybe [Name])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Name]
forall a. Maybe a
Nothing
    Maybe [Name]
director'' <- Text -> RWST Item () BibState BibParser (Maybe [Name])
getNameList' Text
"director" RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
-> RWST Item () BibState BibParser (Maybe [Name])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Name] -> RWST Item () BibState BibParser (Maybe [Name])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Name]
forall a. Maybe a
Nothing
    let (Maybe [Name]
editor', Maybe [Name]
director') = case Text
editortype of
                                    Text
"director" -> (Maybe [Name]
forall a. Maybe a
Nothing, Maybe [Name]
editor'')
                                    Text
_          -> (Maybe [Name]
editor'', Maybe [Name]
director'')
    -- FIXME: add same for editora, editorb, editorc

    -- dates
    Maybe Date
issued' <- (Date -> Maybe Date
forall a. a -> Maybe a
Just (Date -> Maybe Date)
-> RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser (Maybe Date)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> RWST Item () BibState BibParser Date
getDate Text
"date" RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser Date
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Date
getOldDate Text
forall a. Monoid a => a
mempty)) RWST Item () BibState BibParser (Maybe Date)
-> RWST Item () BibState BibParser (Maybe Date)
-> RWST Item () BibState BibParser (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               Maybe Date -> RWST Item () BibState BibParser (Maybe Date)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Date
forall a. Maybe a
Nothing
    Maybe Date
eventDate' <- (Date -> Maybe Date
forall a. a -> Maybe a
Just (Date -> Maybe Date)
-> RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser (Maybe Date)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> RWST Item () BibState BibParser Date
getDate Text
"eventdate" RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser Date
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Date
getOldDate Text
"event")) RWST Item () BibState BibParser (Maybe Date)
-> RWST Item () BibState BibParser (Maybe Date)
-> RWST Item () BibState BibParser (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                   Maybe Date -> RWST Item () BibState BibParser (Maybe Date)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Date
forall a. Maybe a
Nothing
    Maybe Date
origDate' <- (Date -> Maybe Date
forall a. a -> Maybe a
Just (Date -> Maybe Date)
-> RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser (Maybe Date)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> RWST Item () BibState BibParser Date
getDate Text
"origdate" RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser Date
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Date
getOldDate Text
"orig")) RWST Item () BibState BibParser (Maybe Date)
-> RWST Item () BibState BibParser (Maybe Date)
-> RWST Item () BibState BibParser (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                   Maybe Date -> RWST Item () BibState BibParser (Maybe Date)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Date
forall a. Maybe a
Nothing
    Maybe Date
accessed' <- (Date -> Maybe Date
forall a. a -> Maybe a
Just (Date -> Maybe Date)
-> RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser (Maybe Date)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> RWST Item () BibState BibParser Date
getDate Text
"urldate" RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser Date
-> RWST Item () BibState BibParser Date
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Date
getOldDate Text
"url")) RWST Item () BibState BibParser (Maybe Date)
-> RWST Item () BibState BibParser (Maybe Date)
-> RWST Item () BibState BibParser (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    Maybe Date -> RWST Item () BibState BibParser (Maybe Date)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Date
forall a. Maybe a
Nothing

    -- locators
    Maybe Inlines
pages' <- Text -> RWST Item () BibState BibParser (Maybe Inlines)
getFieldMaybe Text
"pages"
    Maybe Inlines
volume' <- Text -> RWST Item () BibState BibParser (Maybe Inlines)
getFieldMaybe Text
"volume"
    Maybe Inlines
part' <- Text -> RWST Item () BibState BibParser (Maybe Inlines)
getFieldMaybe Text
"part"
    Maybe Inlines
volumes' <- Text -> RWST Item () BibState BibParser (Maybe Inlines)
getFieldMaybe Text
"volumes"
    Maybe Inlines
pagetotal' <- Text -> RWST Item () BibState BibParser (Maybe Inlines)
getFieldMaybe Text
"pagetotal"
    Maybe Inlines
chapter' <- Text -> RWST Item () BibState BibParser (Maybe Inlines)
getFieldMaybe Text
"chapter"
    Maybe Inlines
edition' <- Text -> RWST Item () BibState BibParser (Maybe Inlines)
getFieldMaybe Text
"edition"
    Maybe Inlines
version' <- Text -> RWST Item () BibState BibParser (Maybe Inlines)
getFieldMaybe Text
"version"
    (Maybe Inlines
number', Maybe Inlines
collectionNumber', Maybe Inlines
issue') <-
       (Text -> RWST Item () BibState BibParser Inlines
getField Text
"number" RWST Item () BibState BibParser Inlines
-> (Inlines
    -> RWST
         Item
         ()
         BibState
         BibParser
         (Maybe Inlines, Maybe Inlines, Maybe Inlines))
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Inlines
x ->
         if Text
et Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"book",Text
"collection",Text
"proceedings",Text
"reference",
                       Text
"mvbook",Text
"mvcollection",Text
"mvproceedings", Text
"mvreference",
                       Text
"bookinbook",Text
"inbook", Text
"incollection",Text
"inproceedings",
                       Text
"inreference", Text
"suppbook",Text
"suppcollection"]
         then (Maybe Inlines, Maybe Inlines, Maybe Inlines)
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Inlines
forall a. Maybe a
Nothing, Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just Inlines
x, Maybe Inlines
forall a. Maybe a
Nothing)
         else if Bool
isArticle
              then (Text -> RWST Item () BibState BibParser Inlines
getField Text
"issue" RWST Item () BibState BibParser Inlines
-> (Inlines
    -> RWST
         Item
         ()
         BibState
         BibParser
         (Maybe Inlines, Maybe Inlines, Maybe Inlines))
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Inlines
y ->
                      (Maybe Inlines, Maybe Inlines, Maybe Inlines)
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Inlines
forall a. Maybe a
Nothing, Maybe Inlines
forall a. Maybe a
Nothing, Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines) -> Inlines -> Maybe Inlines
forall a b. (a -> b) -> a -> b
$ Char -> [Inlines] -> Inlines
concatWith Char
',' [Inlines
x,Inlines
y]))
                 RWST
  Item
  ()
  BibState
  BibParser
  (Maybe Inlines, Maybe Inlines, Maybe Inlines)
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe Inlines, Maybe Inlines, Maybe Inlines)
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Inlines
forall a. Maybe a
Nothing, Maybe Inlines
forall a. Maybe a
Nothing, Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just Inlines
x)
              else (Maybe Inlines, Maybe Inlines, Maybe Inlines)
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just Inlines
x, Maybe Inlines
forall a. Maybe a
Nothing, Maybe Inlines
forall a. Maybe a
Nothing))
        RWST
  Item
  ()
  BibState
  BibParser
  (Maybe Inlines, Maybe Inlines, Maybe Inlines)
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe Inlines, Maybe Inlines, Maybe Inlines)
-> RWST
     Item
     ()
     BibState
     BibParser
     (Maybe Inlines, Maybe Inlines, Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Inlines
forall a. Maybe a
Nothing, Maybe Inlines
forall a. Maybe a
Nothing, Maybe Inlines
forall a. Maybe a
Nothing)

    -- titles
    Bool
hasMaintitle <- (Bool
True Bool
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> RWST Item () BibState BibParser Text
getRawField Text
"maintitle") RWST Item () BibState BibParser Bool
-> RWST Item () BibState BibParser Bool
-> RWST Item () BibState BibParser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> RWST Item () BibState BibParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    Maybe Inlines
title' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              ((Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isPeriodical RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"issuetitle")
              RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasMaintitle RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                   Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
isChapterlike) RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                   Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"maintitle")
              RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"title")
              RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing

    Inlines
subtitle' <- (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isPeriodical RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"issuesubtitle")
                  RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasMaintitle RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
isChapterlike) RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"mainsubtitle")
                  RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"subtitle"
                  RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
    Inlines
titleaddon' <- (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasMaintitle RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
isChapterlike) RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"maintitleaddon")
                    RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"titleaddon"
                    RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty

    Maybe Inlines
volumeTitle' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    ((Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasMaintitle RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                      Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
isChapterlike) RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                      Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"title")
                     RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasMaintitle RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isChapterlike RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"booktitle"))
                    RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Inlines
volumeSubtitle' <- (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasMaintitle RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                        Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
isChapterlike) RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                        Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"subtitle")
                       RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasMaintitle RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                            Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isChapterlike RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                            Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"booksubtitle")
                       RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
    Inlines
volumeTitleAddon' <- (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasMaintitle RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
isChapterlike) RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"titleaddon")
                         RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasMaintitle RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                              Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isChapterlike RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                              Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"booktitleaddon")
                         RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty

    Maybe Inlines
containerTitle' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       ((Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isPeriodical RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWST Item () BibState BibParser Inlines
getPeriodicalTitle Text
"title")
                       RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isChapterlike RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"maintitle")
                       RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isChapterlike RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"booktitle")
                       RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Inlines
getPeriodicalTitle Text
"journaltitle"
                       RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Inlines
getPeriodicalTitle Text
"journal")
                       RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Inlines
containerSubtitle' <- (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isPeriodical RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWST Item () BibState BibParser Inlines
getPeriodicalTitle Text
"subtitle")
                          RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isChapterlike RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"mainsubtitle")
                          RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isChapterlike RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"booksubtitle")
                          RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Inlines
getPeriodicalTitle Text
"journalsubtitle"
                          RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
    Inlines
containerTitleAddon' <- (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isPeriodical RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                             Text -> RWST Item () BibState BibParser Inlines
getPeriodicalTitle Text
"titleaddon")
                            RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isChapterlike RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                 Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"maintitleaddon")
                            RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isChapterlike RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                 Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"booktitleaddon")
                            RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
    Maybe Inlines
containerTitleShort' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                            ((Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isPeriodical RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                              Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
hasMaintitle) RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                              Text -> RWST Item () BibState BibParser Inlines
getField Text
"shorttitle")
                            RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Inlines
getPeriodicalTitle Text
"shortjournal")
                           RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing

    -- change numerical series title to e.g. 'series 3'
    let fixSeriesTitle :: [Inline] -> [Inline]
fixSeriesTitle [Str Text
xs] | Text -> Bool
isNumber Text
xs =
          [Text -> Inline
Str (Locale -> Text -> Text
ordinalize Locale
locale Text
xs), Inline
Space, Text -> Inline
Str (Lang -> Text -> Text
resolveKey' Lang
lang Text
"jourser")]
        fixSeriesTitle [Inline]
xs = [Inline]
xs
    Maybe Inlines
seriesTitle' <- (Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> (Inlines -> Inlines) -> Inlines -> Maybe Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([Inline] -> Inlines)
-> (Inlines -> [Inline]) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
fixSeriesTitle ([Inline] -> [Inline])
-> (Inlines -> [Inline]) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline])
-> (Inlines -> Inlines) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lang -> Inlines -> Inlines
resolveKey Lang
lang (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"series") RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
shortTitle' <- (Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
hasMaintitle Bool -> Bool -> Bool
|| Bool
isChapterlike) RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                              Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"shorttitle"))
                 RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (if (Inlines
subtitle' Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
/= Inlines
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
|| Inlines
titleaddon' Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
/= Inlines
forall a. Monoid a => a
mempty) Bool -> Bool -> Bool
&&
                          Bool -> Bool
not Bool
hasMaintitle
                          then Bool -> Text -> RWST Item () BibState BibParser (Maybe Inlines)
getShortTitle Bool
False Text
"title"
                          else Bool -> Text -> RWST Item () BibState BibParser (Maybe Inlines)
getShortTitle Bool
True  Text
"title")
                 RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing

    Maybe Inlines
eventTitle' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"eventtitle" RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
origTitle' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
"origtitle" RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing

    -- publisher
    [Maybe Inlines]
pubfields <- (Text -> RWST Item () BibState BibParser (Maybe Inlines))
-> [Text] -> RWST Item () BibState BibParser [Maybe Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Text
f -> Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                         (if Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Bibtex Bool -> Bool -> Bool
|| Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"howpublished"
                          then Text -> RWST Item () BibState BibParser Inlines
getField Text
f
                          else Text -> RWST Item () BibState BibParser Inlines
getLiteralList' Text
f)
                        RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing)
           [Text
"school",Text
"institution",Text
"organization", Text
"howpublished",Text
"publisher"]
    let publisher' :: Maybe Inlines
publisher' = case [Maybe Inlines] -> [Inlines]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Inlines]
pubfields of
                       [] -> Maybe Inlines
forall a. Maybe a
Nothing
                       [Inlines]
xs -> Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines) -> Inlines -> Maybe Inlines
forall a b. (a -> b) -> a -> b
$ Char -> [Inlines] -> Inlines
concatWith Char
';' [Inlines]
xs
    Maybe Inlines
origpublisher' <- (Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField Text
"origpublisher") RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing

    -- places
    Maybe Inlines
venue' <- (Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField Text
"venue") RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
address' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  (if Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Bibtex
                      then Text -> RWST Item () BibState BibParser Inlines
getField Text
"address"
                      else Text -> RWST Item () BibState BibParser Inlines
getLiteralList' Text
"address"
                         RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
et Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"patent") RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                              Text -> RWST Item () BibState BibParser Inlines
getLiteralList' Text
"location"))
                RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
origLocation' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  (if Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Bibtex
                      then Text -> RWST Item () BibState BibParser Inlines
getField Text
"origlocation"
                      else Text -> RWST Item () BibState BibParser Inlines
getLiteralList' Text
"origlocation")
                    RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
jurisdiction' <- if Text
reftype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"patent"
                     then Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        (Char -> [Inlines] -> Inlines
concatWith Char
';' ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inlines -> Inlines) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Lang -> Inlines -> Inlines
resolveKey Lang
lang) ([Inlines] -> Inlines)
-> RWST Item () BibState BibParser [Inlines]
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             Text -> RWST Item () BibState BibParser [Inlines]
getLiteralList Text
"location") RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
                     else Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing

    -- url, doi, isbn, etc.:
    -- note that with eprinttype = arxiv, we take eprint to be a partial url
    -- archivePrefix is an alias for eprinttype
    Maybe Text
url' <- (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
et Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"online" Bool -> Bool -> Bool
|| Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"url" [(Text, Text)]
opts Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"false")
             RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"url")
         RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do Text
etype <- Text -> RWST Item () BibState BibParser Text
getRawField Text
"eprinttype"
                 Text
eprint <- Text -> RWST Item () BibState BibParser Text
getRawField Text
"eprint"
                 let baseUrl :: Text
baseUrl =
                       case Text -> Text
T.toLower Text
etype of
                         Text
"arxiv"       -> Text
"https://arxiv.org/abs/"
                         Text
"jstor"       -> Text
"https://www.jstor.org/stable/"
                         Text
"pubmed"      -> Text
"https://www.ncbi.nlm.nih.gov/pubmed/"
                         Text
"googlebooks" -> Text
"https://books.google.com?id="
                         Text
_             -> Text
""
                 if Text -> Bool
T.null Text
baseUrl
                    then RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                    else Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> RWST Item () BibState BibParser (Maybe Text))
-> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
baseUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
eprint)
         RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
doi' <- (Bool -> RWST Item () BibState BibParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"doi" [(Text, Text)]
opts Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"false") RWST Item () BibState BibParser ()
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"doi")
           RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
isbn' <- Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"isbn" RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
issn' <- Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"issn" RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
pmid' <- Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField  Text
"pmid" RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
pmcid' <- Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"pmcid" RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
callNumber' <- Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"library" RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

    -- notes
    Maybe Inlines
annotation' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   (Text -> RWST Item () BibState BibParser Inlines
getField Text
"annotation" RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Inlines
getField Text
"annote")
                     RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
abstract' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField Text
"abstract" RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
keywords' <- Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField Text
"keywords" RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
note' <- if Text
et Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"periodical"
             then Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
             else Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField Text
"note" RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
addendum' <- if Variant
variant Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Variant
Bibtex
                    then Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
                    else Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField Text
"addendum"
                 RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
    Maybe Inlines
pubstate' <- (  (Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> (Inlines -> Inlines) -> Inlines -> Maybe Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lang -> Inlines -> Inlines
resolveKey Lang
lang (Inlines -> Maybe Inlines)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField Text
"pubstate")
                  RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
-> RWST Item () BibState BibParser (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> case Date -> Maybe Text
dateLiteral (Date -> Maybe Text) -> Maybe Date -> Maybe (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Date
issued' of
                           Just (Just Text
"forthcoming") ->
                             Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines))
-> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines) -> Inlines -> Maybe Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str Text
"forthcoming"
                           Maybe (Maybe Text)
_ -> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing
                   )




    let addField :: (k, Maybe a) -> Map k a -> Map k a
addField (k
_, Maybe a
Nothing) = Map k a -> Map k a
forall a. a -> a
id
        addField (k
f, Just a
x)  = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
f a
x
    let vars :: Map Variable (Val Inlines)
vars = ((Variable, Maybe (Val Inlines))
 -> Map Variable (Val Inlines) -> Map Variable (Val Inlines))
-> Map Variable (Val Inlines)
-> [(Variable, Maybe (Val Inlines))]
-> Map Variable (Val Inlines)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Variable, Maybe (Val Inlines))
-> Map Variable (Val Inlines) -> Map Variable (Val Inlines)
forall k a. Ord k => (k, Maybe a) -> Map k a -> Map k a
addField Map Variable (Val Inlines)
forall a. Monoid a => a
mempty
                [ (Variable
"other-ids", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
otherIds)
                , (Variable
"genre", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
genre)
                , (Variable
"language", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
hyphenation)
                -- dates
                , (Variable
"accessed", Date -> Val Inlines
forall a. Date -> Val a
DateVal (Date -> Val Inlines) -> Maybe Date -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Date
accessed')
                , (Variable
"event-date", Date -> Val Inlines
forall a. Date -> Val a
DateVal (Date -> Val Inlines) -> Maybe Date -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Date
eventDate')
                , (Variable
"issued", Date -> Val Inlines
forall a. Date -> Val a
DateVal (Date -> Val Inlines) -> Maybe Date -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Date
issued')
                , (Variable
"original-date", Date -> Val Inlines
forall a. Date -> Val a
DateVal (Date -> Val Inlines) -> Maybe Date -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Date
origDate')
                -- names
                , (Variable
"author", [Name] -> Val Inlines
forall a. [Name] -> Val a
NamesVal ([Name] -> Val Inlines) -> Maybe [Name] -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Name]
author')
                , (Variable
"editor", [Name] -> Val Inlines
forall a. [Name] -> Val a
NamesVal ([Name] -> Val Inlines) -> Maybe [Name] -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Name]
editor')
                , (Variable
"translator", [Name] -> Val Inlines
forall a. [Name] -> Val a
NamesVal ([Name] -> Val Inlines) -> Maybe [Name] -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Name]
translator')
                , (Variable
"director", [Name] -> Val Inlines
forall a. [Name] -> Val a
NamesVal ([Name] -> Val Inlines) -> Maybe [Name] -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Name]
director')
                , (Variable
"container-author", [Name] -> Val Inlines
forall a. [Name] -> Val a
NamesVal ([Name] -> Val Inlines) -> Maybe [Name] -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Name]
containerAuthor')
                -- locators
                , (Variable
"page", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines)
-> (Inlines -> Inlines) -> Inlines -> Val Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> Inlines -> Inlines
forall a b. Walkable a b => (a -> a) -> b -> b
Walk.walk Inline -> Inline
convertEnDash (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
pages')
                , (Variable
"number-of-pages", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
pagetotal')
                , (Variable
"volume", case (Maybe Inlines
volume', Maybe Inlines
part') of
                               (Maybe Inlines
Nothing, Maybe Inlines
Nothing) -> Maybe (Val Inlines)
forall a. Maybe a
Nothing
                               (Just Inlines
v, Maybe Inlines
Nothing) -> Val Inlines -> Maybe (Val Inlines)
forall a. a -> Maybe a
Just (Val Inlines -> Maybe (Val Inlines))
-> Val Inlines -> Maybe (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Val Inlines
forall a. a -> Val a
FancyVal Inlines
v
                               (Maybe Inlines
Nothing, Just Inlines
p) -> Val Inlines -> Maybe (Val Inlines)
forall a. a -> Maybe a
Just (Val Inlines -> Maybe (Val Inlines))
-> Val Inlines -> Maybe (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Val Inlines
forall a. a -> Val a
FancyVal Inlines
p
                               (Just Inlines
v, Just Inlines
p)  ->
                                 Val Inlines -> Maybe (Val Inlines)
forall a. a -> Maybe a
Just (Val Inlines -> Maybe (Val Inlines))
-> Val Inlines -> Maybe (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Inlines -> Val Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
v Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.str Text
"." Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
p)
                , (Variable
"number-of-volumes", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
volumes')
                , (Variable
"chapter-number", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
chapter')
                , (Variable
"edition", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
edition')
                , (Variable
"version", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
version')
                , (Variable
"number", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
number')
                , (Variable
"collection-number", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
collectionNumber')
                , (Variable
"issue", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
issue')
                -- title
                , (Variable
"original-title", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
origTitle')
                , (Variable
"event", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
eventTitle')
                , (Variable
"title", case Maybe Inlines
title' of
                              Just Inlines
t -> Val Inlines -> Maybe (Val Inlines)
forall a. a -> Maybe a
Just (Val Inlines -> Maybe (Val Inlines))
-> Val Inlines -> Maybe (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Inlines -> Val Inlines
forall a b. (a -> b) -> a -> b
$
                                         Char -> [Inlines] -> Inlines
concatWith Char
'.' [
                                             Char -> [Inlines] -> Inlines
concatWith Char
':' [Inlines
t, Inlines
subtitle']
                                           , Inlines
titleaddon' ]
                              Maybe Inlines
Nothing -> Maybe (Val Inlines)
forall a. Maybe a
Nothing)
                , (Variable
"volume-title",
                            case Maybe Inlines
volumeTitle' of
                              Just Inlines
t -> Val Inlines -> Maybe (Val Inlines)
forall a. a -> Maybe a
Just (Val Inlines -> Maybe (Val Inlines))
-> Val Inlines -> Maybe (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Inlines -> Val Inlines
forall a b. (a -> b) -> a -> b
$
                                         Char -> [Inlines] -> Inlines
concatWith Char
'.' [
                                             Char -> [Inlines] -> Inlines
concatWith Char
':' [Inlines
t, Inlines
volumeSubtitle']
                                           , Inlines
volumeTitleAddon' ]
                              Maybe Inlines
Nothing -> Maybe (Val Inlines)
forall a. Maybe a
Nothing)
                , (Variable
"container-title",
                            case Maybe Inlines
containerTitle' of
                              Just Inlines
t -> Val Inlines -> Maybe (Val Inlines)
forall a. a -> Maybe a
Just (Val Inlines -> Maybe (Val Inlines))
-> Val Inlines -> Maybe (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Inlines -> Val Inlines
forall a b. (a -> b) -> a -> b
$
                                         Char -> [Inlines] -> Inlines
concatWith Char
'.' [
                                             Char -> [Inlines] -> Inlines
concatWith Char
':' [Inlines
t,
                                               Inlines
containerSubtitle']
                                           , Inlines
containerTitleAddon' ]
                              Maybe Inlines
Nothing -> Maybe (Val Inlines)
forall a. Maybe a
Nothing)
                , (Variable
"container-title-short", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
containerTitleShort')
                , (Variable
"collection-title", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
seriesTitle')
                , (Variable
"title-short", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
shortTitle')
                -- publisher
                , (Variable
"publisher", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
publisher')
                , (Variable
"original-publisher", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
origpublisher')
                -- places
                , (Variable
"jurisdiction", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
jurisdiction')
                , (Variable
"event-place",  Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
venue')
                , (Variable
"publisher-place", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
address')
                , (Variable
"original-publisher-place", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
origLocation')
                -- urls
                , (Variable
"url", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
url')
                , (Variable
"doi", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
doi')
                , (Variable
"isbn", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
isbn')
                , (Variable
"issn", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
issn')
                , (Variable
"pmcid", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
pmcid')
                , (Variable
"pmid", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
pmid')
                , (Variable
"call-number", Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Maybe Text -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
callNumber')
                -- notes
                , (Variable
"note", case [Maybe Inlines] -> [Inlines]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Inlines
note', Maybe Inlines
addendum'] of
                             [] -> Maybe (Val Inlines)
forall a. Maybe a
Nothing
                             [Inlines]
xs -> Val Inlines -> Maybe (Val Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val Inlines -> Maybe (Val Inlines))
-> Val Inlines -> Maybe (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Inlines -> Val Inlines
forall a b. (a -> b) -> a -> b
$ Char -> [Inlines] -> Inlines
concatWith Char
'.' [Inlines]
xs)
                , (Variable
"annote", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
annotation')
                , (Variable
"abstract", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
abstract')
                , (Variable
"keyword", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
keywords')
                , (Variable
"status", Inlines -> Val Inlines
forall a. a -> Val a
FancyVal (Inlines -> Val Inlines) -> Maybe Inlines -> Maybe (Val Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
pubstate')
                ]
    Reference Inlines -> Bib (Reference Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reference Inlines -> Bib (Reference Inlines))
-> Reference Inlines -> Bib (Reference Inlines)
forall a b. (a -> b) -> a -> b
$ Reference :: forall a.
ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
Reference
      { referenceId :: ItemId
referenceId             = Text -> ItemId
ItemId Text
id'
      , referenceType :: Text
referenceType           = Text
reftype
      , referenceDisambiguation :: Maybe DisambiguationData
referenceDisambiguation = Maybe DisambiguationData
forall a. Maybe a
Nothing
      , referenceVariables :: Map Variable (Val Inlines)
referenceVariables      = Map Variable (Val Inlines)
vars }


bib :: Item -> Bib a -> BibParser a
bib :: Item -> Bib a -> BibParser a
bib Item
entry Bib a
m = (a, ()) -> a
forall a b. (a, b) -> a
fst ((a, ()) -> a) -> BibParser (a, ()) -> BibParser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bib a -> Item -> BibState -> BibParser (a, ())
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> r -> s -> m (a, w)
evalRWST Bib a
m Item
entry (Bool -> Lang -> BibState
BibState Bool
True Lang
defaultLang)

resolveCrossRefs :: Variant -> [Item] -> [Item]
resolveCrossRefs :: Variant -> [Item] -> [Item]
resolveCrossRefs Variant
variant [Item]
entries =
  (Item -> Item) -> [Item] -> [Item]
forall a b. (a -> b) -> [a] -> [b]
map (Variant -> [Item] -> Item -> Item
resolveCrossRef Variant
variant [Item]
entries) [Item]
entries

resolveCrossRef :: Variant -> [Item] -> Item -> Item
resolveCrossRef :: Variant -> [Item] -> Item -> Item
resolveCrossRef Variant
variant [Item]
entries Item
entry =
  (Text -> Text -> Item -> Item) -> Item -> StringMap -> Item
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Text -> Text -> Item -> Item
forall a. (Eq a, IsString a) => a -> Text -> Item -> Item
go Item
entry (Item -> StringMap
fields Item
entry)
  where go :: a -> Text -> Item -> Item
go a
key Text
val Item
entry' =
          if a
key a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"crossref" Bool -> Bool -> Bool
|| a
key a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"xdata"
          then Item
entry'{ fields :: StringMap
fields = Item -> StringMap
fields Item
entry' StringMap -> StringMap -> StringMap
forall a. Semigroup a => a -> a -> a
<>
                          [(Text, Text)] -> StringMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Variant -> Item -> [Item] -> Text -> [(Text, Text)]
getXrefFields Variant
variant
                                        Item
entry [Item]
entries Text
val) }
          else Item
entry'

getXrefFields :: Variant -> Item -> [Item] -> Text -> [(Text, Text)]
getXrefFields :: Variant -> Item -> [Item] -> Text -> [(Text, Text)]
getXrefFields Variant
variant Item
baseEntry [Item]
entries Text
keys = do
  let keys' :: [Text]
keys' = Text -> [Text]
splitKeys Text
keys
  Item
xrefEntry <- [Item
e | Item
e <- [Item]
entries, Item -> Text
identifier Item
e Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
keys']
  (Text
k, Text
v) <- StringMap -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList (StringMap -> [(Text, Text)]) -> StringMap -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Item -> StringMap
fields Item
xrefEntry
  if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"crossref" Bool -> Bool -> Bool
|| Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"xdata"
     then do
       [(Text, Text)]
xs <- (Text -> [(Text, Text)]) -> [Text] -> [[(Text, Text)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Variant -> Item -> [Item] -> Text -> [(Text, Text)]
getXrefFields Variant
variant Item
baseEntry [Item]
entries)
                   (Text -> [Text]
splitKeys Text
v)
       (Text
x, Text
y) <- [(Text, Text)]
xs
       Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> StringMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
x (StringMap -> Maybe Text) -> StringMap -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Item -> StringMap
fields Item
xrefEntry
       (Text, Text) -> [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Text
y)
     else do
       Text
k' <- case Variant
variant of
               Variant
Bibtex -> Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return Text
k
               Variant
Biblatex -> Text -> Text -> Text -> [Text]
transformKey
                            (Item -> Text
entryType Item
xrefEntry) (Item -> Text
entryType Item
baseEntry) Text
k
       Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> StringMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k' (StringMap -> Maybe Text) -> StringMap -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Item -> StringMap
fields Item
baseEntry
       (Text, Text) -> [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k',Text
v)



data BibState = BibState{
           BibState -> Bool
untitlecase    :: Bool
         , BibState -> Lang
localeLang     :: Lang
         }

type Bib = RWST Item () BibState BibParser

blocksToInlines :: [Block] -> Inlines
blocksToInlines :: [Block] -> Inlines
blocksToInlines [Block]
bs =
  case [Block]
bs of
       [Plain [Inline]
xs] -> [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
xs
       [Para  [Inline]
xs] -> [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
xs
       [Block]
_          -> [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([Inline] -> Inlines) -> [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$ (Inline -> [Inline]) -> [Block] -> [Inline]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
Walk.query (Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[]) [Block]
bs

adjustSpans :: Lang -> Inline -> Inline
adjustSpans :: Lang -> Inline -> Inline
adjustSpans Lang
lang (Span (Text
"",[],[(Text
"bibstring",Text
s)]) [Inline]
_) = Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Lang -> Text -> Text
resolveKey' Lang
lang Text
s
adjustSpans Lang
_ Inline
SoftBreak = Inline
Space
adjustSpans Lang
_ Inline
x = Inline
x

latex' :: Text -> Bib [Block]
latex' :: Text -> Bib [Block]
latex' Text
t = do
  Lang
lang <- (BibState -> Lang) -> RWST Item () BibState BibParser Lang
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BibState -> Lang
localeLang
  case Lang -> Text -> Either PandocError [Block]
parseLaTeX Lang
lang Text
t of
    Left PandocError
_   -> Bib [Block]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Right [Block]
bs -> [Block] -> Bib [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return [Block]
bs

parseLaTeX :: Lang -> Text -> Either PandocError [Block]
parseLaTeX :: Lang -> Text -> Either PandocError [Block]
parseLaTeX Lang
lang Text
t =
  case PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
runPure (ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readLaTeX
                ReaderOptions
forall a. Default a => a
def{ readerExtensions :: Extensions
readerExtensions =
                      [Extension] -> Extensions
extensionsFromList [Extension
Ext_raw_tex, Extension
Ext_smart] } Text
t) of
    Left PandocError
e              -> PandocError -> Either PandocError [Block]
forall a b. a -> Either a b
Left PandocError
e
    Right (Pandoc Meta
_ [Block]
bs) -> [Block] -> Either PandocError [Block]
forall a b. b -> Either a b
Right ([Block] -> Either PandocError [Block])
-> [Block] -> Either PandocError [Block]
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
Walk.walk (Lang -> Inline -> Inline
adjustSpans Lang
lang) [Block]
bs

latex :: Text -> Bib Inlines
latex :: Text -> RWST Item () BibState BibParser Inlines
latex = ([Block] -> Inlines)
-> Bib [Block] -> RWST Item () BibState BibParser Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Block] -> Inlines
blocksToInlines (Bib [Block] -> RWST Item () BibState BibParser Inlines)
-> (Text -> Bib [Block])
-> Text
-> RWST Item () BibState BibParser Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bib [Block]
latex' (Text -> Bib [Block]) -> (Text -> Text) -> Text -> Bib [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip

type Options = [(Text, Text)]

parseOptions :: Text -> Options
parseOptions :: Text -> [(Text, Text)]
parseOptions = (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, Text)
breakOpt ([Text] -> [(Text, Text)])
-> (Text -> [Text]) -> Text -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
","
  where breakOpt :: Text -> (Text, Text)
breakOpt Text
x = case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'=') Text
x of
                          (Text
w,Text
v) -> (Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
w,
                                    Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
v)

bibEntries :: BibParser [Item]
bibEntries :: ParsecT Sources (Lang, StringMap) Identity [Item]
bibEntries = do
  ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources (Lang, StringMap) Identity ()
nonEntry
  ParsecT Sources (Lang, StringMap) Identity Item
-> ParsecT Sources (Lang, StringMap) Identity [Item]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Sources (Lang, StringMap) Identity Item
bibItem ParsecT Sources (Lang, StringMap) Identity Item
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity Item
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources (Lang, StringMap) Identity ()
nonEntry)
 where nonEntry :: ParsecT Sources (Lang, StringMap) Identity ()
nonEntry = ParsecT Sources (Lang, StringMap) Identity ()
bibSkip ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                  ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'@' ParsecT Sources (Lang, StringMap) Identity Char
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       (ParsecT Sources (Lang, StringMap) Identity ()
bibComment ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Sources (Lang, StringMap) Identity ()
bibPreamble ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Sources (Lang, StringMap) Identity ()
bibString))

bibSkip :: BibParser ()
bibSkip :: ParsecT Sources (Lang, StringMap) Identity ()
bibSkip = ParsecT Sources (Lang, StringMap) Identity Char
-> ParsecT Sources (Lang, StringMap) Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ((Char -> Bool) -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'@'))

bibComment :: BibParser ()
bibComment :: ParsecT Sources (Lang, StringMap) Identity ()
bibComment = do
  Text -> BibParser Text
cistring Text
"comment"
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  BibParser Text -> ParsecT Sources (Lang, StringMap) Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void BibParser Text
inBraces ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Sources (Lang, StringMap) Identity ()
bibSkip ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

bibPreamble :: BibParser ()
bibPreamble :: ParsecT Sources (Lang, StringMap) Identity ()
bibPreamble = do
  Text -> BibParser Text
cistring Text
"preamble"
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  BibParser Text -> ParsecT Sources (Lang, StringMap) Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void BibParser Text
inBraces

bibString :: BibParser ()
bibString :: ParsecT Sources (Lang, StringMap) Identity ()
bibString = do
  Text -> BibParser Text
cistring Text
"string"
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'{'
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  (Text
k,Text
v) <- BibParser (Text, Text)
entField
  Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'}'
  ((Lang, StringMap) -> (Lang, StringMap))
-> ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\(Lang
l,StringMap
m) -> (Lang
l, Text -> Text -> StringMap -> StringMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
k Text
v StringMap
m))
  () -> ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

take1WhileP :: Monad m => (Char -> Bool) -> ParserT Sources u m Text
take1WhileP :: (Char -> Bool) -> ParserT Sources u m Text
take1WhileP Char -> Bool
f = String -> Text
T.pack (String -> Text)
-> ParsecT Sources u m String -> ParserT Sources u m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources u m Char -> ParsecT Sources u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
f)

inBraces :: BibParser Text
inBraces :: BibParser Text
inBraces = do
  Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'{'
  [Text]
res <- BibParser Text
-> ParsecT Sources (Lang, StringMap) Identity Char
-> ParsecT Sources (Lang, StringMap) Identity [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill
         (  (Char -> Bool) -> BibParser Text
forall (m :: * -> *) u.
Monad m =>
(Char -> Bool) -> ParserT Sources u m Text
take1WhileP (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'{' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\')
        BibParser Text -> BibParser Text -> BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Sources (Lang, StringMap) Identity Char
-> BibParser Text -> BibParser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (  (Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'{' ParsecT Sources (Lang, StringMap) Identity Char
-> BibParser Text -> BibParser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\{")
                         BibParser Text -> BibParser Text -> BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'}' ParsecT Sources (Lang, StringMap) Identity Char
-> BibParser Text -> BibParser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\}")
                         BibParser Text -> BibParser Text -> BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\"))
        BibParser Text -> BibParser Text -> BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Text
braced (Text -> Text) -> BibParser Text -> BibParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BibParser Text
inBraces)
         ) (Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'}')
  Text -> BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> BibParser Text) -> Text -> BibParser Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
res

braced :: Text -> Text
braced :: Text -> Text
braced = Char -> Text -> Text
T.cons Char
'{' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
'}'

inQuotes :: BibParser Text
inQuotes :: BibParser Text
inQuotes = do
  Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"'
  [Text] -> Text
T.concat ([Text] -> Text)
-> ParsecT Sources (Lang, StringMap) Identity [Text]
-> BibParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BibParser Text
-> ParsecT Sources (Lang, StringMap) Identity Char
-> ParsecT Sources (Lang, StringMap) Identity [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill
             ( (Char -> Bool) -> BibParser Text
forall (m :: * -> *) u.
Monad m =>
(Char -> Bool) -> ParserT Sources u m Text
take1WhileP (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'{' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\')
               BibParser Text -> BibParser Text -> BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Sources (Lang, StringMap) Identity Char
-> BibParser Text -> BibParser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Text -> Text
T.cons Char
'\\' (Text -> Text) -> (Char -> Text) -> Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Text)
-> ParsecT Sources (Lang, StringMap) Identity Char
-> BibParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar)
               BibParser Text -> BibParser Text -> BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text
braced (Text -> Text) -> BibParser Text -> BibParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BibParser Text
inBraces
            ) (Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"')

fieldName :: BibParser Text
fieldName :: BibParser Text
fieldName = Text -> Text
resolveAlias (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
  (Text -> Text) -> BibParser Text -> BibParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> BibParser Text
forall (m :: * -> *) u.
Monad m =>
(Char -> Bool) -> ParserT Sources u m Text
take1WhileP (\Char
c ->
         Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+')

isBibtexKeyChar :: Char -> Bool
isBibtexKeyChar :: Char -> Bool
isBibtexKeyChar Char
c =
  Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
".:;?!`'()/*@_+=-[]*&" :: [Char])

bibItem :: BibParser Item
bibItem :: ParsecT Sources (Lang, StringMap) Identity Item
bibItem = do
  Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'@'
  SourcePos
pos <- ParsecT Sources (Lang, StringMap) Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Text
enttype <- Text -> Text
T.toLower (Text -> Text) -> BibParser Text -> BibParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> BibParser Text
forall (m :: * -> *) u.
Monad m =>
(Char -> Bool) -> ParserT Sources u m Text
take1WhileP Char -> Bool
isLetter
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'{'
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text
entid <- (Char -> Bool) -> BibParser Text
forall (m :: * -> *) u.
Monad m =>
(Char -> Bool) -> ParserT Sources u m Text
take1WhileP Char -> Bool
isBibtexKeyChar
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
','
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  [(Text, Text)]
entfields <- BibParser (Text, Text)
entField BibParser (Text, Text)
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity [(Text, Text)]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepEndBy` (Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
',' ParsecT Sources (Lang, StringMap) Identity Char
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces)
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'}'
  Item -> ParsecT Sources (Lang, StringMap) Identity Item
forall (m :: * -> *) a. Monad m => a -> m a
return (Item -> ParsecT Sources (Lang, StringMap) Identity Item)
-> Item -> ParsecT Sources (Lang, StringMap) Identity Item
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> Text -> StringMap -> Item
Item Text
entid SourcePos
pos Text
enttype ([(Text, Text)] -> StringMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
entfields)

entField :: BibParser (Text, Text)
entField :: BibParser (Text, Text)
entField = do
  Text
k <- BibParser Text
fieldName
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'='
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  [Text]
vs <- (BibParser Text
expandString BibParser Text -> BibParser Text -> BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BibParser Text
inQuotes BibParser Text -> BibParser Text -> BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BibParser Text
inBraces BibParser Text -> BibParser Text -> BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BibParser Text
rawWord) BibParser Text
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy`
            ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity Char
-> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources (Lang, StringMap) Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'#' ParsecT Sources (Lang, StringMap) Identity Char
-> ParsecT Sources (Lang, StringMap) Identity ()
-> ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces)
  ParsecT Sources (Lang, StringMap) Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  (Text, Text) -> BibParser (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k, [Text] -> Text
T.concat [Text]
vs)

resolveAlias :: Text -> Text
resolveAlias :: Text -> Text
resolveAlias Text
"archiveprefix" = Text
"eprinttype"
resolveAlias Text
"primaryclass" = Text
"eprintclass"
resolveAlias Text
s = Text
s

rawWord :: BibParser Text
rawWord :: BibParser Text
rawWord = (Char -> Bool) -> BibParser Text
forall (m :: * -> *) u.
Monad m =>
(Char -> Bool) -> ParserT Sources u m Text
take1WhileP Char -> Bool
isAlphaNum

expandString :: BibParser Text
expandString :: BibParser Text
expandString = do
  Text
k <- BibParser Text
fieldName
  (Lang
lang, StringMap
strs) <- ParsecT Sources (Lang, StringMap) Identity (Lang, StringMap)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case Text -> StringMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k StringMap
strs of
       Just Text
v  -> Text -> BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
v
       Maybe Text
Nothing -> Text -> BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> BibParser Text) -> Text -> BibParser Text
forall a b. (a -> b) -> a -> b
$ Lang -> Text -> Text
resolveKey' Lang
lang Text
k

cistring :: Text -> BibParser Text
cistring :: Text -> BibParser Text
cistring Text
s = BibParser Text -> BibParser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> BibParser Text
forall (m :: * -> *) s u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
go Text
s)
 where go :: Text -> ParsecT s u m Text
go Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
         Maybe (Char, Text)
Nothing     -> Text -> ParsecT s u m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
         Just (Char
c,Text
cs) -> do
           Char
x <- Char -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char (Char -> Char
toLower Char
c) ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char (Char -> Char
toUpper Char
c)
           Text
xs <- Text -> ParsecT s u m Text
go Text
cs
           Text -> ParsecT s u m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Text -> Text
T.cons Char
x Text
xs)

splitKeys :: Text -> [Text]
splitKeys :: Text -> [Text]
splitKeys = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')

-- Biblatex Localization Keys (see Biblatex manual)
-- Currently we only map a subset likely to be used in Biblatex *databases*
-- (in fields such as `type`, and via `\bibstring{}` commands).

parseMonth :: Text -> Maybe Int
parseMonth :: Text -> Maybe Int
parseMonth Text
s =
  case Text -> Text
T.toLower Text
s of
         Text
"jan" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
         Text
"feb" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
         Text
"mar" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3
         Text
"apr" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
         Text
"may" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5
         Text
"jun" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6
         Text
"jul" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
7
         Text
"aug" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
         Text
"sep" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
9
         Text
"oct" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10
         Text
"nov" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
11
         Text
"dec" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
12
         Text
_     -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (Text -> String
T.unpack Text
s)

notFound :: Text -> Bib a
notFound :: Text -> Bib a
notFound Text
f = String -> Bib a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Bib a) -> String -> Bib a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found"

getField :: Text -> Bib Inlines
getField :: Text -> RWST Item () BibState BibParser Inlines
getField Text
f = do
  StringMap
fs <- (Item -> StringMap) -> RWST Item () BibState BibParser StringMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Item -> StringMap
fields
  case Text -> StringMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
f StringMap
fs of
       Just Text
x  -> Text -> RWST Item () BibState BibParser Inlines
latex Text
x
       Maybe Text
Nothing -> Text -> RWST Item () BibState BibParser Inlines
forall a. Text -> Bib a
notFound Text
f


getPeriodicalTitle :: Text -> Bib Inlines
getPeriodicalTitle :: Text -> RWST Item () BibState BibParser Inlines
getPeriodicalTitle Text
f = do
  Inlines
ils <- Text -> RWST Item () BibState BibParser Inlines
getField Text
f
  Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
ils

protectCase :: (Inlines -> Inlines) -> (Inlines -> Inlines)
protectCase :: (Inlines -> Inlines) -> Inlines -> Inlines
protectCase Inlines -> Inlines
f = (Inline -> Inline) -> Inlines -> Inlines
forall a b. Walkable a b => (a -> a) -> b -> b
Walk.walk Inline -> Inline
unprotect (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
f (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> Inlines -> Inlines
forall a b. Walkable a b => (a -> a) -> b -> b
Walk.walk Inline -> Inline
protect
 where
  protect :: Inline -> Inline
protect (Span (Text
"",[],[]) [Inline]
xs) = Attr -> [Inline] -> Inline
Span (Text
"",[Text
"nocase"],[]) [Inline]
xs
  protect  Inline
x = Inline
x
  unprotect :: Inline -> Inline
unprotect (Span (Text
"",[Text
"nocase"],[]) [Inline]
xs)
    | [Inline] -> Bool
hasLowercaseWord [Inline]
xs = Attr -> [Inline] -> Inline
Span (Text
"",[Text
"nocase"],[]) [Inline]
xs
    | Bool
otherwise           = Attr -> [Inline] -> Inline
Span (Text
"",[],[]) [Inline]
xs
  unprotect Inline
x = Inline
x
  hasLowercaseWord :: [Inline] -> Bool
hasLowercaseWord = (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Inline -> Bool
startsWithLowercase ([Inline] -> Bool) -> ([Inline] -> [Inline]) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen Char -> Bool
isPunctuation
  startsWithLowercase :: Inline -> Bool
startsWithLowercase (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
x,Text
_))) = Char -> Bool
isLower Char
x
  startsWithLowercase Inline
_           = Bool
False

unTitlecase :: Maybe Lang -> Inlines -> Inlines
unTitlecase :: Maybe Lang -> Inlines -> Inlines
unTitlecase Maybe Lang
mblang = (Inlines -> Inlines) -> Inlines -> Inlines
protectCase (Maybe Lang -> TextCase -> Inlines -> Inlines
forall a. CiteprocOutput a => Maybe Lang -> TextCase -> a -> a
addTextCase Maybe Lang
mblang TextCase
SentenceCase)

getTitle :: Text -> Bib Inlines
getTitle :: Text -> RWST Item () BibState BibParser Inlines
getTitle Text
f = do
  Inlines
ils <- Text -> RWST Item () BibState BibParser Inlines
getField Text
f
  Bool
utc <- (BibState -> Bool) -> RWST Item () BibState BibParser Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BibState -> Bool
untitlecase
  Lang
lang <- (BibState -> Lang) -> RWST Item () BibState BibParser Lang
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BibState -> Lang
localeLang
  let processTitle :: Inlines -> Inlines
processTitle = if Bool
utc then Maybe Lang -> Inlines -> Inlines
unTitlecase (Lang -> Maybe Lang
forall a. a -> Maybe a
Just Lang
lang) else Inlines -> Inlines
forall a. a -> a
id
  Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> RWST Item () BibState BibParser Inlines)
-> Inlines -> RWST Item () BibState BibParser Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
processTitle Inlines
ils

getShortTitle :: Bool -> Text -> Bib (Maybe Inlines)
getShortTitle :: Bool -> Text -> RWST Item () BibState BibParser (Maybe Inlines)
getShortTitle Bool
requireColon Text
f = do
  [Inline]
ils <- (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') ([Inline] -> [Inline])
-> (Inlines -> [Inline]) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline])
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getTitle Text
f
  if Bool -> Bool
not Bool
requireColon Bool -> Bool -> Bool
|| [Inline] -> Bool
containsColon [Inline]
ils
     then Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines))
-> Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines) -> Inlines -> Maybe Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([Inline] -> Inlines) -> [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
upToColon [Inline]
ils
     else Maybe Inlines -> RWST Item () BibState BibParser (Maybe Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inlines
forall a. Maybe a
Nothing

containsColon :: [Inline] -> Bool
containsColon :: [Inline] -> Bool
containsColon [Inline]
xs = Text -> Inline
Str Text
":" Inline -> [Inline] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Inline]
xs

upToColon :: [Inline] -> [Inline]
upToColon :: [Inline] -> [Inline]
upToColon [Inline]
xs = (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Inline
Str Text
":") [Inline]
xs

isNumber :: Text -> Bool
isNumber :: Text -> Bool
isNumber Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Just (Char
'-', Text
ds) -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
ds
  Just (Char, Text)
_         -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t
  Maybe (Char, Text)
Nothing        -> Bool
False

getDate :: Text -> Bib Date
getDate :: Text -> RWST Item () BibState BibParser Date
getDate Text
f = do
  -- the ~ can used for approx dates, but the latex reader
  -- parses this as a nonbreaking space, so we need to convert it back!
  let nbspToTilde :: Char -> Char
nbspToTilde Char
'\160' = Char
'~'
      nbspToTilde Char
c      = Char
c
  Maybe Date
mbd <- Text -> Maybe Date
rawDateEDTF (Text -> Maybe Date) -> (Text -> Text) -> Text -> Maybe Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
nbspToTilde (Text -> Maybe Date)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Date)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
f
  case Maybe Date
mbd of
    Maybe Date
Nothing -> String -> RWST Item () BibState BibParser Date
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expected date"
    Just Date
d  -> Date -> RWST Item () BibState BibParser Date
forall (m :: * -> *) a. Monad m => a -> m a
return Date
d

-- A negative (BC) year might be written with -- or --- in bibtex:
fixLeadingDash :: Text -> Text
fixLeadingDash :: Text -> Text
fixLeadingDash Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Just (Char
c, Text
ds) | (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'–' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'—') Bool -> Bool -> Bool
&& Text -> Bool
firstIsDigit Text
ds -> Char -> Text -> Text
T.cons Char
'–' Text
ds
  Maybe (Char, Text)
_ -> Text
t
 where firstIsDigit :: Text -> Bool
firstIsDigit = Bool -> ((Char, Text) -> Bool) -> Maybe (Char, Text) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
isDigit (Char -> Bool) -> ((Char, Text) -> Char) -> (Char, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Maybe (Char, Text) -> Bool)
-> (Text -> Maybe (Char, Text)) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons

getOldDate :: Text -> Bib Date
getOldDate :: Text -> RWST Item () BibState BibParser Date
getOldDate Text
prefix = do
  Maybe Int
year' <- (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int)
-> (Inlines -> String) -> Inlines -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Inlines -> Text) -> Inlines -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fixLeadingDash (Text -> Text) -> (Inlines -> Text) -> Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify
              (Inlines -> Maybe Int)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"year")) RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> RWST Item () BibState BibParser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
  Maybe Int
month' <- (Text -> Maybe Int
parseMonth (Text -> Maybe Int)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"month"))
            RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> RWST Item () BibState BibParser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
  Maybe Int
day' <- (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"day"))
          RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> RWST Item () BibState BibParser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
  Maybe Int
endyear' <- (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int)
-> (Inlines -> String) -> Inlines -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Inlines -> Text) -> Inlines -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fixLeadingDash (Text -> Text) -> (Inlines -> Text) -> Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify
              (Inlines -> Maybe Int)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"endyear")) RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> RWST Item () BibState BibParser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
  Maybe Int
endmonth' <- (Text -> Maybe Int
parseMonth (Text -> Maybe Int) -> (Inlines -> Text) -> Inlines -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify
                 (Inlines -> Maybe Int)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Inlines
getField (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"endmonth")) RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> RWST Item () BibState BibParser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
  Maybe Int
endday' <- (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int)
-> (Inlines -> String) -> Inlines -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Inlines -> Text) -> Inlines -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inlines -> Maybe Int)
-> RWST Item () BibState BibParser Inlines
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 Text -> RWST Item () BibState BibParser Inlines
getField (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"endday")) RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
-> RWST Item () BibState BibParser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> RWST Item () BibState BibParser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
  let toDateParts :: (Maybe Int, Maybe Int, Maybe Int) -> DateParts
toDateParts (Maybe Int
y', Maybe Int
m', Maybe Int
d') =
              [Int] -> DateParts
DateParts ([Int] -> DateParts) -> [Int] -> DateParts
forall a b. (a -> b) -> a -> b
$
                 case Maybe Int
y' of
                   Maybe Int
Nothing -> []
                   Just Int
y  ->
                     case Maybe Int
m' of
                       Maybe Int
Nothing -> [Int
y]
                       Just Int
m  ->
                         case Maybe Int
d' of
                           Maybe Int
Nothing -> [Int
y,Int
m]
                           Just Int
d  -> [Int
y,Int
m,Int
d]
  let dateparts :: [DateParts]
dateparts = (DateParts -> Bool) -> [DateParts] -> [DateParts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\DateParts
x -> DateParts
x DateParts -> DateParts -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int] -> DateParts
DateParts [])
                  ([DateParts] -> [DateParts]) -> [DateParts] -> [DateParts]
forall a b. (a -> b) -> a -> b
$ ((Maybe Int, Maybe Int, Maybe Int) -> DateParts)
-> [(Maybe Int, Maybe Int, Maybe Int)] -> [DateParts]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int, Maybe Int, Maybe Int) -> DateParts
toDateParts [(Maybe Int
year',Maybe Int
month',Maybe Int
day'),
                                     (Maybe Int
endyear',Maybe Int
endmonth',Maybe Int
endday')]
  Maybe Text
literal' <- if [DateParts] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DateParts]
dateparts
                 then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"year")
                 else Maybe Text -> RWST Item () BibState BibParser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
  Date -> RWST Item () BibState BibParser Date
forall (m :: * -> *) a. Monad m => a -> m a
return (Date -> RWST Item () BibState BibParser Date)
-> Date -> RWST Item () BibState BibParser Date
forall a b. (a -> b) -> a -> b
$
    Date :: [DateParts] -> Bool -> Maybe Int -> Maybe Text -> Date
Date { dateParts :: [DateParts]
dateParts = [DateParts]
dateparts
         , dateCirca :: Bool
dateCirca = Bool
False
         , dateSeason :: Maybe Int
dateSeason = Maybe Int
forall a. Maybe a
Nothing
         , dateLiteral :: Maybe Text
dateLiteral = Maybe Text
literal' }

getRawField :: Text -> Bib Text
getRawField :: Text -> RWST Item () BibState BibParser Text
getRawField Text
f = do
  StringMap
fs <- (Item -> StringMap) -> RWST Item () BibState BibParser StringMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Item -> StringMap
fields
  case Text -> StringMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
f StringMap
fs of
       Just Text
x  -> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
       Maybe Text
Nothing -> Text -> RWST Item () BibState BibParser Text
forall a. Text -> Bib a
notFound Text
f

getLiteralList :: Text -> Bib [Inlines]
getLiteralList :: Text -> RWST Item () BibState BibParser [Inlines]
getLiteralList Text
f = do
  StringMap
fs <- (Item -> StringMap) -> RWST Item () BibState BibParser StringMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Item -> StringMap
fields
  case Text -> StringMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
f StringMap
fs of
       Just Text
x  -> Text -> Bib [Block]
latex' Text
x Bib [Block]
-> ([Block] -> RWST Item () BibState BibParser [Inlines])
-> RWST Item () BibState BibParser [Inlines]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Block] -> RWST Item () BibState BibParser [Inlines]
toLiteralList
       Maybe Text
Nothing -> Text -> RWST Item () BibState BibParser [Inlines]
forall a. Text -> Bib a
notFound Text
f

-- separates items with semicolons
getLiteralList' :: Text -> Bib Inlines
getLiteralList' :: Text -> RWST Item () BibState BibParser Inlines
getLiteralList' Text
f = do
  StringMap
fs <- (Item -> StringMap) -> RWST Item () BibState BibParser StringMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Item -> StringMap
fields
  case Text -> StringMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
f StringMap
fs of
    Just Text
x    -> do
      [Block]
x' <- Text -> Bib [Block]
latex' Text
x
      case [Block]
x' of
        [Para [Inline]
xs]  ->
          Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> RWST Item () BibState BibParser Inlines)
-> Inlines -> RWST Item () BibState BibParser Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList
                 ([Inline] -> Inlines) -> [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Text -> Inline
Str Text
";", Inline
Space]
                 ([[Inline]] -> [Inline]) -> [[Inline]] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]]
splitByAnd [Inline]
xs
        [Plain [Inline]
xs] ->
          Inlines -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> RWST Item () BibState BibParser Inlines)
-> Inlines -> RWST Item () BibState BibParser Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList
                 ([Inline] -> Inlines) -> [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Text -> Inline
Str Text
";", Inline
Space]
                 ([[Inline]] -> [Inline]) -> [[Inline]] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]]
splitByAnd [Inline]
xs
        [Block]
_          -> RWST Item () BibState BibParser Inlines
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Maybe Text
Nothing   -> Text -> RWST Item () BibState BibParser Inlines
forall a. Text -> Bib a
notFound Text
f

splitByAnd :: [Inline] -> [[Inline]]
splitByAnd :: [Inline] -> [[Inline]]
splitByAnd = [Inline] -> [Inline] -> [[Inline]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Inline
Space, Text -> Inline
Str Text
"and", Inline
Space]

toLiteralList :: [Block] -> Bib [Inlines]
toLiteralList :: [Block] -> RWST Item () BibState BibParser [Inlines]
toLiteralList [Para [Inline]
xs] =
  [Inlines] -> RWST Item () BibState BibParser [Inlines]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inlines] -> RWST Item () BibState BibParser [Inlines])
-> [Inlines] -> RWST Item () BibState BibParser [Inlines]
forall a b. (a -> b) -> a -> b
$ ([Inline] -> Inlines) -> [[Inline]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([[Inline]] -> [Inlines]) -> [[Inline]] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]]
splitByAnd [Inline]
xs
toLiteralList [Plain [Inline]
xs] = [Block] -> RWST Item () BibState BibParser [Inlines]
toLiteralList [[Inline] -> Block
Para [Inline]
xs]
toLiteralList [Block]
_ = RWST Item () BibState BibParser [Inlines]
forall (m :: * -> *) a. MonadPlus m => m a
mzero

concatWith :: Char -> [Inlines] -> Inlines
concatWith :: Char -> [Inlines] -> Inlines
concatWith Char
sep = (Inlines -> Inlines -> Inlines) -> Inlines -> [Inlines] -> Inlines
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Inlines -> Inlines -> Inlines
go Inlines
forall a. Monoid a => a
mempty
  where go :: Inlines -> Inlines -> Inlines
        go :: Inlines -> Inlines -> Inlines
go Inlines
accum Inlines
s
          | Inlines
s Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty = Inlines
accum
          | Bool
otherwise   =
              case Seq Inline -> ViewR Inline
forall a. Seq a -> ViewR a
Seq.viewr (Inlines -> Seq Inline
forall a. Many a -> Seq a
B.unMany Inlines
accum) of
                     ViewR Inline
Seq.EmptyR -> Inlines
s
                     Seq Inline
_ Seq.:> Str Text
x
                       | Bool -> Bool
not (Text -> Bool
T.null Text
x) Bool -> Bool -> Bool
&&
                         Text -> Char
T.last Text
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"!?.,:;" :: String)
                                    -> Inlines
accum Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
s
                     ViewR Inline
_ -> Inlines
accum Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.str (Char -> Text
T.singleton Char
sep) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                                                Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
s


getNameList :: Options -> Text -> Bib [Name]
getNameList :: [(Text, Text)] -> Text -> RWST Item () BibState BibParser [Name]
getNameList [(Text, Text)]
opts  Text
f = do
  StringMap
fs <- (Item -> StringMap) -> RWST Item () BibState BibParser StringMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Item -> StringMap
fields
  case Text -> StringMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
f StringMap
fs of
       Just Text
x  -> [(Text, Text)] -> Text -> RWST Item () BibState BibParser [Name]
latexNames [(Text, Text)]
opts Text
x
       Maybe Text
Nothing -> Text -> RWST Item () BibState BibParser [Name]
forall a. Text -> Bib a
notFound Text
f

toNameList :: Options -> [Block] -> Bib [Name]
toNameList :: [(Text, Text)] -> [Block] -> RWST Item () BibState BibParser [Name]
toNameList [(Text, Text)]
opts [Para [Inline]
xs] =
  (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
emptyName) ([Name] -> [Name])
-> RWST Item () BibState BibParser [Name]
-> RWST Item () BibState BibParser [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> RWST Item () BibState BibParser Name)
-> [[Inline]] -> RWST Item () BibState BibParser [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([(Text, Text)] -> [Inline] -> RWST Item () BibState BibParser Name
toName [(Text, Text)]
opts ([Inline] -> RWST Item () BibState BibParser Name)
-> ([Inline] -> [Inline])
-> [Inline]
-> RWST Item () BibState BibParser Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
addSpaceAfterPeriod)
                                    ([Inline] -> [[Inline]]
splitByAnd [Inline]
xs)
toNameList [(Text, Text)]
opts [Plain [Inline]
xs] = [(Text, Text)] -> [Block] -> RWST Item () BibState BibParser [Name]
toNameList [(Text, Text)]
opts [[Inline] -> Block
Para [Inline]
xs]
toNameList [(Text, Text)]
_ [Block]
_ = RWST Item () BibState BibParser [Name]
forall (m :: * -> *) a. MonadPlus m => m a
mzero

latexNames :: Options -> Text -> Bib [Name]
latexNames :: [(Text, Text)] -> Text -> RWST Item () BibState BibParser [Name]
latexNames [(Text, Text)]
opts Text
t = Text -> Bib [Block]
latex' (Text -> Text
T.strip Text
t) Bib [Block]
-> ([Block] -> RWST Item () BibState BibParser [Name])
-> RWST Item () BibState BibParser [Name]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Text, Text)] -> [Block] -> RWST Item () BibState BibParser [Name]
toNameList [(Text, Text)]
opts

-- see issue 392 for motivation.  We want to treat
-- "J.G. Smith" and "J. G. Smith" the same.
addSpaceAfterPeriod :: [Inline] -> [Inline]
addSpaceAfterPeriod :: [Inline] -> [Inline]
addSpaceAfterPeriod = [Inline] -> [Inline]
go ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.')
  where
    go :: [Inline] -> [Inline]
go [] = []
    go (Str (Text -> String
T.unpack -> [Char
c]):Str Text
".":Str (Text -> String
T.unpack -> [Char
d]):[Inline]
xs)
      | Char -> Bool
isLetter Char
d
      , Char -> Bool
isLetter Char
c
      , Char -> Bool
isUpper Char
c
      , Char -> Bool
isUpper Char
d
        = Text -> Inline
Str (Char -> Text
T.singleton Char
c)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:Text -> Inline
Str Text
"."Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:Inline
SpaceInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline] -> [Inline]
go (Text -> Inline
Str (Char -> Text
T.singleton Char
d)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
xs)
    go (Inline
x:[Inline]
xs) = Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline] -> [Inline]
go [Inline]
xs

emptyName :: Name
emptyName :: Name
emptyName =
    Name :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Bool
-> Bool
-> Maybe Text
-> Name
Name {  nameFamily :: Maybe Text
nameFamily              = Maybe Text
forall a. Maybe a
Nothing
          , nameGiven :: Maybe Text
nameGiven               = Maybe Text
forall a. Maybe a
Nothing
          , nameDroppingParticle :: Maybe Text
nameDroppingParticle    = Maybe Text
forall a. Maybe a
Nothing
          , nameNonDroppingParticle :: Maybe Text
nameNonDroppingParticle = Maybe Text
forall a. Maybe a
Nothing
          , nameSuffix :: Maybe Text
nameSuffix              = Maybe Text
forall a. Maybe a
Nothing
          , nameLiteral :: Maybe Text
nameLiteral             = Maybe Text
forall a. Maybe a
Nothing
          , nameCommaSuffix :: Bool
nameCommaSuffix         = Bool
False
          , nameStaticOrdering :: Bool
nameStaticOrdering      = Bool
False
          }

toName :: Options -> [Inline] -> Bib Name
toName :: [(Text, Text)] -> [Inline] -> RWST Item () BibState BibParser Name
toName [(Text, Text)]
_ [Str Text
"others"] =
  Name -> RWST Item () BibState BibParser Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
emptyName{ nameLiteral :: Maybe Text
nameLiteral = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"others" }
toName [(Text, Text)]
_ [Span (Text
"",[],[]) [Inline]
ils] = -- corporate author
  Name -> RWST Item () BibState BibParser Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
emptyName{ nameLiteral :: Maybe Text
nameLiteral = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils }
 -- extended BibLaTeX name format - see #266
toName [(Text, Text)]
_ ils :: [Inline]
ils@(Str Text
ys:[Inline]
_) | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') Text
ys = do
  let commaParts :: [[Inline]]
commaParts = (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Inline
Str Text
",")
                   ([Inline] -> [[Inline]])
-> ([Inline] -> [Inline]) -> [Inline] -> [[Inline]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\160')
                   ([Inline] -> [[Inline]]) -> [Inline] -> [[Inline]]
forall a b. (a -> b) -> a -> b
$ [Inline]
ils
  let addPart :: Name -> [Inline] -> Name
addPart Name
ag (Str Text
"given" : Str Text
"=" : [Inline]
xs) =
        Name
ag{ nameGiven :: Maybe Text
nameGiven = case Name -> Maybe Text
nameGiven Name
ag of
                          Maybe Text
Nothing -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs
                          Just Text
t  -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs }
      addPart Name
ag (Str Text
"family" : Str Text
"=" : [Inline]
xs) =
        Name
ag{ nameFamily :: Maybe Text
nameFamily = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs }
      addPart Name
ag (Str Text
"prefix" : Str Text
"=" : [Inline]
xs) =
        Name
ag{ nameDroppingParticle :: Maybe Text
nameDroppingParticle =  Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs }
      addPart Name
ag (Str Text
"useprefix" : Str Text
"=" : Str Text
"true" : [Inline]
_) =
        Name
ag{ nameNonDroppingParticle :: Maybe Text
nameNonDroppingParticle = Name -> Maybe Text
nameDroppingParticle Name
ag
          , nameDroppingParticle :: Maybe Text
nameDroppingParticle    = Maybe Text
forall a. Maybe a
Nothing }
      addPart Name
ag (Str Text
"suffix" : Str Text
"=" : [Inline]
xs) =
        Name
ag{ nameSuffix :: Maybe Text
nameSuffix = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs }
      addPart Name
ag (Inline
Space : [Inline]
xs) = Name -> [Inline] -> Name
addPart Name
ag [Inline]
xs
      addPart Name
ag [Inline]
_ = Name
ag
  Name -> RWST Item () BibState BibParser Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RWST Item () BibState BibParser Name)
-> Name -> RWST Item () BibState BibParser Name
forall a b. (a -> b) -> a -> b
$ (Name -> [Inline] -> Name) -> Name -> [[Inline]] -> Name
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Name -> [Inline] -> Name
addPart Name
emptyName [[Inline]]
commaParts
-- First von Last
-- von Last, First
-- von Last, Jr ,First
-- NOTE: biblatex and bibtex differ on:
-- Drummond de Andrade, Carlos
-- bibtex takes "Drummond de" as the von;
-- biblatex takes the whole as a last name.
-- See https://github.com/plk/biblatex/issues/236
-- Here we implement the more sensible biblatex behavior.
toName [(Text, Text)]
opts [Inline]
ils = do
  let useprefix :: Bool
useprefix = Text -> [(Text, Text)] -> Bool
optionSet Text
"useprefix" [(Text, Text)]
opts
  let usecomma :: Bool
usecomma  = Text -> [(Text, Text)] -> Bool
optionSet Text
"juniorcomma" [(Text, Text)]
opts
  let bibtex :: Bool
bibtex    = Text -> [(Text, Text)] -> Bool
optionSet Text
"bibtex" [(Text, Text)]
opts
  let words' :: [Inline] -> [[Inline]]
words' = (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (\Inline
x -> Inline
x Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
Space Bool -> Bool -> Bool
|| Inline
x Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Inline
Str Text
"\160")
  let commaParts :: [[[Inline]]]
commaParts = ([Inline] -> [[Inline]]) -> [[Inline]] -> [[[Inline]]]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> [[Inline]]
words' ([[Inline]] -> [[[Inline]]]) -> [[Inline]] -> [[[Inline]]]
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Inline
Str Text
",")
                              ([Inline] -> [[Inline]]) -> [Inline] -> [[Inline]]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen
                                   (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\160') [Inline]
ils
  let ([[Inline]]
first, [[Inline]]
vonlast, [[Inline]]
jr) =
          case [[[Inline]]]
commaParts of
               --- First is the longest sequence of white-space separated
               -- words starting with an uppercase and that is not the
               -- whole string. von is the longest sequence of whitespace
               -- separated words whose last word starts with lower case
               -- and that is not the whole string.
               [[[Inline]]
fvl]      -> let ([[Inline]]
caps', [[Inline]]
rest') = ([Inline] -> Bool) -> [[Inline]] -> ([[Inline]], [[Inline]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span [Inline] -> Bool
isCapitalized [[Inline]]
fvl
                             in  if [[Inline]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline]]
rest' Bool -> Bool -> Bool
&& Bool -> Bool
not ([[Inline]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline]]
caps')
                                 then ([[Inline]] -> [[Inline]]
forall a. [a] -> [a]
init [[Inline]]
caps', [[[Inline]] -> [Inline]
forall a. [a] -> a
last [[Inline]]
caps'], [])
                                 else ([[Inline]]
caps', [[Inline]]
rest', [])
               [[[Inline]]
vl,[[Inline]]
f]     -> ([[Inline]]
f, [[Inline]]
vl, [])
               ([[Inline]]
vl:[[Inline]]
j:[[Inline]]
f:[[[Inline]]]
_) -> ([[Inline]]
f, [[Inline]]
vl, [[Inline]]
j )
               []         -> ([], [], [])

  let ([[Inline]]
von, [[Inline]]
lastname) =
         if Bool
bibtex
            then case ([Inline] -> Bool) -> [[Inline]] -> ([[Inline]], [[Inline]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span [Inline] -> Bool
isCapitalized ([[Inline]] -> ([[Inline]], [[Inline]]))
-> [[Inline]] -> ([[Inline]], [[Inline]])
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> [[Inline]]
forall a. [a] -> [a]
reverse [[Inline]]
vonlast of
                        ([],[Inline]
w:[[Inline]]
ws) -> ([[Inline]] -> [[Inline]]
forall a. [a] -> [a]
reverse [[Inline]]
ws, [[Inline]
w])
                        ([[Inline]]
vs, [[Inline]]
ws)    -> ([[Inline]] -> [[Inline]]
forall a. [a] -> [a]
reverse [[Inline]]
ws, [[Inline]] -> [[Inline]]
forall a. [a] -> [a]
reverse [[Inline]]
vs)
            else case ([Inline] -> Bool) -> [[Inline]] -> ([[Inline]], [[Inline]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break [Inline] -> Bool
isCapitalized [[Inline]]
vonlast of
                        (vs :: [[Inline]]
vs@([Inline]
_:[[Inline]]
_), []) -> ([[Inline]] -> [[Inline]]
forall a. [a] -> [a]
init [[Inline]]
vs, [[[Inline]] -> [Inline]
forall a. [a] -> a
last [[Inline]]
vs])
                        ([[Inline]]
vs, [[Inline]]
ws)       -> ([[Inline]]
vs, [[Inline]]
ws)
  let prefix :: Text
prefix = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [[Inline]]
von
  let family :: Text
family = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [[Inline]]
lastname
  let suffix :: Text
suffix = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [[Inline]]
jr
  let given :: Text
given = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [[Inline]]
first
  Name -> RWST Item () BibState BibParser Name
forall (m :: * -> *) a. Monad m => a -> m a
return
    Name :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Bool
-> Bool
-> Maybe Text
-> Name
Name {  nameFamily :: Maybe Text
nameFamily              = if Text -> Bool
T.null Text
family
                                         then Maybe Text
forall a. Maybe a
Nothing
                                         else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
family
          , nameGiven :: Maybe Text
nameGiven               = if Text -> Bool
T.null Text
given
                                         then Maybe Text
forall a. Maybe a
Nothing
                                         else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
given
          , nameDroppingParticle :: Maybe Text
nameDroppingParticle    = if Bool
useprefix Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
prefix
                                         then Maybe Text
forall a. Maybe a
Nothing
                                         else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prefix
          , nameNonDroppingParticle :: Maybe Text
nameNonDroppingParticle = if Bool
useprefix Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
prefix)
                                         then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prefix
                                         else Maybe Text
forall a. Maybe a
Nothing
          , nameSuffix :: Maybe Text
nameSuffix              = if Text -> Bool
T.null Text
suffix
                                         then Maybe Text
forall a. Maybe a
Nothing
                                         else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
suffix
          , nameLiteral :: Maybe Text
nameLiteral             = Maybe Text
forall a. Maybe a
Nothing
          , nameCommaSuffix :: Bool
nameCommaSuffix         = Bool
usecomma
          , nameStaticOrdering :: Bool
nameStaticOrdering      = Bool
False
          }

splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen Char -> Bool
_ [] = []
splitStrWhen Char -> Bool
p (Str Text
xs : [Inline]
ys) = (Text -> Inline) -> [Text] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inline
Str (Text -> [Text]
go Text
xs) [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen Char -> Bool
p [Inline]
ys
  where go :: Text -> [Text]
go Text
s =
          let (Text
w,Text
z) = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
p Text
s
           in if Text -> Bool
T.null Text
z
                 then if Text -> Bool
T.null Text
w
                         then []
                         else [Text
w]
                 else if Text -> Bool
T.null Text
w
                         then (Int -> Text -> Text
T.take Int
1 Text
z Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
go (Int -> Text -> Text
T.drop Int
1 Text
z))
                         else (Text
w Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Text -> Text
T.take Int
1 Text
z Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
go (Int -> Text -> Text
T.drop Int
1 Text
z))
splitStrWhen Char -> Bool
p (Inline
x : [Inline]
ys) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen Char -> Bool
p [Inline]
ys

ordinalize :: Locale -> Text -> Text
ordinalize :: Locale -> Text -> Text
ordinalize Locale
locale Text
n =
  let terms :: Map Text [(Term, Text)]
terms = Locale -> Map Text [(Term, Text)]
localeTerms Locale
locale
      pad0 :: Text -> Text
pad0 Text
t = case Text -> Int
T.length Text
t of
                 Int
0 -> Text
"00"
                 Int
1 -> Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                 Int
_ -> Text
t
   in case Text -> Map Text [(Term, Text)] -> Maybe [(Term, Text)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
"ordinal-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
pad0 Text
n) Map Text [(Term, Text)]
terms Maybe [(Term, Text)]
-> Maybe [(Term, Text)] -> Maybe [(Term, Text)]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
           Text -> Map Text [(Term, Text)] -> Maybe [(Term, Text)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"ordinal" Map Text [(Term, Text)]
terms of
        Maybe [(Term, Text)]
Nothing    -> Text
n
        Just []    -> Text
n
        Just ((Term, Text)
t:[(Term, Text)]
_) -> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Term, Text) -> Text
forall a b. (a, b) -> b
snd (Term, Text)
t

isCapitalized :: [Inline] -> Bool
isCapitalized :: [Inline] -> Bool
isCapitalized (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
c,Text
cs)) : [Inline]
rest)
  | Char -> Bool
isUpper Char
c = Bool
True
  | Char -> Bool
isDigit Char
c = [Inline] -> Bool
isCapitalized (Text -> Inline
Str Text
cs Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
rest)
  | Bool
otherwise = Bool
False
isCapitalized (Inline
_:[Inline]
rest) = [Inline] -> Bool
isCapitalized [Inline]
rest
isCapitalized [] = Bool
True

optionSet :: Text -> Options -> Bool
optionSet :: Text -> [(Text, Text)] -> Bool
optionSet Text
key [(Text, Text)]
opts = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
key [(Text, Text)]
opts of
                      Just Text
"true" -> Bool
True
                      Just Text
s      -> Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall a. Monoid a => a
mempty
                      Maybe Text
_           -> Bool
False

getTypeAndGenre :: Bib (Text, Maybe Text)
getTypeAndGenre :: Bib (Text, Maybe Text)
getTypeAndGenre = do
  Lang
lang <- (BibState -> Lang) -> RWST Item () BibState BibParser Lang
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BibState -> Lang
localeLang
  Text
et <- (Item -> Text) -> RWST Item () BibState BibParser Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Item -> Text
entryType
  Text
reftype' <- Lang -> Text -> Text
resolveKey' Lang
lang (Text -> Text)
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RWST Item () BibState BibParser Text
getRawField Text
"type"
         RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty
  Text
st <- Text -> RWST Item () BibState BibParser Text
getRawField Text
"entrysubtype" RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty
  Bool
isEvent <- (Bool
True Bool
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> RWST Item () BibState BibParser Text
getRawField Text
"eventdate"
                     RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Text
getRawField Text
"eventtitle"
                     RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
-> RWST Item () BibState BibParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> RWST Item () BibState BibParser Text
getRawField Text
"venue")) RWST Item () BibState BibParser Bool
-> RWST Item () BibState BibParser Bool
-> RWST Item () BibState BibParser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> RWST Item () BibState BibParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  let reftype :: Text
reftype =
        case Text
et of
           Text
"article"
             | Text
st Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"magazine"  -> Text
"article-magazine"
             | Text
st Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"newspaper" -> Text
"article-newspaper"
             | Bool
otherwise         -> Text
"article-journal"
           Text
"book"                -> Text
"book"
           Text
"booklet"             -> Text
"pamphlet"
           Text
"bookinbook"          -> Text
"chapter"
           Text
"collection"          -> Text
"book"
           Text
"dataset"             -> Text
"dataset"
           Text
"electronic"          -> Text
"webpage"
           Text
"inbook"              -> Text
"chapter"
           Text
"incollection"        -> Text
"chapter"
           Text
"inreference"         -> Text
"entry-encyclopedia"
           Text
"inproceedings"       -> Text
"paper-conference"
           Text
"manual"              -> Text
"book"
           Text
"mastersthesis"       -> Text
"thesis"
           Text
"misc"                -> Text
""
           Text
"mvbook"              -> Text
"book"
           Text
"mvcollection"        -> Text
"book"
           Text
"mvproceedings"       -> Text
"book"
           Text
"mvreference"         -> Text
"book"
           Text
"online"              -> Text
"webpage"
           Text
"patent"              -> Text
"patent"
           Text
"periodical"
             | Text
st Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"magazine"  -> Text
"article-magazine"
             | Text
st Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"newspaper" -> Text
"article-newspaper"
             | Bool
otherwise         -> Text
"article-journal"
           Text
"phdthesis"           -> Text
"thesis"
           Text
"proceedings"         -> Text
"book"
           Text
"reference"           -> Text
"book"
           Text
"report"              -> Text
"report"
           Text
"software"            -> Text
"book"    -- no "software" type in CSL
           Text
"suppbook"            -> Text
"chapter"
           Text
"suppcollection"      -> Text
"chapter"
           Text
"suppperiodical"
             | Text
st Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"magazine"  -> Text
"article-magazine"
             | Text
st Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"newspaper" -> Text
"article-newspaper"
             | Bool
otherwise         -> Text
"article-journal"
           Text
"techreport"          -> Text
"report"
           Text
"thesis"              -> Text
"thesis"
           Text
"unpublished"         -> if Bool
isEvent then Text
"speech" else Text
"manuscript"
           Text
"www"                 -> Text
"webpage"
           -- biblatex, "unsupported"
           Text
"artwork"             -> Text
"graphic"
           Text
"audio"               -> Text
"song"    -- for audio *recordings*
           Text
"commentary"          -> Text
"book"
           Text
"image"               -> Text
"graphic"   -- or "figure" ?
           Text
"jurisdiction"        -> Text
"legal_case"
           Text
"legislation"         -> Text
"legislation"  -- or "bill" ?
           Text
"legal"               -> Text
"treaty"
           Text
"letter"              -> Text
"personal_communication"
           Text
"movie"               -> Text
"motion_picture"
           Text
"music"               -> Text
"song"        -- for musical *recordings*
           Text
"performance"         -> Text
"speech"
           Text
"review"              -> Text
"review"      -- or "review-book" ?
           Text
"standard"            -> Text
"legislation"
           Text
"video"               -> Text
"motion_picture"
           -- biblatex-apa:
           Text
"data"                -> Text
"dataset"
           Text
"letters"             -> Text
"personal_communication"
           Text
"newsarticle"         -> Text
"article-newspaper"
           Text
_                     -> Text
""

  let refgenre :: Maybe Text
refgenre =
        case Text
et of
          Text
"mastersthesis"  -> if Text -> Bool
T.null Text
reftype'
                                 then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Lang -> Text -> Text
resolveKey' Lang
lang Text
"mathesis"
                                 else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
reftype'
          Text
"phdthesis"      -> if Text -> Bool
T.null Text
reftype'
                                 then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Lang -> Text -> Text
resolveKey' Lang
lang Text
"phdthesis"
                                 else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
reftype'
          Text
_                -> if Text -> Bool
T.null Text
reftype'
                                 then Maybe Text
forall a. Maybe a
Nothing
                                 else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
reftype'
  (Text, Maybe Text) -> Bib (Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
reftype, Maybe Text
refgenre)


-- transformKey source target key
-- derived from Appendix C of bibtex manual
transformKey :: Text -> Text -> Text -> [Text]
transformKey :: Text -> Text -> Text -> [Text]
transformKey Text
_ Text
_ Text
"ids"            = []
transformKey Text
_ Text
_ Text
"crossref"       = []
transformKey Text
_ Text
_ Text
"xref"           = []
transformKey Text
_ Text
_ Text
"entryset"       = []
transformKey Text
_ Text
_ Text
"entrysubtype"   = []
transformKey Text
_ Text
_ Text
"execute"        = []
transformKey Text
_ Text
_ Text
"label"          = []
transformKey Text
_ Text
_ Text
"options"        = []
transformKey Text
_ Text
_ Text
"presort"        = []
transformKey Text
_ Text
_ Text
"related"        = []
transformKey Text
_ Text
_ Text
"relatedoptions" = []
transformKey Text
_ Text
_ Text
"relatedstring"  = []
transformKey Text
_ Text
_ Text
"relatedtype"    = []
transformKey Text
_ Text
_ Text
"shorthand"      = []
transformKey Text
_ Text
_ Text
"shorthandintro" = []
transformKey Text
_ Text
_ Text
"sortkey"        = []
transformKey Text
x Text
y Text
"author"
  | Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"mvbook", Text
"book"] Bool -> Bool -> Bool
&&
    Text
y Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"inbook", Text
"bookinbook", Text
"suppbook"] = [Text
"bookauthor", Text
"author"]
-- note: this next clause is not in the biblatex manual, but it makes
-- sense in the context of CSL conversion:
transformKey Text
x Text
y Text
"author"
  | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"mvbook" Bool -> Bool -> Bool
&& Text
y Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"book" = [Text
"bookauthor", Text
"author"]
transformKey Text
"mvbook" Text
y Text
z
  | Text
y Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"book", Text
"inbook", Text
"bookinbook", Text
"suppbook"] = Text -> [Text]
standardTrans Text
z
transformKey Text
x Text
y Text
z
  | Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"mvcollection", Text
"mvreference"] Bool -> Bool -> Bool
&&
    Text
y Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"collection", Text
"reference", Text
"incollection", Text
"inreference",
               Text
"suppcollection"] = Text -> [Text]
standardTrans Text
z
transformKey Text
"mvproceedings" Text
y Text
z
  | Text
y Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"proceedings", Text
"inproceedings"] = Text -> [Text]
standardTrans Text
z
transformKey Text
"book" Text
y Text
z
  | Text
y Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"inbook", Text
"bookinbook", Text
"suppbook"] = Text -> [Text]
bookTrans Text
z
transformKey Text
x Text
y Text
z
  | Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"collection", Text
"reference"] Bool -> Bool -> Bool
&&
    Text
y Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"incollection", Text
"inreference", Text
"suppcollection"] = Text -> [Text]
bookTrans Text
z
transformKey Text
"proceedings" Text
"inproceedings" Text
z = Text -> [Text]
bookTrans Text
z
transformKey Text
"periodical" Text
y Text
z
  | Text
y Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"article", Text
"suppperiodical"] =
  case Text
z of
       Text
"title"          -> [Text
"journaltitle"]
       Text
"subtitle"       -> [Text
"journalsubtitle"]
       Text
"shorttitle"     -> []
       Text
"sorttitle"      -> []
       Text
"indextitle"     -> []
       Text
"indexsorttitle" -> []
       Text
_                -> [Text
z]
transformKey Text
_ Text
_ Text
x                = [Text
x]

standardTrans :: Text -> [Text]
standardTrans :: Text -> [Text]
standardTrans Text
z =
  case Text
z of
       Text
"title"          -> [Text
"maintitle"]
       Text
"subtitle"       -> [Text
"mainsubtitle"]
       Text
"titleaddon"     -> [Text
"maintitleaddon"]
       Text
"shorttitle"     -> []
       Text
"sorttitle"      -> []
       Text
"indextitle"     -> []
       Text
"indexsorttitle" -> []
       Text
_                -> [Text
z]

bookTrans :: Text -> [Text]
bookTrans :: Text -> [Text]
bookTrans Text
z =
  case Text
z of
       Text
"title"          -> [Text
"booktitle"]
       Text
"subtitle"       -> [Text
"booksubtitle"]
       Text
"titleaddon"     -> [Text
"booktitleaddon"]
       Text
"shorttitle"     -> []
       Text
"sorttitle"      -> []
       Text
"indextitle"     -> []
       Text
"indexsorttitle" -> []
       Text
_                -> [Text
z]

resolveKey :: Lang -> Inlines -> Inlines
resolveKey :: Lang -> Inlines -> Inlines
resolveKey Lang
lang Inlines
ils = (Inline -> Inline) -> Inlines -> Inlines
forall a b. Walkable a b => (a -> a) -> b -> b
Walk.walk Inline -> Inline
go Inlines
ils
  where go :: Inline -> Inline
go (Str Text
s) = Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Lang -> Text -> Text
resolveKey' Lang
lang Text
s
        go Inline
x       = Inline
x

resolveKey' :: Lang -> Text -> Text
resolveKey' :: Lang -> Text -> Text
resolveKey' Lang
lang Text
k =
  case Text
-> Map Text (Map Text (Text, Text))
-> Maybe (Map Text (Text, Text))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Lang -> Text
langLanguage Lang
lang) Map Text (Map Text (Text, Text))
biblatexStringMap Maybe (Map Text (Text, Text))
-> (Map Text (Text, Text) -> Maybe (Text, Text))
-> Maybe (Text, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Text -> Map Text (Text, Text) -> Maybe (Text, Text)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Text
T.toLower Text
k) of
    Maybe (Text, Text)
Nothing     -> Text
k
    Just (Text
x, Text
_) -> (PandocError -> Text)
-> ([Block] -> Text) -> Either PandocError [Block] -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> PandocError -> Text
forall a b. a -> b -> a
const Text
k) [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify (Either PandocError [Block] -> Text)
-> Either PandocError [Block] -> Text
forall a b. (a -> b) -> a -> b
$ Lang -> Text -> Either PandocError [Block]
parseLaTeX Lang
lang Text
x

convertEnDash :: Inline -> Inline
convertEnDash :: Inline -> Inline
convertEnDash (Str Text
s) = Text -> Inline
Str ((Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'–' then Char
'-' else Char
c) Text
s)
convertEnDash Inline
x       = Inline
x