{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module Citeproc.Style
( parseStyle
, mergeLocales
)
where
import Citeproc.Types
import Citeproc.Locale
import Citeproc.Element
import Data.Text (Text)
import Control.Monad (foldM)
import Control.Applicative ((<|>))
import qualified Text.XML as X
import qualified Data.Text as T
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing)
import Data.Default (def)
import qualified Data.Text.Lazy as TL
import Control.Monad.Trans.Reader (local)
mergeLocales :: Maybe Lang -> Style a -> Locale
mergeLocales :: Maybe Lang -> Style a -> Locale
mergeLocales mblang :: Maybe Lang
mblang style :: 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
where
getUSLocale :: Locale
getUSLocale = case Lang -> Either CiteprocError Locale
getLocale (Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> [(Text, [(Text, Text)])]
-> [Text]
-> Lang
Lang "en" Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just"US") [] [] []) of
Right l :: Locale
l -> Locale
l
Left _ -> 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 "en" Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just"US") [] [] []) (Maybe Lang -> Lang) -> Maybe Lang -> Lang
forall a b. (a -> b) -> a -> b
$
Maybe Lang
mblang Maybe Lang -> Maybe Lang -> Maybe Lang
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 l :: Locale
l -> Locale
l
Left _ -> Locale
getUSLocale
primlang :: Maybe Lang
primlang = Lang -> Maybe Lang
getPrimaryDialect Lang
lang
stylelocales :: [Locale]
stylelocales =
[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]
++
[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]
++
[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]
++
[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)]
parseStyle :: Monad m
=> (Text -> m Text)
-> Text
-> m (Either CiteprocError (Style a))
parseStyle :: (Text -> m Text) -> Text -> m (Either CiteprocError (Style a))
parseStyle getIndependentParent :: Text -> m Text
getIndependentParent t :: Text
t =
case ParseSettings -> Text -> Either SomeException Document
X.parseText ParseSettings
forall a. Default a => a
def (Text -> Text
TL.fromStrict Text
t) of
Left e :: SomeException
e -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style 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 n :: 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 "default-locale" Attributes
attr of
Nothing -> Maybe Lang
forall a. Maybe a
Nothing
Just l :: 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 "link") ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren "info"
(Document -> Element
X.documentRoot Document
n)
case [Element -> Attributes
getAttributes Element
l
| Element
l <- [Element]
links
, Text -> Attributes -> Maybe Text
lookupAttribute "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 "independent-parent" ] of
[] -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style 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
(lattr :: Attributes
lattr:_) ->
case Text -> Attributes -> Maybe Text
lookupAttribute "href" Attributes
lattr of
Nothing -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style 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
"No href attribute on link to parent style"
Just url :: Text
url -> do
Text
parentTxt <- Text -> m Text
getIndependentParent Text
url
case ParseSettings -> Text -> Either SomeException Document
X.parseText ParseSettings
forall a. Default a => a
def (Text -> Text
TL.fromStrict Text
parentTxt) of
Left e :: SomeException
e -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style 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 n' :: Document
n' -> Either CiteprocError (Style a)
-> m (Either CiteprocError (Style 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 :: Maybe Lang -> Element -> ElementParser (Style a)
pStyle defaultLocale :: Maybe Lang
defaultLocale node :: Element
node = do
let attrmap :: Map Name Text
attrmap = Element -> Map Name Text
getInheritableNameAttributes Element
node
(Map Name Text -> Map Name Text)
-> ElementParser (Style a) -> ElementParser (Style a)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (Map Name Text -> Map Name Text -> Map Name Text
forall a. Semigroup a => a -> a -> a
<> Map Name Text
attrmap) (ElementParser (Style a) -> ElementParser (Style a))
-> ElementParser (Style a) -> ElementParser (Style a)
forall a b. (a -> b) -> a -> b
$ do
let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
Map Text [Element]
macroMap <- [(Text, [Element])] -> Map Text [Element]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, [Element])] -> Map Text [Element])
-> ReaderT
(Map Name Text) (Except CiteprocError) [(Text, [Element])]
-> ReaderT
(Map Name Text) (Except CiteprocError) (Map Text [Element])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element
-> ReaderT
(Map Name Text) (Except CiteprocError) (Text, [Element]))
-> [Element]
-> ReaderT
(Map Name Text) (Except CiteprocError) [(Text, [Element])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Text, [Element])
pMacro (Text -> Element -> [Element]
getChildren "macro" Element
node)
(cattr :: Attributes
cattr, citations :: Layout a
citations)
<- case Text -> Element -> [Element]
getChildren "citation" Element
node of
[n :: Element
n] -> (Element -> Attributes
getAttributes Element
n,) (Layout a -> (Attributes, Layout a))
-> ReaderT (Map Name Text) (Except CiteprocError) (Layout a)
-> ReaderT
(Map Name Text) (Except CiteprocError) (Attributes, Layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [Element]
-> Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Layout a)
forall a. Map Text [Element] -> Element -> ElementParser (Layout a)
pLayout Map Text [Element]
macroMap Element
n
[] -> String
-> ReaderT
(Map Name Text) (Except CiteprocError) (Attributes, Layout a)
forall a. String -> ElementParser a
parseFailure "No citation element present"
_ -> String
-> ReaderT
(Map Name Text) (Except CiteprocError) (Attributes, Layout a)
forall a. String -> ElementParser a
parseFailure "More than one citation element present"
(battr :: Attributes
battr, bibliography :: Maybe (Layout a)
bibliography) <- case Text -> Element -> [Element]
getChildren "bibliography" Element
node of
[n :: Element
n] -> (\z :: Layout a
z -> (Element -> Attributes
getAttributes Element
n, Layout a -> Maybe (Layout a)
forall a. a -> Maybe a
Just Layout a
z))
(Layout a -> (Attributes, Maybe (Layout a)))
-> ReaderT (Map Name Text) (Except CiteprocError) (Layout a)
-> ReaderT
(Map Name Text)
(Except CiteprocError)
(Attributes, Maybe (Layout a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [Element]
-> Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Layout a)
forall a. Map Text [Element] -> Element -> ElementParser (Layout a)
pLayout Map Text [Element]
macroMap Element
n
[] -> (Attributes, Maybe (Layout a))
-> ReaderT
(Map Name Text)
(Except CiteprocError)
(Attributes, Maybe (Layout a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Attributes
forall a. Monoid a => a
mempty, Maybe (Layout a)
forall a. Maybe a
Nothing)
_ -> String
-> ReaderT
(Map Name Text)
(Except CiteprocError)
(Attributes, Maybe (Layout a))
forall a. String -> ElementParser a
parseFailure
"More than one bibliography element present"
let disambiguateGivenNameRule :: GivenNameDisambiguationRule
disambiguateGivenNameRule =
case Text -> Attributes -> Maybe Text
lookupAttribute "givenname-disambiguation-rule" Attributes
cattr of
Just "all-names" -> GivenNameDisambiguationRule
AllNames
Just "all-names-with-initials" -> GivenNameDisambiguationRule
AllNamesWithInitials
Just "primary-name" -> GivenNameDisambiguationRule
PrimaryName
Just "primary-name-with-initials" -> GivenNameDisambiguationRule
PrimaryNameWithInitials
_ -> GivenNameDisambiguationRule
ByCite
let disambigStrategy :: DisambiguationStrategy
disambigStrategy =
$WDisambiguationStrategy :: Bool
-> Maybe GivenNameDisambiguationRule
-> Bool
-> DisambiguationStrategy
DisambiguationStrategy
{ disambiguateAddNames :: Bool
disambiguateAddNames =
Text -> Attributes -> Maybe Text
lookupAttribute "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 "true"
, disambiguateAddGivenNames :: Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames =
case Text -> Attributes -> Maybe Text
lookupAttribute "disambiguate-add-givenname" Attributes
cattr of
Just "true" -> GivenNameDisambiguationRule -> Maybe GivenNameDisambiguationRule
forall a. a -> Maybe a
Just GivenNameDisambiguationRule
disambiguateGivenNameRule
_ -> Maybe GivenNameDisambiguationRule
forall a. Maybe a
Nothing
, disambiguateAddYearSuffix :: Bool
disambiguateAddYearSuffix =
Text -> Attributes -> Maybe Text
lookupAttribute "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 "true"
}
let hasYearSuffixVariable :: Element a -> Bool
hasYearSuffixVariable
(Element (EText (TextVariable _ "year-suffix")) _) = Bool
True
hasYearSuffixVariable
(Element (EGroup _ es :: [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
hasYearSuffixVariable
(Element (EChoose []) _) = Bool
False
hasYearSuffixVariable
(Element (EChoose ((_,_,es :: [Element a]
es):conds :: [(Match, [Condition], [Element a])]
conds)) f :: Formatting
f) =
(Element a -> Bool) -> [Element a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Element a -> Bool
hasYearSuffixVariable [Element a]
es Bool -> Bool -> Bool
||
Element a -> Bool
hasYearSuffixVariable (ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element ([(Match, [Condition], [Element a])] -> ElementType a
forall a. [(Match, [Condition], [Element a])] -> ElementType a
EChoose [(Match, [Condition], [Element a])]
conds) Formatting
f)
hasYearSuffixVariable _ = Bool
False
let usesYearSuffixVariable :: Bool
usesYearSuffixVariable =
(Element a -> Bool) -> [Element a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Element a -> Bool
forall a. Element a -> Bool
hasYearSuffixVariable ([Element a] -> Bool) -> [Element a] -> Bool
forall a b. (a -> b) -> a -> b
$
Layout a -> [Element a]
forall a. Layout a -> [Element a]
layoutElements Layout a
citations [Element a] -> [Element a] -> [Element a]
forall a. [a] -> [a] -> [a]
++ [Element a]
-> (Layout a -> [Element a]) -> Maybe (Layout a) -> [Element a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Layout a -> [Element a]
forall a. Layout a -> [Element a]
layoutElements Maybe (Layout a)
bibliography
let sOpts :: StyleOptions
sOpts = $WStyleOptions :: Bool
-> Maybe Lang
-> DemoteNonDroppingParticle
-> Bool
-> Maybe PageRangeFormat
-> Maybe Text
-> DisambiguationStrategy
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Bool
-> Maybe SecondFieldAlign
-> Maybe SubsequentAuthorSubstitute
-> Bool
-> StyleOptions
StyleOptions
{ styleIsNoteStyle :: Bool
styleIsNoteStyle =
case Text -> Attributes -> Maybe Text
lookupAttribute "class" Attributes
attr of
Just "note" -> Bool
True
Nothing -> Bool
True
_ -> Bool
False
, styleDefaultLocale :: Maybe Lang
styleDefaultLocale = Maybe Lang
defaultLocale
, styleDemoteNonDroppingParticle :: DemoteNonDroppingParticle
styleDemoteNonDroppingParticle =
case Text -> Attributes -> Maybe Text
lookupAttribute "demote-non-dropping-particle" Attributes
attr of
Just "never" -> DemoteNonDroppingParticle
DemoteNever
Just "sort-only" -> DemoteNonDroppingParticle
DemoteSortOnly
_ -> 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
== "true") (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$
Text -> Attributes -> Maybe Text
lookupAttribute "initialize-with-hyphen" Attributes
attr
, stylePageRangeFormat :: Maybe PageRangeFormat
stylePageRangeFormat =
case Text -> Attributes -> Maybe Text
lookupAttribute "page-range-format" Attributes
attr of
Just "chicago" -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeChicago
Just "expanded" -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeExpanded
Just "minimal" -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeMinimal
Just "minimal-two" -> PageRangeFormat -> Maybe PageRangeFormat
forall a. a -> Maybe a
Just PageRangeFormat
PageRangeMinimalTwo
_ -> Maybe PageRangeFormat
forall a. Maybe a
Nothing
, stylePageRangeDelimiter :: Maybe Text
stylePageRangeDelimiter =
Text -> Attributes -> Maybe Text
lookupAttribute "page-range-delimiter" Attributes
attr
, styleDisambiguation :: DisambiguationStrategy
styleDisambiguation = DisambiguationStrategy
disambigStrategy
, styleNearNoteDistance :: Maybe Int
styleNearNoteDistance =
Text -> Attributes -> Maybe Text
lookupAttribute "near-note-distance" Attributes
attr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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 "cite-group-delimiter" Attributes
cattr Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(", " Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Attributes -> Maybe Text
lookupAttribute "collapse" Attributes
cattr)
, styleLineSpacing :: Maybe Int
styleLineSpacing =
Text -> Attributes -> Maybe Text
lookupAttribute "line-spacing" Attributes
battr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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 "entry-spacing" Attributes
battr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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 "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 "true"
, styleSecondFieldAlign :: Maybe SecondFieldAlign
styleSecondFieldAlign =
case Text -> Attributes -> Maybe Text
lookupAttribute "second-field-align" Attributes
battr of
Just "flush" -> SecondFieldAlign -> Maybe SecondFieldAlign
forall a. a -> Maybe a
Just SecondFieldAlign
SecondFieldAlignFlush
Just "margin" -> SecondFieldAlign -> Maybe SecondFieldAlign
forall a. a -> Maybe a
Just SecondFieldAlign
SecondFieldAlignMargin
_ -> Maybe SecondFieldAlign
forall a. Maybe a
Nothing
, styleSubsequentAuthorSubstitute :: Maybe SubsequentAuthorSubstitute
styleSubsequentAuthorSubstitute =
case Text -> Attributes -> Maybe Text
lookupAttribute "subsequent-author-substitute"
Attributes
battr of
Nothing -> Maybe SubsequentAuthorSubstitute
forall a. Maybe a
Nothing
Just t :: 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
"subsequent-author-substitute-rule" Attributes
battr of
Just "complete-each" -> SubsequentAuthorSubstituteRule
CompleteEach
Just "partial-each" -> SubsequentAuthorSubstituteRule
PartialEach
Just "partial-first" -> SubsequentAuthorSubstituteRule
PartialFirst
_ -> SubsequentAuthorSubstituteRule
CompleteAll
, styleUsesYearSuffixVariable :: Bool
styleUsesYearSuffixVariable = Bool
usesYearSuffixVariable
}
[Locale]
locales <- (Element -> ReaderT (Map Name Text) (Except CiteprocError) Locale)
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Locale]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> ReaderT (Map Name Text) (Except CiteprocError) Locale
pLocale (Text -> Element -> [Element]
getChildren "locale" Element
node)
let cslVersion :: (Int, Int, Int)
cslVersion = case Text -> Attributes -> Maybe Text
lookupAttribute "version" Attributes
attr of
Nothing -> (0,0,0)
Just t :: Text
t ->
case (Text -> Maybe Int) -> [Text] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Int
readAsInt (Text -> Text -> [Text]
T.splitOn "." Text
t) of
(Just x :: Int
x : Just y :: Int
y : Just z :: Int
z :_) -> (Int
x,Int
y,Int
z)
(Just x :: Int
x : Just y :: Int
y : _) -> (Int
x,Int
y,0)
(Just x :: Int
x : _) -> (Int
x,0,0)
_ -> (0,0,0)
Style a -> ElementParser (Style a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Style a -> ElementParser (Style a))
-> Style a -> ElementParser (Style a)
forall a b. (a -> b) -> a -> b
$ $WStyle :: forall a.
(Int, Int, Int)
-> StyleOptions
-> Layout a
-> Maybe (Layout a)
-> [Locale]
-> Maybe Abbreviations
-> Style a
Style
{ styleCslVersion :: (Int, Int, Int)
styleCslVersion = (Int, Int, Int)
cslVersion
, styleOptions :: StyleOptions
styleOptions = StyleOptions
sOpts
, styleCitation :: Layout a
styleCitation = Layout a
citations
, styleBibliography :: Maybe (Layout a)
styleBibliography = Maybe (Layout a)
bibliography
, styleLocales :: [Locale]
styleLocales = [Locale]
locales
, styleAbbreviations :: Maybe Abbreviations
styleAbbreviations = Maybe Abbreviations
forall a. Maybe a
Nothing
}
pElement :: X.Element -> ElementParser (Element a)
pElement :: Element -> ElementParser (Element a)
pElement node :: Element
node =
case Name -> Text
X.nameLocalName (Element -> Name
X.elementName Element
node) of
"date" -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pDate Element
node
"text" -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pText Element
node
"group" -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pGroup Element
node
"choose" -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pChoose Element
node
"number" -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pNumber Element
node
"label" -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pLabel Element
node
"names" -> Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pNames Element
node
name :: 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
$ "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 :: Element -> ElementParser (Element a)
pChoose node :: Element
node = do
[(Match, [Condition], [Element a])]
ifNodes <- (Element
-> ReaderT
(Map Name Text)
(Except CiteprocError)
(Match, [Condition], [Element a]))
-> [Element]
-> ReaderT
(Map Name Text)
(Except CiteprocError)
[(Match, [Condition], [Element a])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> ReaderT
(Map Name Text)
(Except CiteprocError)
(Match, [Condition], [Element a])
forall a.
Element -> ElementParser (Match, [Condition], [Element a])
parseIf ([Element]
-> ReaderT
(Map Name Text)
(Except CiteprocError)
[(Match, [Condition], [Element a])])
-> [Element]
-> ReaderT
(Map Name Text)
(Except CiteprocError)
[(Match, [Condition], [Element a])]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren "if" Element
node
[(Match, [Condition], [Element a])]
elseIfNodes <- (Element
-> ReaderT
(Map Name Text)
(Except CiteprocError)
(Match, [Condition], [Element a]))
-> [Element]
-> ReaderT
(Map Name Text)
(Except CiteprocError)
[(Match, [Condition], [Element a])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> ReaderT
(Map Name Text)
(Except CiteprocError)
(Match, [Condition], [Element a])
forall a.
Element -> ElementParser (Match, [Condition], [Element a])
parseIf ([Element]
-> ReaderT
(Map Name Text)
(Except CiteprocError)
[(Match, [Condition], [Element a])])
-> [Element]
-> ReaderT
(Map Name Text)
(Except CiteprocError)
[(Match, [Condition], [Element a])]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren "else-if" Element
node
[(Match, [Condition], [Element a])]
elseNodes <- (Element
-> ReaderT
(Map Name Text)
(Except CiteprocError)
(Match, [Condition], [Element a]))
-> [Element]
-> ReaderT
(Map Name Text)
(Except CiteprocError)
[(Match, [Condition], [Element a])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> ReaderT
(Map Name Text)
(Except CiteprocError)
(Match, [Condition], [Element a])
forall a.
Element -> ElementParser (Match, [Condition], [Element a])
parseIf ([Element]
-> ReaderT
(Map Name Text)
(Except CiteprocError)
[(Match, [Condition], [Element a])])
-> [Element]
-> ReaderT
(Map Name Text)
(Except CiteprocError)
[(Match, [Condition], [Element a])]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren "else" Element
node
let parts :: [(Match, [Condition], [Element a])]
parts = [(Match, [Condition], [Element a])]
ifNodes [(Match, [Condition], [Element a])]
-> [(Match, [Condition], [Element a])]
-> [(Match, [Condition], [Element a])]
forall a. [a] -> [a] -> [a]
++ [(Match, [Condition], [Element a])]
elseIfNodes [(Match, [Condition], [Element a])]
-> [(Match, [Condition], [Element a])]
-> [(Match, [Condition], [Element a])]
forall a. [a] -> [a] -> [a]
++ [(Match, [Condition], [Element a])]
elseNodes
Element a -> ElementParser (Element a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element ([(Match, [Condition], [Element a])] -> ElementType a
forall a. [(Match, [Condition], [Element a])] -> ElementType a
EChoose [(Match, [Condition], [Element a])]
parts) Formatting
forall a. Monoid a => a
mempty
parseIf :: X.Element -> ElementParser (Match, [Condition], [Element a])
parseIf :: Element -> ElementParser (Match, [Condition], [Element a])
parseIf node :: Element
node = do
let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
let match :: Match
match = case Text -> Attributes -> Maybe Text
lookupAttribute "match" Attributes
attr of
Just "any" -> Match
MatchAny
Just "none" -> Match
MatchNone
_ -> Match
MatchAll
let conditions :: [Condition]
conditions =
(case Text -> Attributes -> Maybe Text
lookupAttribute "disambiguate" Attributes
attr of
Just "true" -> (Condition
WouldDisambiguate Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
_ -> [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 "is-numeric" Attributes
attr of
Just t :: Text
t -> \xs :: [Condition]
xs -> (Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
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)
_ -> [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 "is-uncertain-date" Attributes
attr of
Just t :: Text
t -> \xs :: [Condition]
xs -> (Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
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)
_ -> [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 "locator" Attributes
attr of
Just t :: Text
t -> \xs :: [Condition]
xs -> (Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
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)
_ -> [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 "position" Attributes
attr of
Just t :: Text
t -> \xs :: [Condition]
xs ->
(Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\case
"first" -> (Position -> Condition
HasPosition Position
FirstPosition Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
"ibid" -> (Position -> Condition
HasPosition Position
Ibid Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
"ibid-with-locator"
-> (Position -> Condition
HasPosition Position
IbidWithLocator Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
"subsequent" -> (Position -> Condition
HasPosition Position
Subsequent Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
"near-note" -> (Position -> Condition
HasPosition Position
NearNote Condition -> [Condition] -> [Condition]
forall a. a -> [a] -> [a]
:)
_ -> [Condition] -> [Condition]
forall a. a -> a
id)
[Condition]
xs (Text -> [Variable]
splitVars Text
t)
_ -> [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 "type" Attributes
attr of
Just t :: Text
t -> \xs :: [Condition]
xs -> (Text -> [Condition] -> [Condition])
-> [Condition] -> [Text] -> [Condition]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Condition -> [Condition] -> [Condition])
-> (Text -> Condition) -> Text -> [Condition] -> [Condition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Condition
HasType) [Condition]
xs (Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t)
_ -> [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 "variable" Attributes
attr of
Just t :: Text
t -> \xs :: [Condition]
xs -> (Variable -> [Condition] -> [Condition])
-> [Condition] -> [Variable] -> [Condition]
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)
_ -> [Condition] -> [Condition]
forall a. a -> a
id) ([Condition] -> [Condition]) -> [Condition] -> [Condition]
forall a b. (a -> b) -> a -> b
$ []
[Element a]
elts <- (Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a)
forall a. Element -> ElementParser (Element a)
pElement ([Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a])
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
allChildren Element
node
(Match, [Condition], [Element a])
-> ElementParser (Match, [Condition], [Element a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Match
match, [Condition]
conditions, [Element a]
elts)
pNumber :: X.Element -> ElementParser (Element a)
pNumber :: Element -> ElementParser (Element a)
pNumber node :: 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 "variable" Attributes
attr
let numform :: NumberForm
numform = case Text -> Attributes -> Maybe Text
lookupAttribute "form" Attributes
attr of
Just "ordinal" -> NumberForm
NumberOrdinal
Just "long-ordinal" -> NumberForm
NumberLongOrdinal
Just "roman" -> NumberForm
NumberRoman
_ -> NumberForm
NumberNumeric
case Maybe Text
variable of
Nothing -> String -> ElementParser (Element a)
forall a. String -> ElementParser a
parseFailure "number element without required variable attribute"
Just var :: Text
var -> Element a -> ElementParser (Element 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 :: Element -> ElementParser (Element a)
pLabel node :: 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 "" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute "variable" Attributes
attr
let labelform :: TermForm
labelform = case Text -> Attributes -> Maybe Text
lookupAttribute "form" Attributes
attr of
Just "short" -> TermForm
Short
Just "verb" -> TermForm
Verb
Just "verb-short" -> TermForm
VerbShort
Just "symbol" -> TermForm
Symbol
_ -> TermForm
Long
let pluralize :: Pluralize
pluralize = case Text -> Attributes -> Maybe Text
lookupAttribute "plural" Attributes
attr of
Just "always" -> Pluralize
AlwaysPluralize
Just "never" -> Pluralize
NeverPluralize
_ -> Pluralize
ContextualPluralize
Element a -> ElementParser (Element a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element (Variable -> TermForm -> Pluralize -> ElementType a
forall a. Variable -> TermForm -> Pluralize -> ElementType a
ELabel Variable
variable TermForm
labelform Pluralize
pluralize) Formatting
formatting
pNames :: X.Element -> ElementParser (Element a)
pNames :: Element -> ElementParser (Element a)
pNames node :: Element
node = do
Attributes
attr <- Element -> ElementParser Attributes
getNameAttributes Element
node
let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
let variables :: [Variable]
variables = [Variable] -> (Text -> [Variable]) -> Maybe Text -> [Variable]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Variable]
splitVars (Maybe Text -> [Variable]) -> Maybe Text -> [Variable]
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute "variable" Attributes
attr
let pChild :: (NamesFormat, [Element a])
-> Element
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
pChild (nf :: NamesFormat
nf,subst :: [Element a]
subst) n :: Element
n =
case Name -> Text
X.nameLocalName (Element -> Name
X.elementName Element
n) of
"label" -> do
Element Any
e <- Element -> ElementParser (Element Any)
forall a. Element -> ElementParser (Element a)
pLabel Element
n
case Element Any
e of
Element (ELabel _ labelform :: TermForm
labelform pluralize :: Pluralize
pluralize) f :: Formatting
f ->
(NamesFormat, [Element a])
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall (m :: * -> *) a. Monad m => a -> m a
return ( NamesFormat
nf{ namesLabel :: Maybe (TermForm, Pluralize, Formatting)
namesLabel = (TermForm, Pluralize, Formatting)
-> Maybe (TermForm, Pluralize, Formatting)
forall a. a -> Maybe a
Just (TermForm
labelform, Pluralize
pluralize, Formatting
f)
, namesLabelBeforeName :: Bool
namesLabelBeforeName =
Maybe (NameFormat, Formatting) -> Bool
forall a. Maybe a -> Bool
isNothing (NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
nf) }
, [Element a]
subst )
_ -> String
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a. String -> ElementParser a
parseFailure "pLabel returned something other than ELabel"
"substitute" -> do
[Element a]
els <- (Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a)
forall a. Element -> ElementParser (Element a)
pElement ([Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a])
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
allChildren Element
n
(NamesFormat, [Element a])
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall (m :: * -> *) a. Monad m => a -> m a
return ( NamesFormat
nf, [Element a]
els )
"et-al" -> do
(Text, Formatting)
res <- Element -> ElementParser (Text, Formatting)
pEtAl Element
n
(NamesFormat, [Element a])
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall (m :: * -> *) a. Monad m => a -> m a
return ( NamesFormat
nf{ namesEtAl :: Maybe (Text, Formatting)
namesEtAl = (Text, Formatting) -> Maybe (Text, Formatting)
forall a. a -> Maybe a
Just (Text, Formatting)
res }, [Element a]
subst )
"name" -> do
(NameFormat, Formatting)
res <- Element -> ElementParser (NameFormat, Formatting)
pName Element
n
(NamesFormat, [Element a])
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall (m :: * -> *) a. Monad m => a -> m a
return ( NamesFormat
nf{ namesName :: Maybe (NameFormat, Formatting)
namesName = (NameFormat, Formatting) -> Maybe (NameFormat, Formatting)
forall a. a -> Maybe a
Just (NameFormat, Formatting)
res }, [Element a]
subst )
name :: Text
name -> String
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a. String -> ElementParser a
parseFailure (String
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a]))
-> String
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a b. (a -> b) -> a -> b
$ "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
<>
" not a valid child of names"
(nameformat :: NamesFormat
nameformat, subst :: [Element a]
subst) <-
((NamesFormat, [Element a])
-> Element
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a]))
-> (NamesFormat, [Element a])
-> [Element]
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (NamesFormat, [Element a])
-> Element
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
forall a.
(NamesFormat, [Element a])
-> Element
-> ReaderT
(Map Name Text) (Except CiteprocError) (NamesFormat, [Element a])
pChild (Maybe (TermForm, Pluralize, Formatting)
-> Maybe (Text, Formatting)
-> Maybe (NameFormat, Formatting)
-> Bool
-> NamesFormat
NamesFormat Maybe (TermForm, Pluralize, Formatting)
forall a. Maybe a
Nothing Maybe (Text, Formatting)
forall a. Maybe a
Nothing Maybe (NameFormat, Formatting)
forall a. Maybe a
Nothing Bool
False, [])
(Element -> [Element]
allChildren Element
node)
Element a -> ElementParser (Element a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element ([Variable] -> NamesFormat -> [Element a] -> ElementType a
forall a. [Variable] -> NamesFormat -> [Element a] -> ElementType a
ENames [Variable]
variables NamesFormat
nameformat [Element a]
subst) Formatting
formatting
pEtAl :: X.Element -> ElementParser (Text, Formatting)
pEtAl :: Element -> ElementParser (Text, Formatting)
pEtAl node :: 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 "et-al" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute "term" Attributes
attr
(Text, Formatting) -> ElementParser (Text, Formatting)
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 node :: Element
node = do
Attributes
attr <- Element -> ElementParser Attributes
getNameAttributes Element
node
let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
let nameParts :: [Attributes]
nameParts = (Element -> Attributes) -> [Element] -> [Attributes]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Attributes
getAttributes ([Element] -> [Attributes]) -> [Element] -> [Attributes]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
getChildren "name-part" Element
node
let nameformat :: NameFormat
nameformat = $WNameFormat :: Maybe Formatting
-> Maybe Formatting
-> Maybe TermForm
-> Text
-> DelimiterPrecedes
-> DelimiterPrecedes
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> NameForm
-> Bool
-> Maybe Text
-> Maybe NameAsSortOrder
-> Text
-> NameFormat
NameFormat
{ nameGivenFormatting :: Maybe Formatting
nameGivenFormatting =
case [Attributes
nattr
| Attributes
nattr <- [Attributes]
nameParts
, Text -> Attributes -> Maybe Text
lookupAttribute "name" Attributes
nattr Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just "given" ] of
(nattr :: Attributes
nattr:_) -> 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
_ -> Maybe Formatting
forall a. Maybe a
Nothing
, nameFamilyFormatting :: Maybe Formatting
nameFamilyFormatting =
case [Attributes
nattr
| Attributes
nattr <- [Attributes]
nameParts
, Text -> Attributes -> Maybe Text
lookupAttribute "name" Attributes
nattr Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just "family" ] of
(nattr :: Attributes
nattr:_) -> 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
_ -> Maybe Formatting
forall a. Maybe a
Nothing
, nameAndStyle :: Maybe TermForm
nameAndStyle =
case Text -> Attributes -> Maybe Text
lookupAttribute "and" Attributes
attr of
Just "text" -> TermForm -> Maybe TermForm
forall a. a -> Maybe a
Just TermForm
Long
Just "symbol" -> TermForm -> Maybe TermForm
forall a. a -> Maybe a
Just TermForm
Symbol
_ -> Maybe TermForm
forall a. Maybe a
Nothing
, nameDelimiter :: Text
nameDelimiter =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ", " (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute "delimiter" Attributes
attr
, nameDelimiterPrecedesEtAl :: DelimiterPrecedes
nameDelimiterPrecedesEtAl =
case Text -> Attributes -> Maybe Text
lookupAttribute "delimiter-precedes-et-al" Attributes
attr of
Just "after-inverted-name" -> DelimiterPrecedes
PrecedesAfterInvertedName
Just "always" -> DelimiterPrecedes
PrecedesAlways
Just "never" -> DelimiterPrecedes
PrecedesNever
_ -> DelimiterPrecedes
PrecedesContextual
, nameDelimiterPrecedesLast :: DelimiterPrecedes
nameDelimiterPrecedesLast =
case Text -> Attributes -> Maybe Text
lookupAttribute "delimiter-precedes-last" Attributes
attr of
Just "after-inverted-name" -> DelimiterPrecedes
PrecedesAfterInvertedName
Just "always" -> DelimiterPrecedes
PrecedesAlways
Just "never" -> DelimiterPrecedes
PrecedesNever
_ -> DelimiterPrecedes
PrecedesContextual
, nameEtAlMin :: Maybe Int
nameEtAlMin =
(Text -> Attributes -> Maybe Text
lookupAttribute "names-min" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> Attributes -> Maybe Text
lookupAttribute "et-al-min" Attributes
attr) Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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 "names-use-first" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> Attributes -> Maybe Text
lookupAttribute "et-al-use-first" Attributes
attr) Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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 "et-al-subsequent-use-first" Attributes
attr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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 "et-al-subsequent-min" Attributes
attr Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readAsInt
, nameEtAlUseLast :: Bool
nameEtAlUseLast =
case Text -> Attributes -> Maybe Text
lookupAttribute "names-use-last" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> Attributes -> Maybe Text
lookupAttribute "et-al-use-last" Attributes
attr of
Just "true" -> Bool
True
_ -> Bool
False
, nameForm :: NameForm
nameForm =
case Text -> Attributes -> Maybe Text
lookupAttribute "form" Attributes
attr of
Just "short" -> NameForm
ShortName
Just "count" -> NameForm
CountName
_ -> NameForm
LongName
, nameInitialize :: Bool
nameInitialize =
case Text -> Attributes -> Maybe Text
lookupAttribute "initialize" Attributes
attr of
Just "false" -> Bool
False
_ -> Bool
True
, nameInitializeWith :: Maybe Text
nameInitializeWith =
Text -> Attributes -> Maybe Text
lookupAttribute "initialize-with" Attributes
attr
, nameAsSortOrder :: Maybe NameAsSortOrder
nameAsSortOrder =
case Text -> Attributes -> Maybe Text
lookupAttribute "name-as-sort-order" Attributes
attr of
Just "all" -> NameAsSortOrder -> Maybe NameAsSortOrder
forall a. a -> Maybe a
Just NameAsSortOrder
NameAsSortOrderAll
Just "first" -> NameAsSortOrder -> Maybe NameAsSortOrder
forall a. a -> Maybe a
Just NameAsSortOrder
NameAsSortOrderFirst
_ -> Maybe NameAsSortOrder
forall a. Maybe a
Nothing
, nameSortSeparator :: Text
nameSortSeparator =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ", " (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attributes -> Maybe Text
lookupAttribute "sort-separator" Attributes
attr
}
(NameFormat, Formatting) -> ElementParser (NameFormat, Formatting)
forall (m :: * -> *) a. Monad m => a -> m a
return (NameFormat
nameformat, Formatting
formatting)
pGroup :: X.Element -> ElementParser (Element a)
pGroup :: Element -> ElementParser (Element a)
pGroup node :: Element
node = do
let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
let formatting :: Formatting
formatting = Attributes -> Formatting
getFormatting Attributes
attr
[Element a]
es <- (Element -> ElementParser (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pElement ([Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a])
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
allChildren Element
node
Element a -> ElementParser (Element a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element (Bool -> [Element a] -> ElementType a
forall a. Bool -> [Element a] -> ElementType a
EGroup Bool
False [Element a]
es) Formatting
formatting
pText :: X.Element -> ElementParser (Element a)
pText :: Element -> ElementParser (Element a)
pText node :: 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 "form" Attributes
attr of
Just "short" -> VariableForm
ShortForm
_ -> VariableForm
LongForm
let termform :: TermForm
termform = case Text -> Attributes -> Maybe Text
lookupAttribute "form" Attributes
attr of
Just "short" -> TermForm
Short
Just "verb" -> TermForm
Verb
Just "verb-short" -> TermForm
VerbShort
Just "symbol" -> TermForm
Symbol
_ -> TermForm
Long
let termnumber :: Maybe TermNumber
termnumber = case Text -> Attributes -> Maybe Text
lookupAttribute "plural" Attributes
attr of
Just "true" -> TermNumber -> Maybe TermNumber
forall a. a -> Maybe a
Just TermNumber
Plural
Just "false" -> TermNumber -> Maybe TermNumber
forall a. a -> Maybe a
Just TermNumber
Singular
_ -> Maybe TermNumber
forall a. Maybe a
Nothing
ElementType a
elt <- case Text -> Attributes -> Maybe Text
lookupAttribute "variable" Attributes
attr of
Just var :: Text
var -> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a))
-> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a b. (a -> b) -> a -> b
$ TextType -> ElementType a
forall a. TextType -> ElementType a
EText (VariableForm -> Variable -> TextType
TextVariable VariableForm
varform (Text -> Variable
toVariable Text
var))
Nothing ->
case Text -> Attributes -> Maybe Text
lookupAttribute "macro" Attributes
attr of
Just _ -> do
[Element a]
elements <- (Element -> ElementParser (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> ElementParser (Element a)
forall a. Element -> ElementParser (Element a)
pElement (Element -> [Element]
allChildren Element
node)
ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a))
-> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a b. (a -> b) -> a -> b
$ Bool -> [Element a] -> ElementType a
forall a. Bool -> [Element a] -> ElementType a
EGroup Bool
True [Element a]
elements
Nothing ->
case Text -> Attributes -> Maybe Text
lookupAttribute "term" Attributes
attr of
Just termname :: Text
termname ->
ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a))
-> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a b. (a -> b) -> a -> b
$ TextType -> ElementType a
forall a. TextType -> ElementType a
EText (Term -> TextType
TextTerm
$WTerm :: Text
-> TermForm
-> Maybe TermNumber
-> Maybe TermGender
-> Maybe TermGender
-> Maybe TermMatch
-> Term
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
})
Nothing ->
case Text -> Attributes -> Maybe Text
lookupAttribute "value" Attributes
attr of
Just val :: Text
val ->
ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a))
-> ElementType a
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a b. (a -> b) -> a -> b
$ TextType -> ElementType a
forall a. TextType -> ElementType a
EText (Text -> TextType
TextValue Text
val)
Nothing ->
String
-> ReaderT (Map Name Text) (Except CiteprocError) (ElementType a)
forall a. String -> ElementParser a
parseFailure "text element lacks needed attribute"
Element a -> ElementParser (Element a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element a -> ElementParser (Element a))
-> Element a -> ElementParser (Element a)
forall a b. (a -> b) -> a -> b
$ ElementType a -> Formatting -> Element a
forall a. ElementType a -> Formatting -> Element a
Element ElementType a
elt Formatting
formatting
pMacro :: X.Element -> ElementParser (Text, [X.Element])
pMacro :: Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Text, [Element])
pMacro node :: Element
node = do
Text
name <- case Text -> Attributes -> Maybe Text
lookupAttribute "name" (Element -> Attributes
getAttributes Element
node) of
Just t :: Text
t -> Text -> ReaderT (Map Name Text) (Except CiteprocError) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
Nothing -> String -> ReaderT (Map Name Text) (Except CiteprocError) Text
forall a. String -> ElementParser a
parseFailure "macro element missing name attribute"
(Text, [Element])
-> ReaderT (Map Name Text) (Except CiteprocError) (Text, [Element])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Element -> [Element]
allChildren Element
node)
inheritableNameAttributes :: M.Map X.Name X.Name
inheritableNameAttributes :: Map Name Name
inheritableNameAttributes = [(Name, Name)] -> Map Name Name
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Name)] -> Map Name Name)
-> [(Name, Name)] -> Map Name Name
forall a b. (a -> b) -> a -> b
$
((Text, Text) -> (Name, Name)) -> [(Text, Text)] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: Text
x,y :: Text
y) -> (Text -> Name
attname Text
x, Text -> Name
attname Text
y))
[ ("and", "and")
, ("delimiter-precedes-et-al", "delimiter-precedes-et-al")
, ("delimiter-precedes-last", "delimiter-precedes-last")
, ("et-al-min", "et-al-min")
, ("et-al-use-first", "et-al-use-first")
, ("et-al-use-last", "et-al-use-last")
, ("et-al-subsequent-min", "et-al-subsequent-min")
, ("et-al-subsequent-use-first", "et-al-subsequent-use-first")
, ("initialize", "initialize")
, ("initialize-with", "initialize-with")
, ("name-as-sort-order", "name-as-sort-order")
, ("sort-separator", "sort-separator")
, ("name-form", "form")
, ("name-delimiter", "delimiter")
, ("names-delimiter", "delimiter")
, ("names-min", "names-min")
, ("names-use-first", "names-use-first")
, ("names-use-last", "names-use-last")
]
getInheritableNameAttributes :: X.Element -> M.Map X.Name Text
getInheritableNameAttributes :: Element -> Map Name Text
getInheritableNameAttributes elt :: Element
elt =
(Name -> Text -> Map Name Text -> Map Name Text)
-> Map Name Text -> Map Name Text -> Map Name Text
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey
(\k :: Name
k v :: Text
v m :: Map Name Text
m -> case Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
k Map Name Name
inheritableNameAttributes of
Just k' :: Name
k' -> Name -> Text -> Map Name Text -> Map Name Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
k' Text
v Map Name Text
m
Nothing -> Map Name Text
m) Map Name Text
forall k a. Map k a
M.empty (Element -> Map Name Text
X.elementAttributes Element
elt)
pLayout :: M.Map Text [X.Element] -> X.Element -> ElementParser (Layout a)
pLayout :: Map Text [Element] -> Element -> ElementParser (Layout a)
pLayout macroMap :: Map Text [Element]
macroMap node :: Element
node = do
let attrmap :: Map Name Text
attrmap = Element -> Map Name Text
getInheritableNameAttributes Element
node
let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
(Map Name Text -> Map Name Text)
-> ElementParser (Layout a) -> ElementParser (Layout a)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (Map Name Text -> Map Name Text -> Map Name Text
forall a. Semigroup a => a -> a -> a
<> Map Name Text
attrmap) (ElementParser (Layout a) -> ElementParser (Layout a))
-> ElementParser (Layout a) -> ElementParser (Layout a)
forall a b. (a -> b) -> a -> b
$ do
Element
node' <- Map Text [Element] -> Element -> ElementParser Element
expandMacros Map Text [Element]
macroMap Element
node
let layouts :: [Element]
layouts = Text -> Element -> [Element]
getChildren "layout" Element
node'
let formatting :: Formatting
formatting = [Formatting] -> Formatting
forall a. Monoid a => [a] -> a
mconcat ([Formatting] -> Formatting) -> [Formatting] -> Formatting
forall a b. (a -> b) -> a -> b
$ (Element -> Formatting) -> [Element] -> [Formatting]
forall a b. (a -> b) -> [a] -> [b]
map (Attributes -> Formatting
getFormatting (Attributes -> Formatting)
-> (Element -> Attributes) -> Element -> Formatting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Attributes
getAttributes) [Element]
layouts
let sorts :: [Element]
sorts = Text -> Element -> [Element]
getChildren "sort" Element
node'
[Element a]
elements <- (Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a)
forall a. Element -> ElementParser (Element a)
pElement ((Element -> [Element]) -> [Element] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Element -> [Element]
allChildren [Element]
layouts)
let opts :: LayoutOptions
opts = $WLayoutOptions :: Maybe Collapsing -> Maybe Text -> Maybe Text -> LayoutOptions
LayoutOptions
{ layoutCollapse :: Maybe Collapsing
layoutCollapse =
case Text -> Attributes -> Maybe Text
lookupAttribute "collapse" Attributes
attr of
Just "citation-number" -> Collapsing -> Maybe Collapsing
forall a. a -> Maybe a
Just Collapsing
CollapseCitationNumber
Just "year" -> Collapsing -> Maybe Collapsing
forall a. a -> Maybe a
Just Collapsing
CollapseYear
Just "year-suffix" -> Collapsing -> Maybe Collapsing
forall a. a -> Maybe a
Just Collapsing
CollapseYearSuffix
Just "year-suffix-ranged"
-> Collapsing -> Maybe Collapsing
forall a. a -> Maybe a
Just Collapsing
CollapseYearSuffixRanged
_ -> Maybe Collapsing
forall a. Maybe a
Nothing
, layoutYearSuffixDelimiter :: Maybe Text
layoutYearSuffixDelimiter =
Text -> Attributes -> Maybe Text
lookupAttribute "year-suffix-delimiter" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> Attributes -> Maybe Text
lookupAttribute "cite-group-delimiter" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
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 "after-collapse-delimiter" Attributes
attr Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Formatting -> Maybe Text
formatDelimiter Formatting
formatting
}
[SortKey a]
sortKeys <- (Element
-> ReaderT (Map Name Text) (Except CiteprocError) (SortKey a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [SortKey a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (SortKey a)
forall a. Element -> ElementParser (SortKey a)
pSortKey ((Element -> [Element]) -> [Element] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Element -> [Element]
getChildren "key") [Element]
sorts)
Layout a -> ElementParser (Layout a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout a -> ElementParser (Layout a))
-> Layout a -> ElementParser (Layout a)
forall a b. (a -> b) -> a -> b
$ $WLayout :: forall a.
LayoutOptions
-> Formatting -> [Element a] -> [SortKey a] -> Layout a
Layout { layoutOptions :: LayoutOptions
layoutOptions = LayoutOptions
opts
, layoutFormatting :: Formatting
layoutFormatting = Formatting
formatting{
formatAffixesInside :: Bool
formatAffixesInside = Bool
True }
, layoutElements :: [Element a]
layoutElements = [Element a]
elements
, layoutSortKeys :: [SortKey a]
layoutSortKeys = [SortKey a]
sortKeys
}
pSortKey :: X.Element -> ElementParser (SortKey a)
pSortKey :: Element -> ElementParser (SortKey a)
pSortKey node :: Element
node = do
let attrmap :: Map Name Text
attrmap = Element -> Map Name Text
getInheritableNameAttributes Element
node
(Map Name Text -> Map Name Text)
-> ElementParser (SortKey a) -> ElementParser (SortKey a)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (Map Name Text -> Map Name Text -> Map Name Text
forall a. Semigroup a => a -> a -> a
<> Map Name Text
attrmap) (ElementParser (SortKey a) -> ElementParser (SortKey a))
-> ElementParser (SortKey a) -> ElementParser (SortKey a)
forall a b. (a -> b) -> a -> b
$ do
let attr :: Attributes
attr = Element -> Attributes
getAttributes Element
node
let direction :: SortDirection
direction = case Text -> Attributes -> Maybe Text
lookupAttribute "sort" Attributes
attr of
Just "descending" -> SortDirection
Descending
_ -> SortDirection
Ascending
case Text -> Attributes -> Maybe Text
lookupAttribute "macro" Attributes
attr of
Just _ ->
SortDirection -> [Element a] -> SortKey a
forall a. SortDirection -> [Element a] -> SortKey a
SortKeyMacro SortDirection
direction ([Element a] -> SortKey a)
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
-> ElementParser (SortKey a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a))
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Element a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> ReaderT (Map Name Text) (Except CiteprocError) (Element a)
forall a. Element -> ElementParser (Element a)
pElement (Element -> [Element]
allChildren Element
node)
Nothing -> SortKey a -> ElementParser (SortKey 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 "variable" Attributes
attr)
attname :: Text -> X.Name
attname :: Text -> Name
attname t :: Text
t = Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
t Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
expandMacros :: M.Map Text [X.Element]
-> X.Element
-> ElementParser X.Element
expandMacros :: Map Text [Element] -> Element -> ElementParser Element
expandMacros macroMap :: Map Text [Element]
macroMap el :: Element
el =
case Name -> Text
X.nameLocalName (Element -> Name
X.elementName Element
el) of
n :: Text
n | Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "text" Bool -> Bool -> Bool
||
Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "key" ->
case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Name
attname "macro") (Element -> Map Name Text
X.elementAttributes Element
el) of
Nothing -> do
[Node]
els' <- (Node -> ReaderT (Map Name Text) (Except CiteprocError) Node)
-> [Node] -> ReaderT (Map Name Text) (Except CiteprocError) [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node -> ReaderT (Map Name Text) (Except CiteprocError) Node
expandNode (Element -> [Node]
X.elementNodes Element
el)
Element -> ElementParser Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ElementParser Element)
-> Element -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ Element
el{ elementNodes :: [Node]
X.elementNodes = [Node]
els' }
Just macroName :: Text
macroName ->
case Text -> Map Text [Element] -> Maybe [Element]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
macroName Map Text [Element]
macroMap of
Nothing ->
String -> ElementParser Element
forall a. String -> ElementParser a
parseFailure (String -> ElementParser Element)
-> String -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ "macro " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
macroName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " not found"
Just els :: [Element]
els -> do
[Node]
els' <- (Element -> ReaderT (Map Name Text) (Except CiteprocError) Node)
-> [Element]
-> ReaderT (Map Name Text) (Except CiteprocError) [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Element -> Node)
-> ElementParser Element
-> ReaderT (Map Name Text) (Except CiteprocError) Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
X.NodeElement (ElementParser Element
-> ReaderT (Map Name Text) (Except CiteprocError) Node)
-> (Element -> ElementParser Element)
-> Element
-> ReaderT (Map Name Text) (Except CiteprocError) Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text [Element] -> Element -> ElementParser Element
expandMacros Map Text [Element]
macroMap) [Element]
els
Element -> ElementParser Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ElementParser Element)
-> Element -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ Element
el{ elementNodes :: [Node]
X.elementNodes = [Node]
els' }
_ -> do
[Node]
els' <- (Node -> ReaderT (Map Name Text) (Except CiteprocError) Node)
-> [Node] -> ReaderT (Map Name Text) (Except CiteprocError) [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node -> ReaderT (Map Name Text) (Except CiteprocError) Node
expandNode (Element -> [Node]
X.elementNodes Element
el)
Element -> ElementParser Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ElementParser Element)
-> Element -> ElementParser Element
forall a b. (a -> b) -> a -> b
$ Element
el{ elementNodes :: [Node]
X.elementNodes = [Node]
els' }
where
expandNode :: Node -> ReaderT (Map Name Text) (Except CiteprocError) Node
expandNode (X.NodeElement el' :: Element
el') = Element -> Node
X.NodeElement (Element -> Node)
-> ElementParser Element
-> ReaderT (Map Name Text) (Except CiteprocError) Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [Element] -> Element -> ElementParser Element
expandMacros Map Text [Element]
macroMap Element
el'
expandNode x :: Node
x = Node -> ReaderT (Map Name Text) (Except CiteprocError) Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
x
splitVars :: Text -> [Variable]
splitVars :: Text -> [Variable]
splitVars = (Text -> Variable) -> [Text] -> [Variable]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Variable
toVariable ([Text] -> [Variable]) -> (Text -> [Text]) -> Text -> [Variable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip