    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    module Citeproc.Element
      ( pLocale
      , pDate
      , Attributes(..)
      , lookupAttribute
      , ElementParser
      , runElementParser
      , parseFailure
      , getChildren
      , allChildren
      , getAttributes
      , getNameAttributes
      , getFormatting
      , getTextContent
      )
    where
    import Citeproc.Types
    import Data.Maybe (fromMaybe)
    import Control.Monad (foldM)
    import qualified Data.Map as M
    import qualified Text.XML as X
    import Data.Text (Text)
    import qualified Data.Text as T
    import Control.Monad.Trans.Reader
    import Control.Monad.Trans.Except
    import Control.Monad.Trans.Class (lift)

    newtype Attributes = Attributes (M.Map Text Text)
      deriving (Int -> Attributes -> ShowS
    [Attributes] -> ShowS
    Attributes -> String
    (Int -> Attributes -> ShowS)
    -> (Attributes -> String)
    -> ([Attributes] -> ShowS)
    -> Show Attributes
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Attributes -> ShowS
    showsPrec :: Int -> Attributes -> ShowS
    $cshow :: Attributes -> String
    show :: Attributes -> String
    $cshowList :: [Attributes] -> ShowS
    showList :: [Attributes] -> ShowS
    Show, NonEmpty Attributes -> Attributes
    Attributes -> Attributes -> Attributes
    (Attributes -> Attributes -> Attributes)
    -> (NonEmpty Attributes -> Attributes)
    -> (forall b. Integral b => b -> Attributes -> Attributes)
    -> Semigroup Attributes
    forall b. Integral b => b -> Attributes -> Attributes
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    $c<> :: Attributes -> Attributes -> Attributes
    <> :: Attributes -> Attributes -> Attributes
    $csconcat :: NonEmpty Attributes -> Attributes
    sconcat :: NonEmpty Attributes -> Attributes
    $cstimes :: forall b. Integral b => b -> Attributes -> Attributes
    stimes :: forall b. Integral b => b -> Attributes -> Attributes
    Semigroup, Semigroup Attributes
    Attributes
    Semigroup Attributes =>
    Attributes
    -> (Attributes -> Attributes -> Attributes)
    -> ([Attributes] -> Attributes)
    -> Monoid Attributes
    [Attributes] -> Attributes
    Attributes -> Attributes -> Attributes
    forall a.
    Semigroup a =>
    a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
    $cmempty :: Attributes
    mempty :: Attributes
    $cmappend :: Attributes -> Attributes -> Attributes
    mappend :: Attributes -> Attributes -> Attributes
    $cmconcat :: [Attributes] -> Attributes
    mconcat :: [Attributes] -> Attributes
    Monoid, Attributes -> Attributes -> Bool
    (Attributes -> Attributes -> Bool)
    -> (Attributes -> Attributes -> Bool) -> Eq Attributes
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Attributes -> Attributes -> Bool
    == :: Attributes -> Attributes -> Bool
    $c/= :: Attributes -> Attributes -> Bool
    /= :: Attributes -> Attributes -> Bool
    Eq)

    lookupAttribute :: Text -> Attributes -> Maybe Text
    lookupAttribute :: Text -> Attributes -> Maybe Text
    lookupAttribute Text
    key (Attributes Map Text Text
    kvs) = Text -> Map Text Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    key Map Text Text
    kvs

    type ElementParser = ReaderT (M.Map X.Name Text) (Except CiteprocError)

    runElementParser :: ElementParser a -> Either CiteprocError a
    runElementParser :: forall a. ElementParser a -> Either CiteprocError a
    runElementParser ElementParser a
    p = Except CiteprocError a -> Either CiteprocError a
    forall e a. Except e a -> Either e a
    runExcept (ElementParser a -> Map Name Text -> Except CiteprocError a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ElementParser a
    p Map Name Text
    forall a. Monoid a => a
    mempty)

    parseFailure :: String -> ElementParser a
    parseFailure :: forall a. String -> ElementParser a
    parseFailure String
    s = Except CiteprocError a
    -> ReaderT (Map Name Text) (Except CiteprocError) a
    forall (m :: * -> *) a.
    Monad m =>
    m a -> ReaderT (Map Name Text) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Except CiteprocError a
     -> ReaderT (Map Name Text) (Except CiteprocError) a)
    -> Except CiteprocError a
    -> ReaderT (Map Name Text) (Except CiteprocError) a
    forall a b. (a -> b) -> a -> b
    $ CiteprocError -> Except CiteprocError a
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE (Text -> CiteprocError
    CiteprocParseError (Text -> CiteprocError) -> Text -> CiteprocError
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    s)

    getChildren :: Text -> X.Element -> [X.Element]
    getChildren :: Text -> Element -> [Element]
    getChildren Text
    name Element
    el = [Element
    e | X.NodeElement Element
    e <- Element -> [Node]
    X.elementNodes Element
    el
                             , Name -> Text
    X.nameLocalName (Element -> Name
    X.elementName Element
    e) Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    name]

    allChildren :: X.Element -> [X.Element]
    allChildren :: Element -> [Element]
    allChildren Element
    el = [Element
    e | X.NodeElement Element
    e <- Element -> [Node]
    X.elementNodes Element
    el]

    getAttributes :: X.Element -> Attributes
    getAttributes :: Element -> Attributes
    getAttributes =
      Map Text Text -> Attributes
    Attributes (Map Text Text -> Attributes)
    -> (Element -> Map Text Text) -> Element -> Attributes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name -> Text) -> Map Name Text -> Map Text Text
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    M.mapKeys Name -> Text
    X.nameLocalName (Map Name Text -> Map Text Text)
    -> (Element -> Map Name Text) -> Element -> Map Text Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> Map Name Text
    X.elementAttributes

    -- Like getAttributes but incorporates inheritable attributes.
    getNameAttributes :: X.Element -> ElementParser Attributes
    getNameAttributes :: Element -> ElementParser Attributes
    getNameAttributes Element
    node = do
      Map Name Text
    nameattr <- ReaderT (Map Name Text) (Except CiteprocError) (Map Name Text)
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      let xattr :: Map Name Text
    xattr = Element -> Map Name Text
    X.elementAttributes Element
    node Map Name Text -> Map Name Text -> Map Name Text
    forall a. Semigroup a => a -> a -> a
    <> Map Name Text
    nameattr
      Attributes -> ElementParser Attributes
    forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Attributes -> ElementParser Attributes)
    -> Attributes -> ElementParser Attributes
    forall a b. (a -> b) -> a -> b
    $ Map Text Text -> Attributes
    Attributes (Map Text Text -> Attributes) -> Map Text Text -> Attributes
    forall a b. (a -> b) -> a -> b
    $ (Name -> Text) -> Map Name Text -> Map Text Text
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    M.mapKeys Name -> Text
    X.nameLocalName Map Name Text
    xattr

    getFormatting :: Attributes -> Formatting
    getFormatting :: Attributes -> Formatting
    getFormatting Attributes
    attr =
       Formatting
         { formatLang :: Maybe Lang
    formatLang = Maybe Lang
    forall a. Maybe a
    Nothing
         , formatFontStyle :: Maybe FontStyle
    formatFontStyle =
              case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "font-style" Attributes
    attr of
                Just Text
    "italic"  -> FontStyle -> Maybe FontStyle
    forall a. a -> Maybe a
    Just FontStyle
    ItalicFont
                Just Text
    "oblique" -> FontStyle -> Maybe FontStyle
    forall a. a -> Maybe a
    Just FontStyle
    ObliqueFont
                Just Text
    "normal"  -> FontStyle -> Maybe FontStyle
    forall a. a -> Maybe a
    Just FontStyle
    NormalFont
                Maybe Text
    _              -> Maybe FontStyle
    forall a. Maybe a
    Nothing
          , formatFontVariant :: Maybe FontVariant
    formatFontVariant =
              case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "font-variant" Attributes
    attr of
                Just Text
    "small-caps" -> FontVariant -> Maybe FontVariant
    forall a. a -> Maybe a
    Just FontVariant
    SmallCapsVariant
                Just Text
    "normal"     -> FontVariant -> Maybe FontVariant
    forall a. a -> Maybe a
    Just FontVariant
    NormalVariant
                Maybe Text
    _                 -> Maybe FontVariant
    forall a. Maybe a
    Nothing
          , formatFontWeight :: Maybe FontWeight
    formatFontWeight =
              case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "font-weight" Attributes
    attr of
                Just Text
    "bold"   -> FontWeight -> Maybe FontWeight
    forall a. a -> Maybe a
    Just FontWeight
    BoldWeight
                Just Text
    "light"  -> FontWeight -> Maybe FontWeight
    forall a. a -> Maybe a
    Just FontWeight
    LightWeight
                Just Text
    "normal" -> FontWeight -> Maybe FontWeight
    forall a. a -> Maybe a
    Just FontWeight
    NormalWeight
                Maybe Text
    _             -> Maybe FontWeight
    forall a. Maybe a
    Nothing
          , formatTextDecoration :: Maybe TextDecoration
    formatTextDecoration =
              case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "text-decoration" Attributes
    attr of
                Just Text
    "underline" -> TextDecoration -> Maybe TextDecoration
    forall a. a -> Maybe a
    Just TextDecoration
    UnderlineDecoration
                Just Text
    "none"      -> TextDecoration -> Maybe TextDecoration
    forall a. a -> Maybe a
    Just TextDecoration
    NoDecoration
                Maybe Text
    _                -> Maybe TextDecoration
    forall a. Maybe a
    Nothing
          , formatVerticalAlign :: Maybe VerticalAlign
    formatVerticalAlign =
              case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "vertical-align" Attributes
    attr of
                Just Text
    "sup"       -> VerticalAlign -> Maybe VerticalAlign
    forall a. a -> Maybe a
    Just VerticalAlign
    SupAlign
                Just Text
    "sub"       -> VerticalAlign -> Maybe VerticalAlign
    forall a. a -> Maybe a
    Just VerticalAlign
    SubAlign
                Just Text
    "baseline"  -> VerticalAlign -> Maybe VerticalAlign
    forall a. a -> Maybe a
    Just VerticalAlign
    BaselineAlign
                Maybe Text
    _                -> Maybe VerticalAlign
    forall a. Maybe a
    Nothing
          , formatPrefix :: Maybe Text
    formatPrefix = Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "prefix" Attributes
    attr
          , formatSuffix :: Maybe Text
    formatSuffix = Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "suffix" Attributes
    attr
          , formatDisplay :: Maybe DisplayStyle
    formatDisplay =
              case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "display" Attributes
    attr of
                Just Text
    "block"        -> DisplayStyle -> Maybe DisplayStyle
    forall a. a -> Maybe a
    Just DisplayStyle
    DisplayBlock
                Just Text
    "left-margin"  -> DisplayStyle -> Maybe DisplayStyle
    forall a. a -> Maybe a
    Just DisplayStyle
    DisplayLeftMargin
                Just Text
    "right-inline" -> DisplayStyle -> Maybe DisplayStyle
    forall a. a -> Maybe a
    Just DisplayStyle
    DisplayRightInline
                Just Text
    "indent"       -> DisplayStyle -> Maybe DisplayStyle
    forall a. a -> Maybe a
    Just DisplayStyle
    DisplayIndent
                Maybe Text
    _                   -> Maybe DisplayStyle
    forall a. Maybe a
    Nothing
          , formatTextCase :: Maybe TextCase
    formatTextCase =
              case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "text-case" Attributes
    attr of
                Just Text
    "lowercase"        -> TextCase -> Maybe TextCase
    forall a. a -> Maybe a
    Just TextCase
    Lowercase
                Just Text
    "uppercase"        -> TextCase -> Maybe TextCase
    forall a. a -> Maybe a
    Just TextCase
    Uppercase
                Just Text
    "capitalize-first" -> TextCase -> Maybe TextCase
    forall a. a -> Maybe a
    Just TextCase
    CapitalizeFirst
                Just Text
    "capitalize-all"   -> TextCase -> Maybe TextCase
    forall a. a -> Maybe a
    Just TextCase
    CapitalizeAll
                Just Text
    "sentence"         -> TextCase -> Maybe TextCase
    forall a. a -> Maybe a
    Just TextCase
    SentenceCase
                Just Text
    "title"            -> TextCase -> Maybe TextCase
    forall a. a -> Maybe a
    Just TextCase
    TitleCase
                Maybe Text
    _                       -> Maybe TextCase
    forall a. Maybe a
    Nothing
          , formatDelimiter :: Maybe Text
    formatDelimiter = Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "delimiter" Attributes
    attr
          , formatStripPeriods :: Bool
    formatStripPeriods =
              Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "strip-periods" Attributes
    attr Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "true"
          , formatQuotes :: Bool
    formatQuotes =
              Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "quotes" Attributes
    attr Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "true"
          , formatAffixesInside :: Bool
    formatAffixesInside = Bool
    False -- should be true for layout only
          }

    getTextContent :: X.Element -> Text
    getTextContent :: Element -> Text
    getTextContent Element
    e = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat [Text
    t | X.NodeContent Text
    t <- Element -> [Node]
    X.elementNodes Element
    e]

    pLocale :: X.Element -> ElementParser Locale
    pLocale :: Element -> ElementParser Locale
    pLocale Element
    node = do
      let attr :: Attributes
    attr = Element -> Attributes
    getAttributes Element
    node
      Maybe Lang
    lang <- case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "lang" Attributes
    attr of
                Maybe Text
    Nothing -> Maybe Lang
    -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang)
    forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Lang
    forall a. Maybe a
    Nothing
                Just Text
    l  -> (String
     -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang))
    -> (Lang
        -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang))
    -> Either String Lang
    -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String
    -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang)
    forall a. String -> ElementParser a
    parseFailure (Maybe Lang
    -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang)
    forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Lang
     -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang))
    -> (Lang -> Maybe Lang)
    -> Lang
    -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Lang -> Maybe Lang
    forall a. a -> Maybe a
    Just) (Either String Lang
     -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang))
    -> Either String Lang
    -> ReaderT (Map Name Text) (Except CiteprocError) (Maybe Lang)
    forall a b. (a -> b) -> a -> b
    $ Text -> Either String Lang
    parseLang Text
    l
      let styleOpts :: Attributes
    styleOpts = [Attributes] -> Attributes
    forall a. Monoid a => [a] -> a
    mconcat ([Attributes] -> Attributes)
    -> ([Element] -> [Attributes]) -> [Element] -> Attributes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (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
    "style-options" Element
    node
      let addDateElt :: Element a -> Map DateType (Element a) -> Map DateType (Element a)
    addDateElt Element a
    e Map DateType (Element a)
    m =
            case Element a
    e of
              Element (EDate Variable
    _ DateType
    dateType Maybe ShowDateParts
    _ [DP]
    _) Formatting
    _ -> DateType
    -> Element a
    -> Map DateType (Element a)
    -> Map DateType (Element a)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert DateType
    dateType Element a
    e Map DateType (Element a)
    m
              Element a
    _ -> String -> Map DateType (Element a)
    forall a. HasCallStack => String -> a
    error String
    "pDate returned an element other than EDate"
      Map DateType (Element Text)
    dateElts <- (Element Text
     -> Map DateType (Element Text) -> Map DateType (Element Text))
    -> Map DateType (Element Text)
    -> [Element Text]
    -> Map DateType (Element Text)
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Element Text
    -> Map DateType (Element Text) -> Map DateType (Element Text)
    forall {a}.
    Element a -> Map DateType (Element a) -> Map DateType (Element a)
    addDateElt Map DateType (Element Text)
    forall a. Monoid a => a
    mempty ([Element Text] -> Map DateType (Element Text))
    -> ReaderT (Map Name Text) (Except CiteprocError) [Element Text]
    -> ReaderT
         (Map Name Text)
         (Except CiteprocError)
         (Map DateType (Element Text))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Element
     -> ReaderT (Map Name Text) (Except CiteprocError) (Element Text))
    -> [Element]
    -> ReaderT (Map Name Text) (Except CiteprocError) [Element Text]
    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 Text)
    forall a. Element -> ElementParser (Element a)
    pDate (Text -> Element -> [Element]
    getChildren Text
    "date" Element
    node)
      let termNodes :: [Element]
    termNodes = (Element -> [Element]) -> [Element] -> [Element]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Text -> Element -> [Element]
    getChildren Text
    "term") (Text -> Element -> [Element]
    getChildren Text
    "terms" Element
    node)
      Map Text [(Term, Text)]
    terms <- (Map Text [(Term, Text)]
     -> Element
     -> ReaderT
          (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)]))
    -> Map Text [(Term, Text)]
    -> [Element]
    -> ReaderT
         (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)])
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Map Text [(Term, Text)]
    -> Element
    -> ReaderT
         (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)])
    parseTerm Map Text [(Term, Text)]
    forall a. Monoid a => a
    mempty [Element]
    termNodes
      Locale -> ElementParser Locale
    forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Locale -> ElementParser Locale) -> Locale -> ElementParser Locale
    forall a b. (a -> b) -> a -> b
    $
        Locale
        { localeLanguage :: Maybe Lang
    localeLanguage               = Maybe Lang
    lang
        , localePunctuationInQuote :: Maybe Bool
    localePunctuationInQuote     = (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "true") (Text -> Bool) -> Maybe Text -> Maybe Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                   Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "punctuation-in-quote" Attributes
    styleOpts
        , localeLimitDayOrdinalsToDay1 :: Maybe Bool
    localeLimitDayOrdinalsToDay1 = (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "true") (Text -> Bool) -> Maybe Text -> Maybe Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                   Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "limit-day-ordinals-to-day-1" Attributes
    styleOpts
        , localeDate :: Map DateType (Element Text)
    localeDate                   = Map DateType (Element Text)
    dateElts
        , localeTerms :: Map Text [(Term, Text)]
    localeTerms                  = Map Text [(Term, Text)]
    terms
        }

    parseTerm :: M.Map Text [(Term, Text)]
              -> X.Element
              -> ElementParser (M.Map Text [(Term, Text)])
    parseTerm :: Map Text [(Term, Text)]
    -> Element
    -> ReaderT
         (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)])
    parseTerm Map Text [(Term, Text)]
    m Element
    node = do
      let attr :: Attributes
    attr = Element -> Attributes
    getAttributes Element
    node
      Text
    name <- case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "name" Attributes
    attr of
                    Just Text
    n   -> 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
    n
                    Maybe Text
    Nothing  -> String -> ReaderT (Map Name Text) (Except CiteprocError) Text
    forall a. String -> ElementParser a
    parseFailure String
    "Text node has no name attribute"
      let single :: Text
    single = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Element -> Text) -> [Element] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> Text
    getTextContent ([Element] -> [Text]) -> [Element] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> Element -> [Element]
    getChildren Text
    "single" Element
    node
      let multiple :: Text
    multiple = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Element -> Text) -> [Element] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> Text
    getTextContent ([Element] -> [Text]) -> [Element] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> Element -> [Element]
    getChildren Text
    "multiple" Element
    node
      let txt :: Text
    txt = Element -> Text
    getTextContent Element
    node
      let form :: TermForm
    form = 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 gender :: Maybe TermGender
    gender = case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "gender" Attributes
    attr of
                     Just Text
    "masculine"  -> TermGender -> Maybe TermGender
    forall a. a -> Maybe a
    Just TermGender
    Masculine
                     Just Text
    "feminine"   -> TermGender -> Maybe TermGender
    forall a. a -> Maybe a
    Just TermGender
    Feminine
                     Maybe Text
    _                 -> Maybe TermGender
    forall a. Maybe a
    Nothing
      let genderForm :: Maybe TermGender
    genderForm = case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "gender-form" Attributes
    attr of
                         Just Text
    "masculine"  -> TermGender -> Maybe TermGender
    forall a. a -> Maybe a
    Just TermGender
    Masculine
                         Just Text
    "feminine"   -> TermGender -> Maybe TermGender
    forall a. a -> Maybe a
    Just TermGender
    Feminine
                         Maybe Text
    _                 -> Maybe TermGender
    forall a. Maybe a
    Nothing
      let match :: Maybe TermMatch
    match = case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "match" Attributes
    attr of
                         Just Text
    "last-digit"      -> TermMatch -> Maybe TermMatch
    forall a. a -> Maybe a
    Just TermMatch
    LastDigit
                         Just Text
    "last-two-digits" -> TermMatch -> Maybe TermMatch
    forall a. a -> Maybe a
    Just TermMatch
    LastTwoDigits
                         Just Text
    "whole-number"    -> TermMatch -> Maybe TermMatch
    forall a. a -> Maybe a
    Just TermMatch
    WholeNumber
                         Maybe Text
    _                      -> Maybe TermMatch
    forall a. Maybe a
    Nothing
      let term :: Term
    term = Term
            { termName :: Text
    termName          = Text
    name
            , termForm :: TermForm
    termForm          = TermForm
    form
            , termNumber :: Maybe TermNumber
    termNumber        = Maybe TermNumber
    forall a. Maybe a
    Nothing
            , termGender :: Maybe TermGender
    termGender        = Maybe TermGender
    gender
            , termGenderForm :: Maybe TermGender
    termGenderForm    = Maybe TermGender
    genderForm
            , termMatch :: Maybe TermMatch
    termMatch         = Maybe TermMatch
    match
            }
      let addToList :: a -> Maybe [a] -> Maybe [a]
    addToList a
    x Maybe [a]
    Nothing   = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a
    x]
          addToList a
    x (Just [a]
    xs) = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs)
      if Text -> Bool
    T.null Text
    single
         then Map Text [(Term, Text)]
    -> ReaderT
         (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)])
    forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Text [(Term, Text)]
     -> ReaderT
          (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)]))
    -> Map Text [(Term, Text)]
    -> ReaderT
         (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)])
    forall a b. (a -> b) -> a -> b
    $ (Maybe [(Term, Text)] -> Maybe [(Term, Text)])
    -> Text -> Map Text [(Term, Text)] -> Map Text [(Term, Text)]
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    M.alter ((Term, Text) -> Maybe [(Term, Text)] -> Maybe [(Term, Text)]
    forall {a}. a -> Maybe [a] -> Maybe [a]
    addToList (Term
    term, Text
    txt)) (Term -> Text
    termName Term
    term) Map Text [(Term, Text)]
    m
         else do
           let term_single :: Term
    term_single = Term
    term{ termNumber = Just Singular }
           let term_plural :: Term
    term_plural = Term
    term{ termNumber = Just Plural }
           Map Text [(Term, Text)]
    -> ReaderT
         (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)])
    forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Text [(Term, Text)]
     -> ReaderT
          (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)]))
    -> Map Text [(Term, Text)]
    -> ReaderT
         (Map Name Text) (Except CiteprocError) (Map Text [(Term, Text)])
    forall a b. (a -> b) -> a -> b
    $ (Maybe [(Term, Text)] -> Maybe [(Term, Text)])
    -> Text -> Map Text [(Term, Text)] -> Map Text [(Term, Text)]
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    M.alter
              ((Term, Text) -> Maybe [(Term, Text)] -> Maybe [(Term, Text)]
    forall {a}. a -> Maybe [a] -> Maybe [a]
    addToList (Term
    term_single, Text
    single) (Maybe [(Term, Text)] -> Maybe [(Term, Text)])
    -> (Maybe [(Term, Text)] -> Maybe [(Term, Text)])
    -> Maybe [(Term, Text)]
    -> Maybe [(Term, Text)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
               (Term, Text) -> Maybe [(Term, Text)] -> Maybe [(Term, Text)]
    forall {a}. a -> Maybe [a] -> Maybe [a]
    addToList (Term
    term_plural, Text
    multiple)) (Term -> Text
    termName Term
    term) Map Text [(Term, Text)]
    m

    pDate :: X.Element -> ElementParser (Element a)
    pDate :: forall a. Element -> ElementParser (Element a)
    pDate Element
    node = do
      let attr :: Attributes
    attr = Element -> Attributes
    getAttributes Element
    node
      let formatting :: Formatting
    formatting = Attributes -> Formatting
    getFormatting Attributes
    attr
      let form :: Maybe Text
    form = Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "form" Attributes
    attr
      let var :: Variable
    var = 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
      let showDateParts :: Maybe ShowDateParts
    showDateParts = case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "date-parts" Attributes
    attr of
                            Just Text
    "year-month-day" -> ShowDateParts -> Maybe ShowDateParts
    forall a. a -> Maybe a
    Just ShowDateParts
    YearMonthDay
                            Just Text
    "year-month"     -> ShowDateParts -> Maybe ShowDateParts
    forall a. a -> Maybe a
    Just ShowDateParts
    YearMonth
                            Just Text
    "year"           -> ShowDateParts -> Maybe ShowDateParts
    forall a. a -> Maybe a
    Just ShowDateParts
    Year
                            Maybe Text
    _                     -> Maybe ShowDateParts
    forall a. Maybe a
    Nothing

      [DP]
    dps <- (Element -> ReaderT (Map Name Text) (Except CiteprocError) DP)
    -> [Element] -> ReaderT (Map Name Text) (Except CiteprocError) [DP]
    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) DP
    parseDatePartElement (Text -> Element -> [Element]
    getChildren Text
    "date-part" Element
    node)
      let dateType :: DateType
    dateType = case Maybe Text
    form of
                          Just Text
    "numeric" -> DateType
    LocalizedNumeric
                          Just Text
    "text"    -> DateType
    LocalizedText
                          Maybe Text
    _              -> DateType
    NonLocalized
      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
    -> DateType -> Maybe ShowDateParts -> [DP] -> ElementType a
    forall a.
    Variable
    -> DateType -> Maybe ShowDateParts -> [DP] -> ElementType a
    EDate Variable
    var DateType
    dateType Maybe ShowDateParts
    showDateParts [DP]
    dps) Formatting
    formatting

    parseDatePartElement :: X.Element -> ElementParser DP
    parseDatePartElement :: Element -> ReaderT (Map Name Text) (Except CiteprocError) DP
    parseDatePartElement Element
    node = do
      let attr :: Attributes
    attr = Element -> Attributes
    getAttributes Element
    node
      let formatting :: Formatting
    formatting = Attributes -> Formatting
    getFormatting Attributes
    attr
      let name :: DPName
    name = case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "name" Attributes
    attr of
                   Just Text
    "day"   -> DPName
    DPDay
                   Just Text
    "month" -> DPName
    DPMonth
                   Maybe Text
    _            -> DPName
    DPYear
      let form :: DPForm
    form = case Text -> Attributes -> Maybe Text
    lookupAttribute Text
    "form" Attributes
    attr of
                   Just Text
    "numeric"                -> DPForm
    DPNumeric
                   Just Text
    "numeric-leading-zeros"  -> DPForm
    DPNumericLeadingZeros
                   Just Text
    "ordinal"                -> DPForm
    DPOrdinal
                   Just Text
    "long"                   -> DPForm
    DPLong
                   Just Text
    "short"                  -> DPForm
    DPShort
                   Maybe Text
    _ | DPName
    name DPName -> DPName -> Bool
    forall a. Eq a => a -> a -> Bool
    == DPName
    DPDay             -> DPForm
    DPNumeric
                     | Bool
    otherwise                 -> DPForm
    DPLong
      let rangeDelim :: Text
    rangeDelim = 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
    "range-delimiter" Attributes
    attr
      DP -> ReaderT (Map Name Text) (Except CiteprocError) DP
    forall a. a -> ReaderT (Map Name Text) (Except CiteprocError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DP -> ReaderT (Map Name Text) (Except CiteprocError) DP)
    -> DP -> ReaderT (Map Name Text) (Except CiteprocError) DP
    forall a b. (a -> b) -> a -> b
    $ DPName -> DPForm -> Text -> Formatting -> DP
    DP DPName
    name DPForm
    form Text
    rangeDelim Formatting
    formatting