{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module Citeproc.Style
  ( parseStyle
  , mergeLocales
  )
where
import Citeproc.Types
import Citeproc.Locale
import Citeproc.Element
import Data.Text (Text)
import Control.Monad (foldM)
import Control.Applicative ((<|>))
import qualified Text.XML as X
import qualified Data.Text as T
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing)
import Data.Default (def)
import qualified Data.Text.Lazy as TL
import Control.Monad.Trans.Reader (local)

-- | Merge the locale specified by the first parameter, if any,
-- with the default locale of the style and locale definitions
-- in the style.  The locale specified by the first parameter
-- overrides the style's defaults when there is a conflict.
mergeLocales :: Maybe Lang -> Style a -> Locale
mergeLocales :: forall a. Maybe Lang -> Style a -> Locale
mergeLocales Maybe Lang
mblang Style a
style =
  [Locale] -> Locale
forall a. Monoid a => [a] -> a
mconcat [Locale]
stylelocales Locale -> Locale -> Locale
forall a. Semigroup a => a -> a -> a
<> Locale
deflocale -- left-biased union
 where
  getUSLocale :: Locale
getUSLocale = case Lang -> Either CiteprocError Locale
getLocale (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
JustText
"US") [] [] []) of
                  Right Locale
l -> Locale
l
                  Left CiteprocError
_  -> Locale
forall a. Monoid a => a
mempty
  lang :: Lang
lang = Lang -> Maybe Lang -> Lang
forall a. a -> Maybe a -> a
fromMaybe (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
JustText
"US") [] [] []) (Maybe Lang -> Lang) -> Maybe Lang -> Lang
forall a b. (a -> b) -> a -> b
$
              Maybe Lang
mblang Maybe Lang -> Maybe Lang -> Maybe Lang
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StyleOptions -> Maybe Lang
styleDefaultLocale (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style)
  deflocale :: Locale
deflocale = case Lang -> Either CiteprocError Locale
getLocale Lang
lang of
                 Right Locale
l -> Locale
l
                 Left CiteprocError
_  -> Locale
getUSLocale
  primlang :: Maybe Lang
primlang = Lang -> Maybe Lang
getPrimaryDialect Lang
lang
  stylelocales :: [Locale]
stylelocales =  -- exact match to lang gets precedence
                 [Locale
l | Locale
l <- Style a -> [Locale]
forall a. Style a -> [Locale]
styleLocales Style a
style
                    , Locale -> Maybe Lang
localeLanguage Locale
l Maybe Lang -> Maybe Lang -> Bool
forall a. Eq a => a -> a -> Bool
== Lang -> Maybe Lang
forall a. a -> Maybe a
Just Lang
lang] [Locale] -> [Locale] -> [Locale]
forall a. [a] -> [a] -> [a]
++
                 -- then match to primary dialect, if different
                 [Locale
l | Maybe Lang
primlang Maybe Lang -> Maybe Lang -> Bool
forall a. Eq a => a -> a -> Bool
/= Lang -> Maybe Lang
forall a. a -> Maybe a
Just Lang
lang
                    , Locale
l <- Style a -> [Locale]
forall a. Style a -> [Locale]
styleLocales Style a
style
                    , Locale -> Maybe Lang
localeLanguage Locale
l Maybe Lang -> Maybe Lang -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Lang
primlang] [Locale] -> [Locale] -> [Locale]
forall a. [a] -> [a] -> [a]
++
                 -- then match to the two letter language
                 [Locale
l | Locale
l <- Style a -> [Locale]
forall a. Style a -> [Locale]
styleLocales Style a
style
                    , (Lang -> Maybe Text
langRegion (Lang -> Maybe Text) -> Maybe Lang -> Maybe (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Locale -> Maybe Lang
localeLanguage Locale
l) Maybe (Maybe Text) -> Maybe (Maybe Text) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing
                    , (Lang -> Text
langLanguage (Lang -> Text) -> Maybe Lang -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Locale -> Maybe Lang
localeLanguage Locale
l) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==
                      Text -> Maybe Text
forall a. a -> Maybe a
Just (Lang -> Text
langLanguage Lang
lang)] [Locale] -> [Locale] -> [Locale]
forall a. [a] -> [a] -> [a]
++
                 -- then locale with no lang
                 [Locale
l | Locale
l <- Style a -> [Locale]
forall a. Style a -> [Locale]
styleLocales Style a
style
                    , Maybe Lang -> Bool
forall a. Maybe a -> Bool
isNothing (Locale -> Maybe Lang
localeLanguage Locale
l)]



-- | Parse an XML stylesheet into a 'Style'.  The first parameter
-- is a function that retrieves the text of the independent parent
-- of a dependent style, given a URL.  (This might make an HTTP
-- request or retrieve the style locally.)  If you aren't using
-- dependent styles, you may use `(\_ -> return mempty)`.
parseStyle :: Monad m
           => (Text -> m Text) -- ^ Function that takes a URL and retrieves
                               -- text of independent parent
           -> Text             -- ^ Contents of XML stylesheet
           -> m (Either CiteprocError (Style a))
parseStyle :: forall (m :: * -> *) a.
Monad m =>
(Text -> m Text) -> Text -> m (Either CiteprocError (Style a))
parseStyle Text -> m Text
getIndependentParent Text
t =
  -- first, see if it's a dependent or independent style
  case ParseSettings -> Text -> Either SomeException Document
X.parseText ParseSettings
forall a. Default a => a
def (Text -> Text
TL.fromStrict Text
t) of
    Left SomeException
e  -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CiteprocError (Style a)
 -> m (Either CiteprocError (Style a)))
-> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a b. (a -> b) -> a -> b
$ CiteprocError -> Either CiteprocError (Style a)
forall a b. a -> Either a b
Left (CiteprocError -> Either CiteprocError (Style a))
-> CiteprocError -> Either CiteprocError (Style a)
forall a b. (a -> b) -> a -> b
$ Text -> CiteprocError
CiteprocXMLError (String -> Text
T.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))
    Right Document
n -> do
      let attr :: Attributes
attr = Element -> Attributes
getAttributes (Element -> Attributes) -> Element -> Attributes
forall a b. (a -> b) -> a -> b
$ Document -> Element
X.documentRoot Document
n
      let defaultLocale :: Maybe Lang
defaultLocale =
            case Text -> Attributes -> Maybe Text
lookupAttribute Text
"default-locale" Attributes
attr of
              Maybe Text
Nothing  -> Maybe Lang
forall a. Maybe a
Nothing
              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
      let links :: [Element]
links = (Element -> [Element]) -> [Element] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Element -> [Element]
getChildren Text
"link") ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren Text
"info"
                    (Document -> Element
X.documentRoot Document
n)
      case [Element -> Attributes
getAttributes Element
l
              | Element
l <- [Element]
links
              , Text -> Attributes -> Maybe Text
lookupAttribute Text
"rel" (Element -> Attributes
getAttributes Element
l) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==
                  Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"independent-parent" ] of
        [] -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CiteprocError (Style a)
 -> m (Either CiteprocError (Style a)))
-> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a b. (a -> b) -> a -> b
$
               ElementParser (Style a) -> Either CiteprocError (Style a)
forall a. ElementParser a -> Either CiteprocError a
runElementParser (ElementParser (Style a) -> Either CiteprocError (Style a))
-> ElementParser (Style a) -> Either CiteprocError (Style a)
forall a b. (a -> b) -> a -> b
$ Maybe Lang -> Element -> ElementParser (Style a)
forall a. Maybe Lang -> Element -> ElementParser (Style a)
pStyle Maybe Lang
defaultLocale (Element -> ElementParser (Style a))
-> Element -> ElementParser (Style a)
forall a b. (a -> b) -> a -> b
$ Document -> Element
X.documentRoot Document
n
        (Attributes
lattr:[Attributes]
_) ->
          case Text -> Attributes -> Maybe Text
lookupAttribute Text
"href" Attributes
lattr of
            Maybe Text
Nothing -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CiteprocError (Style a)
 -> m (Either CiteprocError (Style a)))
-> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a b. (a -> b) -> a -> b
$ CiteprocError -> Either CiteprocError (Style a)
forall a b. a -> Either a b
Left (CiteprocError -> Either CiteprocError (Style a))
-> CiteprocError -> Either CiteprocError (Style a)
forall a b. (a -> b) -> a -> b
$ Text -> CiteprocError
CiteprocXMLError
                          Text
