    {-# 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

    -- | 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
                  parentTxt <- Text -> m Text
    getIndependentParent Text
    url
                  case X.parseText def (TL.fromStrict 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 attr :: Attributes
    attr = Element -> Attributes
    getAttributes Element
    node
      let nameformat :: NameFormat
    nameformat = Attributes -> NameFormat
    getInheritableNameFormat Attributes
    attr
      macros <- [(Text, [Element a])] -> Map Text [Element a]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Text, [Element a])] -> Map Text [Element a])
    -> ExceptT CiteprocError Identity [(Text, [Element a])]
    -> ExceptT CiteprocError Identity (Map Text [Element a])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Element -> ExceptT CiteprocError Identity (Text, [Element a]))
    -> [Element]
    -> ExceptT CiteprocError Identity [(Text, [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 -> ExceptT CiteprocError Identity (Text, [Element a])
    forall a. Element -> ElementParser (Text, [Element a])
    pMacro (Text -> Element -> [Element]
    getChildren Text
    "macro" Element
    node)
      (cattr, citations)
          <- case getChildren "citation" node of
                     [Element
    n] -> (Element -> Attributes
    getAttributes Element
    n,) (Layout a -> (Attributes, Layout a))
    -> ExceptT CiteprocError Identity (Layout a)
    -> ExceptT CiteprocError Identity (Attributes, Layout a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Element -> ExceptT CiteprocError Identity (Layout a)
    forall a. Element -> ElementParser (Layout a)
    pLayout Element
    n
                     []  -> String -> ExceptT CiteprocError Identity (Attributes, Layout a)
    forall a. String -> ElementParser a
    parseFailure String
    "No citation element present"
                     [Element]
    _   -> String -> ExceptT CiteprocError Identity (Attributes, Layout a)
    forall a. String -> ElementParser a
    parseFailure String
    "More than one citation element present"
      (battr, bibliography) <- case getChildren "bibliography" 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)))
    -> ExceptT CiteprocError Identity (Layout a)
    -> ExceptT CiteprocError Identity (Attributes, Maybe (Layout a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Element -> ExceptT CiteprocError Identity (Layout a)
    forall a. Element -> ElementParser (Layout a)
    pLayout Element
    n
                        []  -> (Attributes, Maybe (Layout a))
    -> ExceptT CiteprocError Identity (Attributes, Maybe (Layout a))
    forall a. a -> ExceptT CiteprocError Identity 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
    -> ExceptT CiteprocError Identity (Attributes, Maybe (Layout a))
    forall a. String -> ElementParser a
    parseFailure
                                 String
    "More than one bibliography element present"

      let 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
            { 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 ElementType a
    e Formatting
    f) =
            case ElementType a
    e of
              EText (TextVariable VariableForm
    _ Variable
    "year-suffix") -> Bool
    True
              EText (TextMacro Text
    macroname)
                | Just [Element a]
    es' <- Text -> Map Text [Element a] -> Maybe [Element a]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    macroname Map Text [Element a]
    macros ->
                     (Element a -> Bool) -> [Element a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Element a -> Bool
    hasYearSuffixVariable [Element a]
    es'
              EGroup Bool
    _ [Element a]
    es -> (Element a -> Bool) -> [Element a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Element a -> Bool
    hasYearSuffixVariable [Element a]
    es
              EChoose [] -> Bool
    False
              EChoose ((Match
    _,[Condition]
    _,[Element a]
    es):[(Match, [Condition], [Element a])]
    conds) -> (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)
              ElementType a
    _ -> Bool
    False
      let usesYearSuffixVariable =
            (Element a -> Bool) -> [Element a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any 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
                   { 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
                   , styleNameFormat :: NameFormat
    styleNameFormat = NameFormat
    nameformat -- TODO
                   }
      locales <- mapM pLocale (getChildren "locale" node)
      let 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)
      return $ Style
               { styleCslVersion     = cslVersion
               , styleOptions        = sOpts
               , styleCitation       = citations
               , styleBibliography   = bibliography
               , styleLocales        = locales
               , styleAbbreviations  = Nothing
               , styleMacros         = macros
               }

    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
      ifNodes <- (Element
     -> ExceptT
          CiteprocError Identity (Match, [Condition], [Element a]))
    -> [Element]
    -> ExceptT
         CiteprocError Identity [(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
    -> ExceptT CiteprocError Identity (Match, [Condition], [Element a])
    forall a.
    Element -> ElementParser (Match, [Condition], [Element a])
    parseIf ([Element]
     -> ExceptT
          CiteprocError Identity [(Match, [Condition], [Element a])])
    -> [Element]
    -> ExceptT
         CiteprocError Identity [(Match, [Condition], [Element a])]
    forall a b. (a -> b) -> a -> b
    $ Text -> Element -> [Element]
    getChildren Text
    "if" Element
    node
      elseIfNodes <- mapM parseIf $ getChildren "else-if" node
      elseNodes <- mapM parseIf $ getChildren "else" node
      let 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
      return $ Element (EChoose parts) 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  -> ([Text] -> Condition
    HasType (Text -> [Text]
    T.words (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.strip Text
    t) 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
    "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
    $ []
      elts <- (Element -> ExceptT CiteprocError Identity (Element a))
    -> [Element] -> ExceptT CiteprocError Identity [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 -> ExceptT CiteprocError Identity (Element a)
    forall a. Element -> ElementParser (Element a)
    pElement ([Element] -> ExceptT CiteprocError Identity [Element a])
    -> [Element] -> ExceptT CiteprocError Identity [Element a]
    forall a b. (a -> b) -> a -> b
    $ Element -> [Element]
    allChildren Element
    node
      return (match, conditions, 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 -> ExceptT CiteprocError Identity 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 -> ExceptT CiteprocError Identity (Element a)
    forall a. a -> ExceptT CiteprocError Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element a -> ExceptT CiteprocError Identity (Element a))
    -> Element a -> ExceptT CiteprocError Identity (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
      let attr :: Attributes
    attr = Element -> Attributes
    getAttributes 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
    -> ExceptT CiteprocError Identity (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
               e <- Element -> ElementParser (Element (ZonkAny 0))
    forall a. Element -> ElementParser (Element a)
    pLabel Element
    n
               case e of
                 Element (ELabel Variable
    _ TermForm
    labelform Pluralize
    pluralize) Formatting
    f ->
                   (NamesFormat, [Element a])
    -> ExceptT CiteprocError Identity (NamesFormat, [Element a])
    forall a. a -> ExceptT CiteprocError Identity 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 (ZonkAny 0)
    _ -> String -> ExceptT CiteprocError Identity (NamesFormat, [Element a])
    forall a. String -> ElementParser a
    parseFailure String
    "pLabel returned something other than ELabel"
             Text
    "substitute" -> do
               els <- (Element -> ExceptT CiteprocError Identity (Element a))
    -> [Element] -> ExceptT CiteprocError Identity [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 -> ExceptT CiteprocError Identity (Element a)
    forall a. Element -> ElementParser (Element a)
    pElement ([Element] -> ExceptT CiteprocError Identity [Element a])
    -> [Element] -> ExceptT CiteprocError Identity [Element a]
    forall a b. (a -> b) -> a -> b
    $ Element -> [Element]
    allChildren Element
    n
               return ( nf, els )
             Text
    "et-al"      -> do
               res <- Element -> ElementParser (Text, Formatting)
    pEtAl Element
    n
               return ( nf{ namesEtAl = Just res }, subst )
             Text
    "name"       -> do
               res <- Element -> ElementParser (NameFormat, Formatting)
    pName Element
    n
               return ( nf{ namesName = Just res }, subst )
             Text
    name -> String -> ExceptT CiteprocError Identity (NamesFormat, [Element a])
    forall a. String -> ElementParser a
    parseFailure (String
     -> ExceptT CiteprocError Identity (NamesFormat, [Element a]))
    -> String
    -> ExceptT CiteprocError Identity (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"
      (nameformat, subst) <-
          ((NamesFormat, [Element a])
     -> Element
     -> ExceptT CiteprocError Identity (NamesFormat, [Element a]))
    -> (NamesFormat, [Element a])
    -> [Element]
    -> ExceptT CiteprocError Identity (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
    -> ExceptT CiteprocError Identity (NamesFormat, [Element a])
    forall {a}.
    (NamesFormat, [Element a])
    -> Element
    -> ExceptT CiteprocError Identity (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)
      return $ Element (ENames variables nameformat subst) 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 -> ExceptT CiteprocError Identity 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
      let attr :: Attributes
    attr = Element -> Attributes
    getAttributes 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 :: Maybe Text
    nameDelimiter              =
                 Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "delimiter" Attributes
    attr
             , nameDelimiterPrecedesEtAl :: Maybe DelimiterPrecedes
    nameDelimiterPrecedesEtAl  =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "delimiter-precedes-et-al" Attributes
    attr of
                   Just Text
    "after-inverted-name" -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesAfterInvertedName
                   Just Text
    "always"              -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesAlways
                   Just Text
    "never"               -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesNever
                   Just Text
    "contextual"          -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesContextual
                   Maybe Text
    _                          -> Maybe DelimiterPrecedes
    forall a. Maybe a
    Nothing
             , nameDelimiterPrecedesLast :: Maybe DelimiterPrecedes
    nameDelimiterPrecedesLast  =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "delimiter-precedes-last" Attributes
    attr of
                   Just Text
    "after-inverted-name" -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesAfterInvertedName
                   Just Text
    "always"              -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesAlways
                   Just Text
    "never"               -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesNever
                   Just Text
    "contextual"          -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesContextual
                   Maybe Text
    _                          -> Maybe DelimiterPrecedes
    forall a. Maybe a
    Nothing
             , nameEtAlMin :: Maybe Int
    nameEtAlMin                =
                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
    "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 :: Maybe Bool
    nameEtAlUseLast            =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "et-al-use-last" Attributes
    attr of
                   Just Text
    "true" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
                   Just Text
    "false" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
                   Maybe Text
    _           -> Maybe Bool
    forall a. Maybe a
    Nothing
             , nameForm :: Maybe NameForm
    nameForm                   =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "form" Attributes
    attr of
                   Just Text
    "short"  -> NameForm -> Maybe NameForm
    forall a. a -> Maybe a
    Just NameForm
    ShortName
                   Just Text
    "count"  -> NameForm -> Maybe NameForm
    forall a. a -> Maybe a
    Just NameForm
    CountName
                   Just Text
    "long"   -> NameForm -> Maybe NameForm
    forall a. a -> Maybe a
    Just NameForm
    LongName
                   Maybe Text
    _             -> Maybe NameForm
    forall a. Maybe a
    Nothing
             , nameInitialize :: Maybe Bool
    nameInitialize             =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "initialize" Attributes
    attr of
                   Just Text
    "false" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
                   Just Text
    "true" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
                   Maybe Text
    _            -> Maybe Bool
    forall a. Maybe a
    Nothing
             , 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 :: Maybe Text
    nameSortSeparator          =
                 Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "sort-separator" Attributes
    attr
             }
      (NameFormat, Formatting) -> ElementParser (NameFormat, Formatting)
    forall a. a -> ExceptT CiteprocError Identity 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
      es <- (Element -> ExceptT CiteprocError Identity (Element a))
    -> [Element] -> ExceptT CiteprocError Identity [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 -> ExceptT CiteprocError Identity (Element a)
    forall a. Element -> ElementParser (Element a)
    pElement ([Element] -> ExceptT CiteprocError Identity [Element a])
    -> [Element] -> ExceptT CiteprocError Identity [Element a]
    forall a b. (a -> b) -> a -> b
    $ Element -> [Element]
    allChildren Element
    node
      return $ Element (EGroup False es) 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
      elt <- case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "variable" Attributes
    attr of
               Just Text
    var -> ElementType a -> ExceptT CiteprocError Identity (ElementType a)
    forall a. a -> ExceptT CiteprocError Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ElementType a -> ExceptT CiteprocError Identity (ElementType a))
    -> ElementType a -> ExceptT CiteprocError Identity (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
    macroname -> ElementType a -> ExceptT CiteprocError Identity (ElementType a)
    forall a. a -> ExceptT CiteprocError Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ElementType a -> ExceptT CiteprocError Identity (ElementType a))
    -> ElementType a -> ExceptT CiteprocError Identity (ElementType a)
    forall a b. (a -> b) -> a -> b
    $ TextType -> ElementType a
    forall a. TextType -> ElementType a
    EText (Text -> TextType
    TextMacro Text
    macroname)
                   Maybe Text
    Nothing ->
                     case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "term" Attributes
    attr of
                       Just Text
    termname ->
                         ElementType a -> ExceptT CiteprocError Identity (ElementType a)
    forall a. a -> ExceptT CiteprocError Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ElementType a -> ExceptT CiteprocError Identity (ElementType a))
    -> ElementType a -> ExceptT CiteprocError Identity (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 -> ExceptT CiteprocError Identity (ElementType a)
    forall a. a -> ExceptT CiteprocError Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ElementType a -> ExceptT CiteprocError Identity (ElementType a))
    -> ElementType a -> ExceptT CiteprocError Identity (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 -> ExceptT CiteprocError Identity (ElementType a)
    forall a. String -> ElementParser a
    parseFailure String
    "text element lacks needed attribute"
      return $ Element elt formatting

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

    getInheritableNameFormat :: Attributes -> NameFormat
    getInheritableNameFormat :: Attributes -> NameFormat
    getInheritableNameFormat Attributes
    attr =
      NameFormat
             { nameGivenFormatting :: Maybe Formatting
    nameGivenFormatting = Maybe Formatting
    forall a. Maybe a
    Nothing
             , nameFamilyFormatting :: Maybe Formatting
    nameFamilyFormatting = 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 :: Maybe Text
    nameDelimiter =
                 Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "name-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
    <|>
                 Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "names-delimiter" Attributes
    attr
             , nameDelimiterPrecedesEtAl :: Maybe DelimiterPrecedes
    nameDelimiterPrecedesEtAl  =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "delimiter-precedes-et-al" Attributes
    attr of
                   Just Text
    "after-inverted-name" -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesAfterInvertedName
                   Just Text
    "always"              -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesAlways
                   Just Text
    "never"               -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesNever
                   Just Text
    "contextual"          -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesContextual
                   Maybe Text
    _                          -> Maybe DelimiterPrecedes
    forall a. Maybe a
    Nothing
             , nameDelimiterPrecedesLast :: Maybe DelimiterPrecedes
    nameDelimiterPrecedesLast  =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "delimiter-precedes-last" Attributes
    attr of
                   Just Text
    "after-inverted-name" -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesAfterInvertedName
                   Just Text
    "always"              -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesAlways
                   Just Text
    "never"               -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesNever
                   Just Text
    "contextual"          -> DelimiterPrecedes -> Maybe DelimiterPrecedes
    forall a. a -> Maybe a
    Just DelimiterPrecedes
    PrecedesContextual
                   Maybe Text
    _                          -> Maybe DelimiterPrecedes
    forall a. Maybe a
    Nothing
             , nameEtAlMin :: Maybe Int
    nameEtAlMin                =
               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
    "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 :: Maybe Bool
    nameEtAlUseLast            =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "et-al-use-last" Attributes
    attr of
                   Just Text
    "true" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
                   Just Text
    "false" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
                   Maybe Text
    _           -> Maybe Bool
    forall a. Maybe a
    Nothing
             , nameForm :: Maybe NameForm
    nameForm                   =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "name-form" Attributes
    attr of
                   Just Text
    "short"  -> NameForm -> Maybe NameForm
    forall a. a -> Maybe a
    Just NameForm
    ShortName
                   Just Text
    "count"  -> NameForm -> Maybe NameForm
    forall a. a -> Maybe a
    Just NameForm
    CountName
                   Just Text
    "long"   -> NameForm -> Maybe NameForm
    forall a. a -> Maybe a
    Just NameForm
    LongName
                   Maybe Text
    _             -> Maybe NameForm
    forall a. Maybe a
    Nothing
             , nameInitialize :: Maybe Bool
    nameInitialize             =
                 case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "initialize" Attributes
    attr of
                   Just Text
    "false" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
                   Just Text
    "true" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
                   Maybe Text
    _            -> Maybe Bool
    forall a. Maybe a
    Nothing
             , 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 :: Maybe Text
    nameSortSeparator          =
                 Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "sort-separator" Attributes
    attr
             }

    pLayout :: X.Element -> ElementParser (Layout a)
    pLayout :: forall a. Element -> ElementParser (Layout a)
    pLayout Element
    node = do
      let attr :: Attributes
    attr = Element -> Attributes
    getAttributes Element
    node
      let nameformat :: NameFormat
    nameformat = Attributes -> NameFormat
    getInheritableNameFormat Attributes
    attr
      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
      layout <- case [Element]
    layouts of
                  [] -> String -> ExceptT CiteprocError Identity Element
    forall a. String -> ElementParser a
    parseFailure (String -> ExceptT CiteprocError Identity Element)
    -> String -> ExceptT CiteprocError Identity 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 -> ExceptT CiteprocError Identity Element
    forall a. a -> ExceptT CiteprocError Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Element
    l
                  (Element
    _:[Element]
    _) -> String -> ExceptT CiteprocError Identity Element
    forall a. String -> ElementParser a
    parseFailure (String -> ExceptT CiteprocError Identity Element)
    -> String -> ExceptT CiteprocError Identity 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 = 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   = Text -> Element -> [Element]
    getChildren Text
    "sort" Element
    node
      elements <- mapM pElement $ allChildren layout
      let 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
                 , layoutNameFormat :: NameFormat
    layoutNameFormat = NameFormat
    nameformat
                 }
      sortKeys <- mapM pSortKey (concatMap (getChildren "key") sorts)
      return $ Layout { layoutOptions  = opts
                      , layoutFormatting = formatting{
                                             formatAffixesInside = True }
                      , layoutElements = elements
                      , layoutSortKeys = sortKeys
                      }

    pSortKey :: X.Element -> ElementParser (SortKey a)
    pSortKey :: forall a. Element -> ElementParser (SortKey a)
    pSortKey Element
    node = do
      let attr :: Attributes
    attr@(Attributes Map Text Text
    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
      -- The attributes names-min, names-use-first, and names-use-last may
      -- be used to override the values of the corresponding
      -- et-al-min/et-al-subsequent-min,
      -- et-al-use-first/et-al-subsequent-use-first and et-al-use-last
      -- attributes, and affect all names generated via macros called by
      -- cs:key.
      let keyChange :: a -> a
    keyChange a
    "names-min" = a
    "et-al-min"
          keyChange a
    "names-use-first" = a
    "et-al-use-first"
          keyChange a
    "names-use-last" = a
    "et-al-use-last"
          keyChange a
    "names-subsequent-min" = a
    "et-al-subsequent-min"
          keyChange a
    "names-subsequent-use-first" = a
    "et-al-subsequent-use-first"
          keyChange a
    x = a
    x
      let nameformat :: NameFormat
    nameformat = Attributes -> NameFormat
    getInheritableNameFormat
                         (Map Text Text -> Attributes
    Attributes ((Text -> Text) -> Map Text Text -> Map Text Text
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    M.mapKeys Text -> Text
    forall {a}. (Eq a, IsString a) => a -> a
    keyChange Map Text Text
    attr'))
      case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "macro" Attributes
    attr of
          Just Text
    macroname -> SortKey a -> ElementParser (SortKey a)
    forall a. a -> ExceptT CiteprocError Identity 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 -> NameFormat -> Text -> SortKey a
    forall a. SortDirection -> NameFormat -> Text -> SortKey a
    SortKeyMacro SortDirection
    direction NameFormat
    nameformat Text
    macroname
          Maybe Text
    Nothing   -> SortKey a -> ElementParser (SortKey a)
    forall a. a -> ExceptT CiteprocError Identity 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)

    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