"No href attribute on link to parent style"
            Just Text
url -> do -- get parent style
              Text
parentTxt <- Text -> m Text
getIndependentParent Text
url
              case ParseSettings -> Text -> Either SomeException Document
X.parseText ParseSettings
forall a. Default a => a
def (Text -> Text
TL.fromStrict Text
parentTxt) of
                Left SomeException
e -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CiteprocError (Style a)
 -> m (Either CiteprocError (Style a)))
-> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a b. (a -> b) -> a -> b
$ CiteprocError -> Either CiteprocError (Style a)
forall a b. a -> Either a b
Left (CiteprocError -> Either CiteprocError (Style a))
-> CiteprocError -> Either CiteprocError (Style a)
forall a b. (a -> b) -> a -> b
$ Text -> CiteprocError
CiteprocXMLError (String -> Text
T.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))
                Right Document
n' -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CiteprocError (Style a)
 -> m (Either CiteprocError (Style a)))
-> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style a))
forall a b. (a -> b) -> a -> b
$
                 ElementParser (Style a) -> Either CiteprocError (Style a)
forall a. ElementParser a -> Either CiteprocError a
runElementParser (ElementParser (Style a) -> Either CiteprocError (Style a))
-> ElementParser (Style a) -> Either CiteprocError (Style a)
forall a b. (a -> b) -> a -> b
$ Maybe Lang -> Element -> ElementParser (Style a)
forall a. Maybe Lang -> Element -> ElementParser (Style a)
pStyle Maybe Lang
defaultLocale (Element -> ElementParser (Style a))
-> Element -> ElementParser (Style a)
forall a b. (a -> b) -> a -> b
$ Document -> Element
X.documentRoot Document
n'

pStyle :: Maybe Lang -> X.Element -> ElementParser (Style a)
pStyle :: forall a. Maybe Lang -> Element -> ElementParser (Style a)
pStyle Maybe Lang
defaultLocale Element
node = do
  let attrmap :: Map Name Text
attrmap = Element -> Map Name Text
getInheritableNameAttributes Element
node
  (Map Name Text -> Map Name Text)
-> ElementParser (Style a) -> ElementParser (Style a)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (Map Name Text -> Map Name Text -> Map Name Text
forall a. Semigroup a => a -> a -> a
<> Map Name Text
attrmap) (ElementParser (Style a) -> ElementParser (Style a))
-> ElementParser (Style a) -> ElementParser (Style a)
forall a b. (a -> b) -> a -> b
$ do
    let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
    Map Text [Element]
macroMap <- [(Text, [Element])] -> Map Text [Element]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, [Element])] -> Map Text [Element])
-> ReaderT
     (Map Name Text) (Except CiteprocError) [(Text, [Element])]
-> ReaderT
     (Map Name Text) (Except CiteprocError) (Map Text [Element])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element
 -> ReaderT
      (Map Name Text) (Except CiteprocError) (Text, [Element]))
-> [Element]
-> ReaderT
     (Map Name Text) (Except CiteprocError) [(Text, [Element])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Text, [Element])
pMacro (Text -> Element -> [Element]
getChildren Text
"macro" Element
node)
    (Attributes
cattr, Layout a
citations)
        <- case Text -> Element -> [Element]
getChildren Text
"citation" Element
node of
                   [Element
n] -> (Element -> Attributes
getAttributes Element
n,) (Layout a -> (Attributes, Layout a))
-> ReaderT (Map Name Text) (Except CiteprocError) (Layout a)
-> ReaderT
     (Map Name Text) (Except CiteprocError) (Attributes, Layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [Element]
-> Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Layout a)
forall a. Map Text [Element] -> Element -> ElementParser (Layout a)
pLayout Map Text [Element]
macroMap Element
n
                   []  -> String
-> ReaderT
     (Map Name Text) (Except CiteprocError) (Attributes, Layout a)
forall a. String -> ElementParser a
parseFailure String
"No citation element present"
                   [Element]
_   -> String
-> ReaderT
     (Map Name Text) (Except CiteprocError) (Attributes, Layout a)
forall a. String -> ElementParser a
parseFailure String
"More than one citation element present"
    (Attributes
battr, Maybe (Layout a)
bibliography) <- case Text -> Element -> [Element]
getChildren Text
"bibliography" Element
node of
                      [Element
n] -> (\Layout a
z -> (Element -> Attributes
getAttributes Element
n, Layout a -> Maybe (Layout a)
forall a. a -> Maybe a
Just Layout a
z))
                                (Layout a -> (Attributes, Maybe (Layout a)))
-> ReaderT (Map Name Text) (Except CiteprocError) (Layout a)
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     (Attributes, Maybe (Layout a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [Element]
-> Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Layout a)
forall a. Map Text [Element] -> Element -> ElementParser (Layout a)
pLayout Map Text [Element]
macroMap Element
n
                      []  -> (Attributes, Maybe (Layout a))
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     (Attributes, Maybe (Layout a))
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attributes
forall a. Monoid a => a
mempty, Maybe (Layout a)
forall a. Maybe a
Nothing)
                      [Element]
_   -> String
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     (Attributes, Maybe (Layout a))
forall a. String -> ElementParser a
parseFailure
                               String
"More than one bibliography element present"

    let disambiguateGivenNameRule :: GivenNameDisambiguationRule
disambiguateGivenNameRule =
          case Text -> Attributes -> Maybe Text
lookupAttribute Text
"givenname-disambiguation-rule" Attributes
cattr of
            Just Text
"all-names" -> GivenNameDisambiguationRule
AllNames
            Just Text
"all-names-with-initials" -> GivenNameDisambiguationRule
AllNamesWithInitials
            Just Text
"primary-name" -> GivenNameDisambiguationRule
PrimaryName
            Just Text
"primary-name-with-initials" -> GivenNameDisambiguationRule
PrimaryNameWithInitials
            Maybe Text
_ -> GivenNameDisambiguationRule
ByCite

    let disambigStrategy :: DisambiguationStrategy
disambigStrategy =
          DisambiguationStrategy
          { disambiguateAddNames :: Bool
disambiguateAddNames =
              Text -> Attributes -> Maybe Text
lookupAttribute Text
"disambiguate-add-names" Attributes
cattr Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"true"
          , disambiguateAddGivenNames :: Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames =
              case Text -> Attributes -> Maybe Text
lookupAttribute Text
"disambiguate-add-givenname" Attributes
cattr of
                Just Text
"true" -> GivenNameDisambiguationRule -> Maybe GivenNameDisambiguationRule
forall a. a -> Maybe a
Just GivenNameDisambiguationRule
disambiguateGivenNameRule
                Maybe Text
_           -> Maybe GivenNameDisambiguationRule
forall a. Maybe a
Nothing
          , disambiguateAddYearSuffix :: Bool
disambiguateAddYearSuffix =
             Text -> Attributes -> Maybe Text
lookupAttribute Text
"disambiguate-add-year-suffix" Attributes
cattr Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==
               Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"true"
          }

    let hasYearSuffixVariable :: Element a -> Bool
hasYearSuffixVariable
          (Element (EText (TextVariable VariableForm
_ Variable
"year-suffix")) Formatting
_) = Bool
True
        hasYearSuffixVariable
          (Element (EGroup Bool
_ [Element a]
es) Formatting
_) = (Element a -> Bool) -> [Element a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Element a -> Bool
hasYearSuffixVariable [Element a]
es
        hasYearSuffixVariable
          (Element (EChoose []) Formatting
_) = Bool
False
        hasYearSuffixVariable
          (Element (EChoose ((Match
_,[Condition]
_,[Element a]
es):[(Match, [Condition], [Element a])]
conds)) Formatting
f) =
            (Element a -> Bool) -> [Element a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Element a -> Bool
hasYearSuffixVariable [Element a]
es Bool -> Bool -> Bool
||
              Element a -> Bool
hasYearSuffixVariable (ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element ([(Match, [Condition], [Element a])] -> ElementType a
forall a. [(Match, [Condition], [Element a])] -> ElementType a
EChoose [(Match, [Condition], [Element a])]
conds) Formatting
f)
        hasYearSuffixVariable Element a
_ = Bool
False
    let usesYearSuffixVariable :: Bool
usesYearSuffixVariable =
          (Element a -> Bool) -> [Element a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Element a -> Bool
forall {a}. Element a -> Bool
hasYearSuffixVariable ([Element a] -> Bool) -> [Element a] -> Bool
forall a b. (a -> b) -> a -> b
$
            Layout a -> [Element a]
forall a. Layout a -> [Element a]
layoutElements Layout a
citations [Element a] -> [Element a] -> [Element a]
forall a. [a] -> [a] -> [a]
++ [Element a]
-> (Layout a -> [Element a]) -> Maybe (Layout a) -> [Element a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Layout a -> [Element a]
forall a. Layout a -> [Element a]
layoutElements Maybe (Layout a)
bibliography

    let sOpts :: StyleOptions
sOpts = StyleOptions
                 { styleIsNoteStyle :: Bool
styleIsNoteStyle =
                     case Text -> Attributes -> Maybe Text
lookupAttribute Text
"class" Attributes
attr of
                       Just Text
"note" -> Bool
True
                       Maybe Text
Nothing     -> Bool
True
                       Maybe Text
_           -> Bool
False
                 , styleDefaultLocale :: Maybe Lang
styleDefaultLocale = Maybe Lang
defaultLocale
                 , styleDemoteNonDroppingParticle :: DemoteNonDroppingParticle
styleDemoteNonDroppingParticle =
                     case Text -> Attributes -> Maybe Text
lookupAttribute Text
"demote-non-dropping-particle" Attributes
attr of
                       Just Text
"never"     -> DemoteNonDroppingParticle
DemoteNever
                       Just Text
"sort-only" -> DemoteNonDroppingParticle
DemoteSortOnly
                       Maybe Text
_                -> DemoteNonDroppingParticle
DemoteDisplayAndSort
                 , styleInitializeWithHyphen :: Bool
styleInitializeWithHyphen =
                   Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true") (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$
                     Text -> Attributes -> Maybe Text
lookupAttribute Text
"initialize-with-hyphen" Attributes
attr
                 , stylePageRangeFormat :: Maybe PageRangeFormat
stylePageRangeFormat =
                     case Text -> Attributes -> Maybe Text
lookupAttribute Text
"page-range-format" Attributes
attr of
                       Just Text
"chicago"     -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeChicago15
                       -- chicago is an alias for chicago-15, but this
                       -- will change to chicago-16 in v1.1
                       Just Text
"chicago-15"  -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeChicago15
                       Just Text
"chicago-16"  -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeChicago16
                       Just Text
"expanded"    -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeExpanded
                       Just Text
"minimal"     -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeMinimal
                       Just Text
"minimal-two" -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeMinimalTwo
                       Maybe Text
_                  -> Maybe PageRangeFormat
forall a. Maybe a
Nothing
                 , stylePageRangeDelimiter :: Maybe Text
stylePageRangeDelimiter =
                     Text -> Attributes -> Maybe Text
lookupAttribute Text
"page-range-delimiter" Attributes
attr
                 , styleDisambiguation :: DisambiguationStrategy
styleDisambiguation = DisambiguationStrategy
disambigStrategy
                 , styleNearNoteDistance :: Maybe Int
styleNearNoteDistance =
                     Text -> Attributes -> Maybe Text
lookupAttribute Text
"near-note-distance" Attributes
attr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readAsInt
                 , styleCiteGroupDelimiter :: Maybe Text
styleCiteGroupDelimiter =
                     Text -> Attributes -> Maybe Text
lookupAttribute Text
"cite-group-delimiter" Attributes
cattr Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     (Text
", " Text -> Maybe Text -> Maybe Text
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Attributes -> Maybe Text
lookupAttribute Text
"collapse" Attributes
cattr)
                 , styleLineSpacing :: Maybe Int
styleLineSpacing =
                     Text -> Attributes -> Maybe Text
lookupAttribute Text
"line-spacing" Attributes
battr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readAsInt
                 , styleEntrySpacing :: Maybe Int
styleEntrySpacing =
                     Text -> Attributes -> Maybe Text
lookupAttribute Text
"entry-spacing" Attributes
battr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readAsInt
                 , styleHangingIndent :: Bool
styleHangingIndent =
                     Text -> Attributes -> Maybe Text
lookupAttribute Text
"hanging-indent" Attributes
battr Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"true"
                 , styleSecondFieldAlign :: Maybe SecondFieldAlign
styleSecondFieldAlign =
                     case Text -> Attributes -> Maybe Text
lookupAttribute Text
"second-field-align" Attributes
battr of
                       Just Text
"flush" -> SecondFieldAlign -> Maybe SecondFieldAlign
forall a. a -> Maybe a
Just SecondFieldAlign
SecondFieldAlignFlush
                       Just Text
"margin" -> SecondFieldAlign -> Maybe SecondFieldAlign
forall a. a -> Maybe a
Just SecondFieldAlign
SecondFieldAlignMargin
                       Maybe Text
_ -> Maybe SecondFieldAlign
forall a. Maybe a
Nothing
                 , styleSubsequentAuthorSubstitute :: Maybe SubsequentAuthorSubstitute
styleSubsequentAuthorSubstitute =
                     case Text -> Attributes -> Maybe Text
lookupAttribute Text
"subsequent-author-substitute"
                          Attributes
battr of
                       Maybe Text
Nothing -> Maybe SubsequentAuthorSubstitute
forall a. Maybe a
Nothing
                       Just Text
t  -> SubsequentAuthorSubstitute -> Maybe SubsequentAuthorSubstitute
forall a. a -> Maybe a
Just (SubsequentAuthorSubstitute -> Maybe SubsequentAuthorSubstitute)
-> SubsequentAuthorSubstitute -> Maybe SubsequentAuthorSubstitute
forall a b. (a -> b) -> a -> b
$
                         Text
-> SubsequentAuthorSubstituteRule -> SubsequentAuthorSubstitute
SubsequentAuthorSubstitute Text
t
                         (SubsequentAuthorSubstituteRule -> SubsequentAuthorSubstitute)
-> SubsequentAuthorSubstituteRule -> SubsequentAuthorSubstitute
forall a b. (a -> b) -> a -> b
$ case Text -> Attributes -> Maybe Text
lookupAttribute
                             Text
"subsequent-author-substitute-rule" Attributes
battr of
                               Just Text
"complete-each" -> SubsequentAuthorSubstituteRule
CompleteEach
                               Just Text
"partial-each" -> SubsequentAuthorSubstituteRule
PartialEach
                               Just Text
"partial-first" -> SubsequentAuthorSubstituteRule
PartialFirst
                               Maybe Text
_  -> SubsequentAuthorSubstituteRule
CompleteAll
                 , styleUsesYearSuffixVariable :: Bool
styleUsesYearSuffixVariable = Bool
usesYearSuffixVariable
                 }
    [Locale]
locales <- (Element -> ReaderT (Map Name Text) (Except CiteprocError) Locale)
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Locale]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> ReaderT (Map Name Text) (Except CiteprocError) Locale
pLocale (Text -> Element -> [Element]
getChildren Text
"locale" Element
node)
    let cslVersion :: (Int, Int, Int)
cslVersion = case Text -> Attributes -> Maybe Text
lookupAttribute Text
"version" Attributes
attr of
                       Maybe Text
Nothing -> (Int
0,Int
0,Int
0)
                       Just Text
t  ->
                         case (Text -> Maybe Int) -> [Text] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Int
readAsInt (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
t) of
                           (Just Int
x : Just Int
y : Just Int
z :[Maybe Int]
_) -> (Int
x,Int
y,Int
z)
                           (Just Int
x : Just Int
y : [Maybe Int]
_)         -> (Int
x,Int
y,Int
0)
                           (Just Int
x : [Maybe Int]
_)                  -> (Int
x,Int
0,Int
0)
                           [Maybe Int]
_                             -> (Int
0,Int
0,Int
0)
    Style a -> ElementParser (Style a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Style a -> ElementParser (Style a))
-> Style a -> ElementParser (Style a)
forall a b. (a -> b) -> a -> b
$ Style
             { styleCslVersion :: (Int, Int, Int)
styleCslVersion     = (Int, Int, Int)
cslVersion
             , styleOptions :: StyleOptions
styleOptions        = StyleOptions
sOpts
             , styleCitation :: Layout a
styleCitation       = Layout a
citations
             , styleBibliography :: Maybe (Layout a)
styleBibliography   = Maybe (Layout a)
bibliography
             , styleLocales :: [Locale]
styleLocales        = [Locale]
locales
             , styleAbbreviations :: Maybe Abbreviations
styleAbbreviations  = Maybe Abbreviations
forall a. Maybe a
Nothing
             }



pElement :: X.Element -> ElementParser (Element a)
pElement :: forall a. Element -> ElementParser (Element a)
pElement Element
node =
  case Name -> Text
X.nameLocalName (Element -> Name
X.elementName Element
node) of
    Text
"date"   -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pDate Element
node
    Text
"text"   -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pText Element
node
    Text
"group"  -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pGroup Element
node
    Text
"choose" -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pChoose Element
node
    Text
"number" -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pNumber Element
node
    Text
"label"  -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pLabel Element
node
    Text
"names"  -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pNames Element
node
    Text
name     -> String -> ElementParser (Element a)
forall a. String -> ElementParser a
parseFailure (String -> ElementParser (Element a))
-> String -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ String
"unknown element " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
name

pChoose :: X.Element -> ElementParser (Element a)
pChoose :: forall a. Element -> ElementParser (Element a)
pChoose Element
node = do
  [(Match, [Condition], [Element a])]
ifNodes <- (Element
 -> ReaderT
      (Map Name Text)
      (Except CiteprocError)
      (Match, [Condition], [Element a]))
-> [Element]
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     [(Match, [Condition], [Element a])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     (Match, [Condition], [Element a])
forall a.
Element -> ElementParser (Match, [Condition], [Element a])
parseIf ([Element]
 -> ReaderT
      (Map Name Text)
      (Except CiteprocError)
      [(Match, [Condition], [Element a])])
-> [Element]
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     [(Match, [Condition], [Element a])]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren Text
"if" Element
node
  [(Match, [Condition], [Element a])]
elseIfNodes <- (Element
 -> ReaderT
      (Map Name Text)
      (Except CiteprocError)
      (Match, [Condition], [Element a]))
-> [Element]
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     [(Match, [Condition], [Element a])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     (Match, [Condition], [Element a])
forall a.
Element -> ElementParser (Match, [Condition], [Element a])
parseIf ([Element]
 -> ReaderT
      (Map Name Text)
      (Except CiteprocError)
      [(Match, [Condition], [Element a])])
-> [Element]
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     [(Match, [Condition], [Element a])]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren Text
"else-if" Element
node
  [(Match, [Condition], [Element a])]
elseNodes <- (Element
 -> ReaderT
      (Map Name Text)
      (Except CiteprocError)
      (Match, [Condition], [Element a]))
-> [Element]
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     [(Match, [Condition], [Element a])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     (Match, [Condition], [Element a])
forall a.
Element -> ElementParser (Match, [Condition], [Element a])
parseIf ([Element]
 -> ReaderT
      (Map Name Text)
      (Except CiteprocError)
      [(Match, [Condition], [Element a])])
-> [Element]
-> ReaderT
     (Map Name Text)
     (Except CiteprocError)
     [(Match, [Condition], [Element a])]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren Text
"else" Element
node
  let parts :: [(Match, [Condition], [Element a])]
parts = [(Match, [Condition], [Element a])]
ifNodes [(Match, [Condition], [Element a])]
-> [(Match, [Condition], [Element a])]
-> [(Match, [Condition], [Element a])]
forall a. [a] -> [a] -> [a]
++ [(Match, [Condition], [Element a])]
elseIfNodes [(Match, [Condition], [Element a])]
-> [(Match, [Condition], [Element a])]
-> [(Match, [Condition], [Element a])]
forall a. [a] -> [a] -> [a]
++ [(Match, [Condition], [Element a])]
elseNodes
  Element a -> ElementParser (Element a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element ([(Match, [Condition], [Element a])] -> ElementType a
forall a. [(Match, [Condition], [Element a])] -> ElementType a
EChoose [(Match, [Condition], [Element a])]
parts) Formatting
forall a. Monoid a => a
mempty

parseIf :: X.Element -> ElementParser (Match, [Condition], [Element a])
parseIf :: forall a.
Element -> ElementParser (Match, [Condition], [Element a])
parseIf Element
node = do
  let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
  let match :: Match
match = case Text -> Attributes -> Maybe Text
lookupAttribute Text
"match" Attributes
attr of
                Just Text
"any"   -> Match
MatchAny
                Just Text
"none"  -> Match
MatchNone
                Maybe Text
_            -> Match
MatchAll
  let conditions :: [Condition]
conditions =
        (case Text -> Attributes -> Maybe Text
lookupAttribute Text
"disambiguate" Attributes
attr of
           Just Text
"true" -> (Condition
WouldDisambiguate Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
           Maybe Text
_           -> [Condition] -> [Condition]
forall a. a -> a
id) ([Condition] -> [Condition])
-> ([Condition] -> [Condition]) -> [Condition] -> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (case Text -> Attributes -> Maybe Text
lookupAttribute Text
"is-numeric" Attributes
attr of
           Just Text
t  -> \[Condition]
xs -> (Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Condition -> [Condition] -> [Condition])
-> (Variable -> Condition)
-> Variable
-> [Condition]
-> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Condition
IsNumeric) [Condition]
xs (Text -> [Variable]
splitVars Text
t)
           Maybe Text
_       -> [Condition] -> [Condition]
forall a. a -> a
id) ([Condition] -> [Condition])
-> ([Condition] -> [Condition]) -> [Condition] -> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (case Text -> Attributes -> Maybe Text
lookupAttribute Text
"is-uncertain-date" Attributes
attr of
           Just Text
t  -> \[Condition]
xs -> (Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Condition -> [Condition] -> [Condition])
-> (Variable -> Condition)
-> Variable
-> [Condition]
-> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Condition
IsUncertainDate) [Condition]
xs (Text -> [Variable]
splitVars Text
t)
           Maybe Text
_       -> [Condition] -> [Condition]
forall a. a -> a
id) ([Condition] -> [Condition])
-> ([Condition] -> [Condition]) -> [Condition] -> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (case Text -> Attributes -> Maybe Text
lookupAttribute Text
"locator" Attributes
attr of
           Just Text
t  -> \[Condition]
xs -> (Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Condition -> [Condition] -> [Condition])
-> (Variable -> Condition)
-> Variable
-> [Condition]
-> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Condition
HasLocatorType) [Condition]
xs (Text -> [Variable]
splitVars Text
t)
           Maybe Text
_       -> [Condition] -> [Condition]
forall a. a -> a
id) ([Condition] -> [Condition])
-> ([Condition] -> [Condition]) -> [Condition] -> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (case Text -> Attributes -> Maybe Text
lookupAttribute Text
"position" Attributes
attr of
           Just Text
t  -> \[Condition]
xs ->
             (Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\case
                       Variable
"first"      -> (Position -> Condition
HasPosition Position
FirstPosition Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
                       Variable
"ibid"       -> (Position -> Condition
HasPosition Position
Ibid Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
                       Variable
"ibid-with-locator"
                                    -> (Position -> Condition
HasPosition Position
IbidWithLocator Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
                       Variable
"subsequent" -> (Position -> Condition
HasPosition Position
Subsequent Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
                       Variable
"near-note"  -> (Position -> Condition
HasPosition Position
NearNote Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
                       Variable
_            -> [Condition] -> [Condition]
forall a. a -> a
id)
             [Condition]
xs (Text -> [Variable]
splitVars Text
t)
           Maybe Text
_       -> [Condition] -> [Condition]
forall a. a -> a
id) ([Condition] -> [Condition])
-> ([Condition] -> [Condition]) -> [Condition] -> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (case Text -> Attributes -> Maybe Text
lookupAttribute Text
"type" Attributes
attr of
           Just Text
t  -> \[Condition]
xs -> (Text -> [Condition] -> [Condition])
-> [Condition] -> [Text] -> [Condition]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Condition -> [Condition] -> [Condition])
-> (Text -> Condition) -> Text -> [Condition] -> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Condition
HasType) [Condition]
xs (Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t)
           Maybe Text
_       -> [Condition] -> [Condition]
forall a. a -> a
id) ([Condition] -> [Condition])
-> ([Condition] -> [Condition]) -> [Condition] -> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (case Text -> Attributes -> Maybe Text
lookupAttribute Text
"variable" Attributes
attr of
           Just Text
t  -> \[Condition]
xs -> (Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Condition -> [Condition] -> [Condition])
-> (Variable -> Condition)
-> Variable
-> [Condition]
-> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Condition
HasVariable) [Condition]
xs (Text -> [Variable]
splitVars Text
t)
           Maybe Text
_       -> [Condition] -> [Condition]
forall a. a -> a
id) ([Condition] -> [Condition]) -> [Condition] -> [Condition]
forall a b. (a -> b) -> a -> b
$ []
  [Element a]
elts <- (Element
 -> ReaderT (Map Name Text) (Except CiteprocError) (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a)
forall a. Element -> ElementParser (Element a)
pElement ([Element]
 -> ReaderT (Map Name Text) (Except CiteprocError) [Element a])
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
allChildren Element
node
  (Match, [Condition], [Element a])
-> ElementParser (Match, [Condition], [Element a])
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Match
match, [Condition]
conditions, [Element a]
elts)

pNumber :: X.Element -> ElementParser (Element a)
pNumber :: forall a. Element -> ElementParser (Element a)
pNumber Element
node = do
  let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
  let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
  let variable :: Maybe Text
variable = Text -> Attributes -> Maybe Text
lookupAttribute Text
"variable" Attributes
attr
  let numform :: NumberForm
numform = case Text -> Attributes -> Maybe Text
lookupAttribute Text
"form" Attributes
attr of
                  Just Text
"ordinal"      -> NumberForm
NumberOrdinal
                  Just Text
"long-ordinal" -> NumberForm
NumberLongOrdinal
                  Just Text
"roman"        -> NumberForm
NumberRoman
                  Maybe Text
_                   -> NumberForm
NumberNumeric
  case Maybe Text
variable of
    Maybe Text
Nothing  -> String -> ElementParser (Element a)
forall a. String -> ElementParser a
parseFailure String
"number element without required variable attribute"
    Just Text
var -> Element a -> ElementParser (Element a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element (Variable -> NumberForm -> ElementType a
forall a. Variable -> NumberForm -> ElementType a
ENumber (Text -> Variable
toVariable Text
var) NumberForm
numform)
                         Formatting
formatting

pLabel :: X.Element -> ElementParser (Element a)
pLabel :: forall a. Element -> ElementParser (Element a)
pLabel Element
node = do
  let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
  let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
  let variable :: Variable
variable = Text -> Variable
toVariable (Text -> Variable) -> Text -> Variable
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute Text
"variable" Attributes
attr
  let labelform :: TermForm
labelform = case Text -> Attributes -> Maybe Text
lookupAttribute Text
"form" Attributes
attr of
                    Just Text
"short"      -> TermForm
Short
                    Just Text
"verb"       -> TermForm
Verb
                    Just Text
"verb-short" -> TermForm
VerbShort
                    Just Text
"symbol"     -> TermForm
Symbol
                    Maybe Text
_                 -> TermForm
Long
  let pluralize :: Pluralize
pluralize = case Text -> Attributes -> Maybe Text
lookupAttribute Text
"plural" Attributes
attr of
                    Just Text
"always" -> Pluralize
AlwaysPluralize
                    Just Text
"never"  -> Pluralize
NeverPluralize
                    Maybe Text
_             -> Pluralize
ContextualPluralize
  Element a -> ElementParser (Element a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element (Variable -> TermForm -> Pluralize -> ElementType a
forall a. Variable -> TermForm -> Pluralize -> ElementType a
ELabel Variable
variable TermForm
labelform Pluralize
pluralize) Formatting
formatting

pNames :: X.Element -> ElementParser (Element a)
pNames :: forall a. Element -> ElementParser (Element a)
pNames Element
node = do
  Attributes
attr <- Element -> ElementParser Attributes
getNameAttributes Element
node
  let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
  let variables :: [Variable]
variables = [Variable] -> (Text -> [Variable]) -> Maybe Text -> [Variable]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Variable]
splitVars (Maybe Text -> [Variable]) -> Maybe Text -> [Variable]
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute Text
"variable" Attributes
attr
  let pChild :: (NamesFormat, [Element a])
-> Element
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
pChild (NamesFormat
nf,[Element a]
subst) Element
n =
       case Name -> Text
X.nameLocalName (Element -> Name
X.elementName Element
n) of
         Text
"label"      -> do
           Element Any
e <- Element -> ElementParser (Element Any)
forall a. Element -> ElementParser (Element a)
pLabel Element
n
           case Element Any
e of
             Element (ELabel Variable
_ TermForm
labelform Pluralize
pluralize) Formatting
f ->
               (NamesFormat, [Element a])
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( NamesFormat
nf{ namesLabel = Just (labelform, pluralize, f)
                          , namesLabelBeforeName =
                              isNothing (namesName nf) }
                      , [Element a]
subst )
             Element Any
_ -> String
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a. String -> ElementParser a
parseFailure String
"pLabel returned something other than ELabel"
         Text
"substitute" -> do
           [Element a]
els <- (Element
 -> ReaderT (Map Name Text) (Except CiteprocError) (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a)
forall a. Element -> ElementParser (Element a)
pElement ([Element]
 -> ReaderT (Map Name Text) (Except CiteprocError) [Element a])
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
allChildren Element
n
           (NamesFormat, [Element a])
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( NamesFormat
nf, [Element a]
els )
         Text
"et-al"      -> do
           (Text, Formatting)
res <- Element -> ElementParser (Text, Formatting)
pEtAl Element
n
           (NamesFormat, [Element a])
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( NamesFormat
nf{ namesEtAl = Just res }, [Element a]
subst )
         Text
"name"       -> do
           (NameFormat, Formatting)
res <- Element -> ElementParser (NameFormat, Formatting)
pName Element
n
           (NamesFormat, [Element a])
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( NamesFormat
nf{ namesName = Just res }, [Element a]
subst )
         Text
name -> String
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a. String -> ElementParser a
parseFailure (String
 -> ReaderT
      (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a]))
-> String
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a b. (a -> b) -> a -> b
$ String
"element " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                        String
" not a valid child of names"
  (NamesFormat
nameformat, [Element a]
subst) <-
      ((NamesFormat, [Element a])
 -> Element
 -> ReaderT
      (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a]))
-> (NamesFormat, [Element a])
-> [Element]
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (NamesFormat, [Element a])
-> Element
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall {a}.
(NamesFormat, [Element a])
-> Element
-> ReaderT
     (Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
pChild (Maybe (TermForm, Pluralize, Formatting)
-> Maybe (Text, Formatting)
-> Maybe (NameFormat, Formatting)
-> Bool
-> NamesFormat
NamesFormat Maybe (TermForm, Pluralize, Formatting)
forall a. Maybe a
Nothing Maybe (Text, Formatting)
forall a. Maybe a
Nothing Maybe (NameFormat, Formatting)
forall a. Maybe a
Nothing Bool
False, [])
                   (Element -> [Element]
allChildren Element
node)
  Element a -> ElementParser (Element a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element ([Variable] -> NamesFormat -> [Element a] -> ElementType a
forall a. [Variable] -> NamesFormat -> [Element a] -> ElementType a
ENames [Variable]
variables NamesFormat
nameformat [Element a]
subst) Formatting
formatting

pEtAl :: X.Element -> ElementParser (Text, Formatting)
pEtAl :: Element -> ElementParser (Text, Formatting)
pEtAl Element
node = do
  let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
  let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
  let term :: Text
term = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"et-al" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute Text
"term" Attributes
attr
  (Text, Formatting) -> ElementParser (Text, Formatting)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
term, Formatting
formatting)


pName :: X.Element -> ElementParser (NameFormat, Formatting)
pName :: Element -> ElementParser (NameFormat, Formatting)
pName Element
node = do
  Attributes
attr <- Element -> ElementParser Attributes
getNameAttributes Element
node
  let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
  let nameParts :: [Attributes]
nameParts = (Element -> Attributes) -> [Element] -> [Attributes]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Attributes
getAttributes ([Element] -> [Attributes]) -> [Element] -> [Attributes]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren Text
"name-part" Element
node
  let nameformat :: NameFormat
nameformat = NameFormat
         { nameGivenFormatting :: Maybe Formatting
nameGivenFormatting        =
             case [Attributes
nattr
                   | Attributes
nattr <- [Attributes]
nameParts
                   , Text -> Attributes -> Maybe Text
lookupAttribute Text
"name" Attributes
nattr Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"given" ] of
                (Attributes
nattr:[Attributes]
_) -> Formatting -> Maybe Formatting
forall a. a -> Maybe a
Just (Formatting -> Maybe Formatting) -> Formatting -> Maybe Formatting
forall a b. (a -> b) -> a -> b
$ Attributes -> Formatting
getFormatting Attributes
nattr
                [Attributes]
_     -> Maybe Formatting
forall a. Maybe a
Nothing
         , nameFamilyFormatting :: Maybe Formatting
nameFamilyFormatting       =
             case [Attributes
nattr
                   | Attributes
nattr <- [Attributes]
nameParts
                   , Text -> Attributes -> Maybe Text
lookupAttribute Text
"name" Attributes
nattr Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"family" ] of
                (Attributes
nattr:[Attributes]
_) -> Formatting -> Maybe Formatting
forall a. a -> Maybe a
Just (Formatting -> Maybe Formatting) -> Formatting -> Maybe Formatting
forall a b. (a -> b) -> a -> b
$ Attributes -> Formatting
getFormatting Attributes
nattr
                [Attributes]
_     -> Maybe Formatting
forall a. Maybe a
Nothing
         , nameAndStyle :: Maybe TermForm
nameAndStyle           =
             case Text -> Attributes -> Maybe Text
lookupAttribute Text
"and" Attributes
attr of
               Just Text
"text"   -> TermForm -> Maybe TermForm
forall a. a -> Maybe a
Just TermForm
Long
               Just Text
"symbol" -> TermForm -> Maybe TermForm
forall a. a -> Maybe a
Just TermForm
Symbol
               Maybe Text
_             -> Maybe TermForm
forall a. Maybe a
Nothing
         , nameDelimiter :: Text
nameDelimiter              =
             Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
", " (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute Text
"delimiter" Attributes
attr
         , nameDelimiterPrecedesEtAl :: DelimiterPrecedes
nameDelimiterPrecedesEtAl  =
             case Text -> Attributes -> Maybe Text
lookupAttribute Text
"delimiter-precedes-et-al" Attributes
attr of
               Just Text
"after-inverted-name" -> DelimiterPrecedes
PrecedesAfterInvertedName
               Just Text
"always"              -> DelimiterPrecedes
PrecedesAlways
               Just Text
"never"               -> DelimiterPrecedes
PrecedesNever
               Maybe Text
_                          -> DelimiterPrecedes
PrecedesContextual
         , nameDelimiterPrecedesLast :: DelimiterPrecedes
nameDelimiterPrecedesLast  =
             case Text -> Attributes -> Maybe Text
lookupAttribute Text
"delimiter-precedes-last" Attributes
attr of
               Just Text
"after-inverted-name" -> DelimiterPrecedes
PrecedesAfterInvertedName
               Just Text
"always"              -> DelimiterPrecedes
PrecedesAlways
               Just Text
"never"               -> DelimiterPrecedes
PrecedesNever
               Maybe Text
_                          -> DelimiterPrecedes
PrecedesContextual
         , nameEtAlMin :: Maybe Int
nameEtAlMin                =
           (Text -> Attributes -> Maybe Text
lookupAttribute Text
"names-min" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
            Text -> Attributes -> Maybe Text
lookupAttribute Text
"et-al-min" Attributes
attr) Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readAsInt
         , nameEtAlUseFirst :: Maybe Int
nameEtAlUseFirst           =
           (Text -> Attributes -> Maybe Text
lookupAttribute Text
"names-use-first" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
            Text -> Attributes -> Maybe Text
lookupAttribute Text
"et-al-use-first" Attributes
attr) Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readAsInt
         , nameEtAlSubsequentUseFirst :: Maybe Int
nameEtAlSubsequentUseFirst =
             Text -> Attributes -> Maybe Text
lookupAttribute Text
"et-al-subsequent-use-first" Attributes
attr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readAsInt
         , nameEtAlSubsequentMin :: Maybe Int
nameEtAlSubsequentMin      =
             Text -> Attributes -> Maybe Text
lookupAttribute Text
"et-al-subsequent-min" Attributes
attr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readAsInt
         , nameEtAlUseLast :: Bool
nameEtAlUseLast            =
             case Text -> Attributes -> Maybe Text
lookupAttribute Text
"names-use-last" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                  Text -> Attributes -> Maybe Text
lookupAttribute Text
"et-al-use-last" Attributes
attr of
               Just Text
"true" -> Bool
True
               Maybe Text
_           -> Bool
False
         , nameForm :: NameForm
nameForm                   =
             case Text -> Attributes -> Maybe Text
lookupAttribute Text
"form" Attributes
attr of
               Just Text
"short"  -> NameForm
ShortName
               Just Text
"count"  -> NameForm
CountName
               Maybe Text
_             -> NameForm
LongName
         , nameInitialize :: Bool
nameInitialize             =
             case Text -> Attributes -> Maybe Text
lookupAttribute Text
"initialize" Attributes
attr of
               Just Text
"false" -> Bool
False
               Maybe Text
_            -> Bool
True
         , nameInitializeWith :: Maybe Text
nameInitializeWith         =
             Text -> Attributes -> Maybe Text
lookupAttribute Text
"initialize-with" Attributes
attr
         , nameAsSortOrder :: Maybe NameAsSortOrder
nameAsSortOrder            =
             case Text -> Attributes -> Maybe Text
lookupAttribute Text
"name-as-sort-order" Attributes
attr of
               Just Text
"all"   -> NameAsSortOrder -> Maybe NameAsSortOrder
forall a. a -> Maybe a
Just NameAsSortOrder
NameAsSortOrderAll
               Just Text
"first" -> NameAsSortOrder -> Maybe NameAsSortOrder
forall a. a -> Maybe a
Just NameAsSortOrder
NameAsSortOrderFirst
               Maybe Text
_            -> Maybe NameAsSortOrder
forall a. Maybe a
Nothing
         , nameSortSeparator :: Text
nameSortSeparator          =
             Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
", " (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute Text
"sort-separator" Attributes
attr
         }
  (NameFormat, Formatting) -> ElementParser (NameFormat, Formatting)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NameFormat
nameformat, Formatting
formatting)

pGroup :: X.Element -> ElementParser (Element a)
pGroup :: forall a. Element -> ElementParser (Element a)
pGroup Element
node = do
  let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
  let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
  [Element a]
es <- (Element -> ElementParser (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pElement ([Element]
 -> ReaderT (Map Name Text) (Except CiteprocError) [Element a])
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
allChildren Element
node
  Element a -> ElementParser (Element a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element (Bool -> [Element a] -> ElementType a
forall a. Bool -> [Element a] -> ElementType a
EGroup Bool
False [Element a]
es) Formatting
formatting

pText :: X.Element -> ElementParser (Element a)
pText :: forall a. Element -> ElementParser (Element a)
pText Element
node = do
  let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
  let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
  let varform :: VariableForm
varform = case Text -> Attributes -> Maybe Text
lookupAttribute Text
"form" Attributes
attr of
                  Just Text
"short" -> VariableForm
ShortForm
                  Maybe Text
_            -> VariableForm
LongForm
  let termform :: TermForm
termform = case Text -> Attributes -> Maybe Text
lookupAttribute Text
"form" Attributes
attr of
                   Just Text
"short"      -> TermForm
Short
                   Just Text
"verb"       -> TermForm
Verb
                   Just Text
"verb-short" -> TermForm
VerbShort
                   Just Text
"symbol"     -> TermForm
Symbol
                   Maybe Text
_                 -> TermForm
Long
  let termnumber :: Maybe TermNumber
termnumber = case Text -> Attributes -> Maybe Text
lookupAttribute Text
"plural" Attributes
attr of
                     Just Text
"true"   -> TermNumber -> Maybe TermNumber
forall a. a -> Maybe a
Just TermNumber
Plural
                     Just Text
"false"  -> TermNumber -> Maybe TermNumber
forall a. a -> Maybe a
Just TermNumber
Singular
                     Maybe Text
_             -> Maybe TermNumber
forall a. Maybe a
Nothing
  ElementType a
elt <- case Text -> Attributes -> Maybe Text
lookupAttribute Text
"variable" Attributes
attr of
           Just Text
var -> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElementType a
 -> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a))
-> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a b. (a -> b) -> a -> b
$ TextType -> ElementType a
forall a. TextType -> ElementType a
EText (VariableForm -> Variable -> TextType
TextVariable VariableForm
varform (Text -> Variable
toVariable Text
var))
           Maybe Text
Nothing ->
             case Text -> Attributes -> Maybe Text
lookupAttribute Text
"macro" Attributes
attr of
               Just Text
_ -> do
                 [Element a]
elements <- (Element -> ElementParser (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pElement (Element -> [Element]
allChildren Element
node)
                 ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElementType a
 -> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a))
-> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a b. (a -> b) -> a -> b
$ Bool -> [Element a] -> ElementType a
forall a. Bool -> [Element a] -> ElementType a
EGroup Bool
True [Element a]
elements
               Maybe Text
Nothing ->
                 case Text -> Attributes -> Maybe Text
lookupAttribute Text
"term" Attributes
attr of
                   Just Text
termname ->
                     ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElementType a
 -> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a))
-> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a b. (a -> b) -> a -> b
$ TextType -> ElementType a
forall a. TextType -> ElementType a
EText (Term -> TextType
TextTerm
                       Term { termName :: Text
termName = Text
termname
                            , termForm :: TermForm
termForm = TermForm
termform
                            , termNumber :: Maybe TermNumber
termNumber = Maybe TermNumber
termnumber
                            , termGender :: Maybe TermGender
termGender = Maybe TermGender
forall a. Maybe a
Nothing
                            , termGenderForm :: Maybe TermGender
termGenderForm = Maybe TermGender
forall a. Maybe a
Nothing
                            , termMatch :: Maybe TermMatch
termMatch = Maybe TermMatch
forall a. Maybe a
Nothing
                            })
                   Maybe Text
Nothing ->
                     case Text -> Attributes -> Maybe Text
lookupAttribute Text
"value" Attributes
attr of
                       Just Text
val ->
                         ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElementType a
 -> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a))
-> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a b. (a -> b) -> a -> b
$ TextType -> ElementType a
forall a. TextType -> ElementType a
EText (Text -> TextType
TextValue Text
val)
                       Maybe Text
Nothing ->
                         String
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a. String -> ElementParser a
parseFailure String
"text element lacks needed attribute"
  Element a -> ElementParser (Element a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element ElementType a
elt Formatting
formatting

pMacro :: X.Element -> ElementParser (Text, [X.Element])
pMacro :: Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Text, [Element])
pMacro Element
node = do
  Text
name <- case Text -> Attributes -> Maybe Text
lookupAttribute Text
"name" (Element -> Attributes
getAttributes Element
node) of
            Just Text
t  -> Text -> ReaderT (Map Name Text) (Except CiteprocError) Text
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
            Maybe Text
Nothing -> String -> ReaderT (Map Name Text) (Except CiteprocError) Text
forall a. String -> ElementParser a
parseFailure String
"macro element missing name attribute"
  (Text, [Element])
-> ReaderT (Map Name Text) (Except CiteprocError) (Text, [Element])
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Element -> [Element]
allChildren Element
node)

-- these name and names attributes are inheritable from a parent style
-- citation or bibliography element.  We use a map because
-- sometimes the name is different (e.g. name-form and form).
inheritableNameAttributes :: M.Map X.Name X.Name
inheritableNameAttributes :: Map Name Name
inheritableNameAttributes = [(Name, Name)] -> Map Name Name
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Name)] -> Map Name Name)
-> [(Name, Name)] -> Map Name Name
forall a b. (a -> b) -> a -> b
$
  ((Text, Text) -> (Name, Name)) -> [(Text, Text)] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x,Text
y) -> (Text -> Name
attname Text
x, Text -> Name
attname Text
y))
  [ (Text
"and", Text
"and")
  , (Text
"delimiter-precedes-et-al", Text
"delimiter-precedes-et-al")
  , (Text
"delimiter-precedes-last", Text
"delimiter-precedes-last")
  , (Text
"et-al-min", Text
"et-al-min")
  , (Text
"et-al-use-first", Text
"et-al-use-first")
  , (Text
"et-al-use-last", Text
"et-al-use-last")
  , (Text
"et-al-subsequent-min", Text
"et-al-subsequent-min")
  , (Text
"et-al-subsequent-use-first", Text
"et-al-subsequent-use-first")
  , (Text
"initialize", Text
"initialize")
  , (Text
"initialize-with", Text
"initialize-with")
  , (Text
"name-as-sort-order", Text
"name-as-sort-order")
  , (Text
"sort-separator", Text
"sort-separator")
  , (Text
"name-form", Text
"form")
  , (Text
"name-delimiter", Text
"delimiter")
  , (Text
"names-delimiter", Text
"delimiter")
  , (Text
"names-min", Text
"names-min")
  , (Text
"names-use-first", Text
"names-use-first")
  , (Text
"names-use-last", Text
"names-use-last")
  ]

getInheritableNameAttributes :: X.Element -> M.Map X.Name Text
getInheritableNameAttributes :: Element -> Map Name Text
getInheritableNameAttributes Element
elt =
  (Name -> Text -> Map Name Text -> Map Name Text)
-> Map Name Text -> Map Name Text -> Map Name Text
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey
    (\Name
k Text
v Map Name Text
m -> case Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
k Map Name Name
inheritableNameAttributes of
                   Just Name
k' -> Name -> Text -> Map Name Text -> Map Name Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
k' Text
v Map Name Text
m
                   Maybe Name
Nothing -> Map Name Text
m) Map Name Text
forall k a. Map k a
M.empty (Element -> Map Name Text
X.elementAttributes Element
elt)

pLayout :: M.Map Text [X.Element] -> X.Element -> ElementParser (Layout a)
pLayout :: forall a. Map Text [Element] -> Element -> ElementParser (Layout a)
pLayout Map Text [Element]
macroMap Element
node = do
  let attrmap :: Map Name Text
attrmap = Element -> Map Name Text
getInheritableNameAttributes Element
node
  let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
  (Map Name Text -> Map Name Text)
-> ElementParser (Layout a) -> ElementParser (Layout a)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (Map Name Text -> Map Name Text -> Map Name Text
forall a. Semigroup a => a -> a -> a
<> Map Name Text
attrmap) (ElementParser (Layout a) -> ElementParser (Layout a))
-> ElementParser (Layout a) -> ElementParser (Layout a)
forall a b. (a -> b) -> a -> b
$ do
    Element
node' <- Map Text [Element] -> Element -> ElementParser Element
expandMacros Map Text [Element]
macroMap Element
node
    let layouts :: [Element]
layouts = Text -> Element -> [Element]
getChildren Text
"layout" Element
node'
    -- In case there are multiple layouts (as CSL-M allows), we raise an error
    let elname :: String
elname = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Name -> Text
X.nameLocalName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ Element -> Name
X.elementName Element
node
    Element
layout <- case [Element]
layouts of
                [] -> String -> ElementParser Element
forall a. String -> ElementParser a
parseFailure (String -> ElementParser Element)
-> String -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ String
"No layout element present in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
elname
                [Element
l] -> Element -> ElementParser Element
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Element
l
                (Element
_:[Element]
_) -> String -> ElementParser Element
forall a. String -> ElementParser a
parseFailure (String -> ElementParser Element)
-> String -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ String
"Multiple layout elements present in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
elname
    let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting (Attributes -> Formatting)
-> (Element -> Attributes) -> Element -> Formatting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Attributes
getAttributes (Element -> Formatting) -> Element -> Formatting
forall a b. (a -> b) -> a -> b
$ Element
layout
    let sorts :: [Element]
sorts   = Text -> Element -> [Element]
getChildren Text
"sort" Element
node'
    [Element a]
elements <- (Element
 -> ReaderT (Map Name Text) (Except CiteprocError) (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a)
forall a. Element -> ElementParser (Element a)
pElement ([Element]
 -> ReaderT (Map Name Text) (Except CiteprocError) [Element a])
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
allChildren Element
layout
    let opts :: LayoutOptions
opts = LayoutOptions
               { layoutCollapse :: Maybe Collapsing
layoutCollapse =
                   case Text -> Attributes -> Maybe Text
lookupAttribute Text
"collapse" Attributes
attr of
                     Just Text
"citation-number" -> Collapsing -> Maybe Collapsing
forall a. a -> Maybe a
Just Collapsing
CollapseCitationNumber
                     Just Text
"year"            -> Collapsing -> Maybe Collapsing
forall a. a -> Maybe a
Just Collapsing
CollapseYear
                     Just Text
"year-suffix"     -> Collapsing -> Maybe Collapsing
forall a. a -> Maybe a
Just Collapsing
CollapseYearSuffix
                     Just Text
"year-suffix-ranged"
                                            -> Collapsing -> Maybe Collapsing
forall a. a -> Maybe a
Just Collapsing
CollapseYearSuffixRanged
                     Maybe Text
_                      -> Maybe Collapsing
forall a. Maybe a
Nothing
               , layoutYearSuffixDelimiter :: Maybe Text
layoutYearSuffixDelimiter =
                   Text -> Attributes -> Maybe Text
lookupAttribute Text
"year-suffix-delimiter" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     -- technically the spec doesn't say this, but
                     -- this seems to be what the test suites want?:
                     Text -> Attributes -> Maybe Text
lookupAttribute Text
"cite-group-delimiter" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     Formatting -> Maybe Text
formatDelimiter Formatting
formatting
               , layoutAfterCollapseDelimiter :: Maybe Text
layoutAfterCollapseDelimiter =
                   Text -> Attributes -> Maybe Text
lookupAttribute Text
"after-collapse-delimiter" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     Formatting -> Maybe Text
formatDelimiter Formatting
formatting
               }
    [SortKey a]
sortKeys <- (Element
 -> ReaderT (Map Name Text) (Except CiteprocError) (SortKey a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [SortKey a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (SortKey a)
forall a. Element -> ElementParser (SortKey a)
pSortKey ((Element -> [Element]) -> [Element] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Element -> [Element]
getChildren Text
"key") [Element]
sorts)
    Layout a -> ElementParser (Layout a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout a -> ElementParser (Layout a))
-> Layout a -> ElementParser (Layout a)
forall a b. (a -> b) -> a -> b
$ Layout { layoutOptions :: LayoutOptions
layoutOptions  = LayoutOptions
opts
                    , layoutFormatting :: Formatting
layoutFormatting = Formatting
formatting{
                                           formatAffixesInside = True }
                    , layoutElements :: [Element a]
layoutElements = [Element a]
elements
                    , layoutSortKeys :: [SortKey a]
layoutSortKeys = [SortKey a]
sortKeys
                    }

pSortKey :: X.Element -> ElementParser (SortKey a)
pSortKey :: forall a. Element -> ElementParser (SortKey a)
pSortKey Element
node = do
  let attrmap :: Map Name Text
attrmap = Element -> Map Name Text
getInheritableNameAttributes Element
node
  (Map Name Text -> Map Name Text)
-> ElementParser (SortKey a) -> ElementParser (SortKey a)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (Map Name Text -> Map Name Text -> Map Name Text
forall a. Semigroup a => a -> a -> a
<> Map Name Text
attrmap) (ElementParser (SortKey a) -> ElementParser (SortKey a))
-> ElementParser (SortKey a) -> ElementParser (SortKey a)
forall a b. (a -> b) -> a -> b
$ do
    let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
    let direction :: SortDirection
direction = case Text -> Attributes -> Maybe Text
lookupAttribute Text
"sort" Attributes
attr of
                      Just Text
"descending" -> SortDirection
Descending
                      Maybe Text
_                 -> SortDirection
Ascending
    case Text -> Attributes -> Maybe Text
lookupAttribute Text
"macro" Attributes
attr of
        Just Text
_ -> -- should already be expanded
          SortDirection -> [Element a] -> SortKey a
forall a. SortDirection -> [Element a] -> SortKey a
SortKeyMacro SortDirection
direction ([Element a] -> SortKey a)
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
-> ElementParser (SortKey a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element
 -> ReaderT (Map Name Text) (Except CiteprocError) (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a)
forall a. Element -> ElementParser (Element a)
pElement (Element -> [Element]
allChildren Element
node)
        Maybe Text
Nothing   -> SortKey a -> ElementParser (SortKey a)
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SortKey a -> ElementParser (SortKey a))
-> SortKey a -> ElementParser (SortKey a)
forall a b. (a -> b) -> a -> b
$ SortDirection -> Variable -> SortKey a
forall a. SortDirection -> Variable -> SortKey a
SortKeyVariable SortDirection
direction
                       (Text -> Variable
toVariable (Text -> Variable) -> Text -> Variable
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
                         Text -> Attributes -> Maybe Text
lookupAttribute Text
"variable" Attributes
attr)

attname :: Text -> X.Name
attname :: Text -> Name
attname Text
t = Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
t Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing

expandMacros :: M.Map Text [X.Element]
             -> X.Element
             -> ElementParser X.Element
expandMacros :: Map Text [Element] -> Element -> ElementParser Element
expandMacros Map Text [Element]
macroMap Element
el =
  case Name -> Text
X.nameLocalName (Element -> Name
X.elementName Element
el) of
    Text
n | Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"text" Bool -> Bool -> Bool
||
        Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"key" ->
      case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Name
attname Text
"macro") (Element -> Map Name Text
X.elementAttributes Element
el) of
        Maybe Text
Nothing -> do
           [Node]
els' <- (Node -> ReaderT (Map Name Text) (Except CiteprocError) Node)
-> [Node] -> ReaderT (Map Name Text) (Except CiteprocError) [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Node -> ReaderT (Map Name Text) (Except CiteprocError) Node
expandNode (Element -> [Node]
X.elementNodes Element
el)
           Element -> ElementParser Element
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ElementParser Element)
-> Element -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ Element
el{ X.elementNodes = els' }
        Just Text
macroName ->
          case Text -> Map Text [Element] -> Maybe [Element]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
macroName Map Text [Element]
macroMap of
            Maybe [Element]
Nothing ->
              String -> ElementParser Element
forall a. String -> ElementParser a
parseFailure (String -> ElementParser Element)
-> String -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ String
"macro " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
macroName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not found"
            Just [Element]
els -> do
              -- the expansion may contain further macros:
              [Node]
els' <- (Element -> ReaderT (Map Name Text) (Except CiteprocError) Node)
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Element -> Node)
-> ElementParser Element
-> ReaderT (Map Name Text) (Except CiteprocError) Node
forall a b.
(a -> b)
-> ReaderT (Map Name Text) (Except CiteprocError) a
-> ReaderT (Map Name Text) (Except CiteprocError) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
X.NodeElement (ElementParser Element
 -> ReaderT (Map Name Text) (Except CiteprocError) Node)
-> (Element -> ElementParser Element)
-> Element
-> ReaderT (Map Name Text) (Except CiteprocError) Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text [Element] -> Element -> ElementParser Element
expandMacros Map Text [Element]
macroMap) [Element]
els
              Element -> ElementParser Element
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ElementParser Element)
-> Element -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ Element
el{ X.elementNodes = els' }
    Text
_ -> do
      [Node]
els' <- (Node -> ReaderT (Map Name Text) (Except CiteprocError) Node)
-> [Node] -> ReaderT (Map Name Text) (Except CiteprocError) [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Node -> ReaderT (Map Name Text) (Except CiteprocError) Node
expandNode (Element -> [Node]
X.elementNodes Element
el)
      Element -> ElementParser Element
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ElementParser Element)
-> Element -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ Element
el{ X.elementNodes = els' }
 where
  expandNode :: Node -> ReaderT (Map Name Text) (Except CiteprocError) Node
expandNode (X.NodeElement Element
el') = Element -> Node
X.NodeElement (Element -> Node)
-> ElementParser Element
-> ReaderT (Map Name Text) (Except CiteprocError) Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [Element] -> Element -> ElementParser Element
expandMacros Map Text [Element]
macroMap Element
el'
  expandNode Node
x                   = Node -> ReaderT (Map Name Text) (Except CiteprocError) Node
forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
x

splitVars :: Text -> [Variable]
splitVars :: Text -> [Variable]
splitVars = (Text -> Variable) -> [Text] -> [Variable]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Variable
toVariable ([Text] -> [Variable]) -> (Text -> [Text]) -> Text -> [Variable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip