{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.CSL.Parser (readCSLFile, parseCSL, parseCSL',
parseLocale, localizeCSL)
where
import Prelude
import qualified Control.Exception as E
import Control.Monad (when)
import qualified Data.ByteString.Lazy as L
import Data.Either (lefts, rights)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Text (Text, unpack)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import System.Directory (getAppUserDataDirectory)
import Text.CSL.Compat.Pandoc (fetchItem)
import Text.CSL.Data (getLocale)
import Text.CSL.Exception
import Text.CSL.Style hiding (parseNames)
import Text.CSL.Util (findFile, toRead, trim)
import Text.Pandoc.Shared (safeRead)
import qualified Text.XML as X
import Text.XML.Cursor
parseCSL :: Text -> Style
parseCSL :: Text -> Style
parseCSL = ByteString -> Style
parseCSL' (ByteString -> Style) -> (Text -> ByteString) -> Text -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
parseLocale :: Text -> IO Locale
parseLocale :: Text -> IO Locale
parseLocale Text
locale =
Cursor -> Locale
parseLocaleElement (Cursor -> Locale)
-> (ByteString -> Cursor) -> ByteString -> Locale
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Cursor
fromDocument (Document -> Cursor)
-> (ByteString -> Document) -> ByteString -> Cursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSettings -> ByteString -> Document
X.parseLBS_ ParseSettings
forall a. Default a => a
X.def (ByteString -> Locale) -> IO ByteString -> IO Locale
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO ByteString
getLocale Text
locale
localizeCSL :: Maybe Text -> Style -> IO Style
localizeCSL :: Maybe Text -> Style -> IO Style
localizeCSL Maybe Text
mbLocale Style
s = do
let locale :: Text
locale = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Style -> Text
styleDefaultLocale Style
s) Maybe Text
mbLocale
Locale
l <- Text -> IO Locale
parseLocale Text
locale
Style -> IO Style
forall (m :: * -> *) a. Monad m => a -> m a
return Style
s { styleLocale :: [Locale]
styleLocale = Text -> Locale -> [Locale] -> [Locale]
mergeLocales Text
locale Locale
l (Style -> [Locale]
styleLocale Style
s) }
readCSLFile :: Maybe Text -> FilePath -> IO Style
readCSLFile :: Maybe Text -> FilePath -> IO Style
readCSLFile Maybe Text
mbLocale FilePath
src = do
FilePath
csldir <- FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"csl"
Maybe FilePath
mbSrc <- [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile [FilePath
".", FilePath
csldir] FilePath
src
Either SomeException (ByteString, Maybe Text)
fetchRes <- FilePath -> IO (Either SomeException (ByteString, Maybe Text))
fetchItem (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
src Maybe FilePath
mbSrc)
ByteString
f <- case Either SomeException (ByteString, Maybe Text)
fetchRes of
Left SomeException
err -> SomeException -> IO ByteString
forall e a. Exception e => e -> IO a
E.throwIO SomeException
err
Right (ByteString
rawbs, Maybe Text
_) -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
rawbs]
let cur :: Cursor
cur = Document -> Cursor
fromDocument (Document -> Cursor) -> Document -> Cursor
forall a b. (a -> b) -> a -> b
$ ParseSettings -> ByteString -> Document
X.parseLBS_ ParseSettings
forall a. Default a => a
X.def ByteString
f
let pickParentCur :: Cursor -> [Cursor]
pickParentCur = Text -> Cursor -> [Cursor]
get Text
"link" (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Text -> Cursor -> [Cursor]
attributeIs (Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
"rel" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Text
"independent-parent"
let parentCur :: [Cursor]
parentCur = Cursor
cur Cursor -> (Cursor -> [Cursor]) -> [Cursor]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"info" (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Cursor]
pickParentCur
let parent' :: Text
parent' = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Cursor -> Text) -> [Cursor] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Cursor -> Text
stringAttr Text
"href") [Cursor]
parentCur
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
parent' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
T.pack FilePath
src) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
CiteprocException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (CiteprocException -> IO ()) -> CiteprocException -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> CiteprocException
DependentStyleHasItselfAsParent FilePath
src
case Text
parent' of
Text
"" -> Maybe Text -> Style -> IO Style
localizeCSL Maybe Text
mbLocale (Style -> IO Style) -> Style -> IO Style
forall a b. (a -> b) -> a -> b
$ Cursor -> Style
parseCSLCursor Cursor
cur
Text
y -> do
let mbLocale' :: Maybe Text
mbLocale' = case Text -> Cursor -> Text
stringAttr Text
"default-locale" Cursor
cur of
Text
"" -> Maybe Text
mbLocale
Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
Maybe Text -> FilePath -> IO Style
readCSLFile Maybe Text
mbLocale' (Text -> FilePath
T.unpack Text
y)
parseCSL' :: L.ByteString -> Style
parseCSL' :: ByteString -> Style
parseCSL' = Cursor -> Style
parseCSLCursor (Cursor -> Style) -> (ByteString -> Cursor) -> ByteString -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Cursor
fromDocument (Document -> Cursor)
-> (ByteString -> Document) -> ByteString -> Cursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSettings -> ByteString -> Document
X.parseLBS_ ParseSettings
forall a. Default a => a
X.def
parseCSLCursor :: Cursor -> Style
parseCSLCursor :: Cursor -> Style
parseCSLCursor Cursor
cur =
Style :: Text
-> Text
-> Maybe CSInfo
-> Text
-> [Locale]
-> Abbreviations
-> [Option]
-> [MacroMap]
-> Citation
-> Maybe Bibliography
-> Style
Style{ styleVersion :: Text
styleVersion = FilePath -> Text
T.pack FilePath
version
, styleClass :: Text
styleClass = FilePath -> Text
T.pack FilePath
class_
, styleInfo :: Maybe CSInfo
styleInfo = CSInfo -> Maybe CSInfo
forall a. a -> Maybe a
Just CSInfo
info
, styleDefaultLocale :: Text
styleDefaultLocale = Text
defaultLocale
, styleLocale :: [Locale]
styleLocale = [Locale]
locales
, styleAbbrevs :: Abbreviations
styleAbbrevs = Map Text (Map Text (Map Text Text)) -> Abbreviations
Abbreviations Map Text (Map Text (Map Text Text))
forall k a. Map k a
M.empty
, csOptions :: [Option]
csOptions = (Option -> Bool) -> [Option] -> [Option]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`
[Text
"class",
Text
"xmlns",
Text
"version",
Text
"default-locale"]) ([Option] -> [Option]) -> [Option] -> [Option]
forall a b. (a -> b) -> a -> b
$ Cursor -> [Option]
parseOptions Cursor
cur
, csMacros :: [MacroMap]
csMacros = [MacroMap]
macros
, citation :: Citation
citation = Citation -> Maybe Citation -> Citation
forall a. a -> Maybe a -> a
fromMaybe ([Option] -> [Sort] -> Layout -> Citation
Citation [] [] Layout :: Formatting -> Text -> [Element] -> Layout
Layout{ layFormat :: Formatting
layFormat = Formatting
emptyFormatting
, layDelim :: Text
layDelim = Text
""
, elements :: [Element]
elements = [] }) (Maybe Citation -> Citation) -> Maybe Citation -> Citation
forall a b. (a -> b) -> a -> b
$ [Citation] -> Maybe Citation
forall a. [a] -> Maybe a
listToMaybe ([Citation] -> Maybe Citation) -> [Citation] -> Maybe Citation
forall a b. (a -> b) -> a -> b
$
Cursor
cur Cursor -> (Cursor -> [Citation]) -> [Citation]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"citation" (Cursor -> [Cursor])
-> (Cursor -> Citation) -> Cursor -> [Citation]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Citation
parseCitation
, biblio :: Maybe Bibliography
biblio = [Bibliography] -> Maybe Bibliography
forall a. [a] -> Maybe a
listToMaybe ([Bibliography] -> Maybe Bibliography)
-> [Bibliography] -> Maybe Bibliography
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Bibliography]) -> [Bibliography]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"bibliography" (Cursor -> [Cursor])
-> (Cursor -> Bibliography) -> Cursor -> [Bibliography]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Bibliography
parseBiblio
}
where version :: FilePath
version = Text -> FilePath
unpack (Text -> FilePath) -> ([Text] -> Text) -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> FilePath) -> [Text] -> FilePath
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> [Text]
laxAttribute Text
"version"
class_ :: FilePath
class_ = Text -> FilePath
unpack (Text -> FilePath) -> ([Text] -> Text) -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> FilePath) -> [Text] -> FilePath
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> [Text]
laxAttribute Text
"class"
defaultLocale :: Text
defaultLocale = case Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> [Text]
laxAttribute Text
"default-locale" of
(Text
x:[Text]
_) -> Text
x
[] -> Text
"en-US"
author :: CSAuthor
author = case Cursor
cur Cursor -> (Cursor -> [Cursor]) -> [Cursor]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Cursor]
get Text
"info" (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get Text
"author" of
(Cursor
x:[Cursor]
_) -> Text -> Text -> Text -> CSAuthor
CSAuthor ([Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
x Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"name" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content)
([Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
x Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"email" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content)
([Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
x Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"uri" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content)
[Cursor]
_ -> Text -> Text -> Text -> CSAuthor
CSAuthor Text
"" Text
"" Text
""
info :: CSInfo
info = CSInfo :: Text -> CSAuthor -> [CSCategory] -> Text -> Text -> CSInfo
CSInfo
{ csiTitle :: Text
csiTitle = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"info" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get Text
"title" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content)
, csiAuthor :: CSAuthor
csiAuthor = CSAuthor
author
, csiCategories :: [CSCategory]
csiCategories = []
, csiId :: Text
csiId = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"info" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get Text
"id" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
, csiUpdated :: Text
csiUpdated = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"info" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get Text
"updated" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
}
locales :: [Locale]
locales = Cursor
cur Cursor -> (Cursor -> [Locale]) -> [Locale]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"locale" (Cursor -> [Cursor]) -> (Cursor -> Locale) -> Cursor -> [Locale]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Locale
parseLocaleElement
macros :: [MacroMap]
macros = Cursor
cur Cursor -> (Cursor -> [MacroMap]) -> [MacroMap]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"macro" (Cursor -> [Cursor])
-> (Cursor -> MacroMap) -> Cursor -> [MacroMap]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> MacroMap
parseMacroMap
get :: Text -> Axis
get :: Text -> Cursor -> [Cursor]
get Text
name =
Name -> Cursor -> [Cursor]
element (Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
name (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://purl.org/net/xbiblio/csl") Maybe Text
forall a. Maybe a
Nothing)
attrWithDefault :: Read a => Text -> a -> Cursor -> a
attrWithDefault :: Text -> a -> Cursor -> a
attrWithDefault Text
t a
d Cursor
cur =
a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
d (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Text -> Maybe a
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Text
toRead (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text
stringAttr Text
t Cursor
cur)
stringAttr :: Text -> Cursor -> Text
stringAttr :: Text -> Cursor -> Text
stringAttr Text
t Cursor
cur =
case Cursor -> Node
forall node. Cursor node -> node
node Cursor
cur of
X.NodeElement Element
e ->
case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
t Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) (Element -> Map Name Text
X.elementAttributes Element
e) of
Just Text
x -> Text
x
Maybe Text
Nothing -> Text
""
Node
_ -> Text
""
parseCslTerm :: Cursor -> CslTerm
parseCslTerm :: Cursor -> CslTerm
parseCslTerm Cursor
cur =
let body :: Text
body = Text -> Text
trim (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content
in CT :: Text -> Form -> Gender -> Gender -> Text -> Text -> Text -> CslTerm
CT
{ cslTerm :: Text
cslTerm = Text -> Cursor -> Text
stringAttr Text
"name" Cursor
cur
, termForm :: Form
termForm = Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"form" Form
Long Cursor
cur
, termGender :: Gender
termGender = Text -> Gender -> Cursor -> Gender
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"gender" Gender
Neuter Cursor
cur
, termGenderForm :: Gender
termGenderForm = Text -> Gender -> Cursor -> Gender
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"gender-form" Gender
Neuter Cursor
cur
, termSingular :: Text
termSingular = if Text -> Bool
T.null Text
body
then [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"single" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
else Text
body
, termPlural :: Text
termPlural = if Text -> Bool
T.null Text
body
then [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"multiple" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
else Text
body
, termMatch :: Text
termMatch = Text -> Cursor -> Text
stringAttr Text
"match" Cursor
cur
}
parseLocaleElement :: Cursor -> Locale
parseLocaleElement :: Cursor -> Locale
parseLocaleElement Cursor
cur = Locale :: Text -> Text -> [Option] -> [CslTerm] -> [Element] -> Locale
Locale
{ localeVersion :: Text
localeVersion = [Text] -> Text
T.concat [Text]
version
, localeLang :: Text
localeLang = [Text] -> Text
T.concat [Text]
lang
, localeOptions :: [Option]
localeOptions = [[Option]] -> [Option]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Option]] -> [Option]) -> [[Option]] -> [Option]
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [[Option]]) -> [[Option]]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"style-options" (Cursor -> [Cursor])
-> (Cursor -> [Option]) -> Cursor -> [[Option]]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> [Option]
parseOptions
, localeTerms :: [CslTerm]
localeTerms = [CslTerm]
terms
, localeDate :: [Element]
localeDate = [[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Element]] -> [Element]) -> [[Element]] -> [Element]
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [[Element]]) -> [[Element]]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"date" (Cursor -> [Cursor])
-> (Cursor -> [Element]) -> Cursor -> [[Element]]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> [Element]
parseElement
}
where version :: [Text]
version = Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> [Text]
laxAttribute Text
"version"
lang :: [Text]
lang = Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> [Text]
laxAttribute Text
"lang"
terms :: [CslTerm]
terms = Cursor
cur Cursor -> (Cursor -> [CslTerm]) -> [CslTerm]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"terms" (Cursor -> [Cursor])
-> (Cursor -> [CslTerm]) -> Cursor -> [CslTerm]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get Text
"term" (Cursor -> [Cursor]) -> (Cursor -> CslTerm) -> Cursor -> [CslTerm]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> CslTerm
parseCslTerm
parseElement :: Cursor -> [Element]
parseElement :: Cursor -> [Element]
parseElement Cursor
cur =
case Cursor -> Node
forall node. Cursor node -> node
node Cursor
cur of
X.NodeElement Element
e ->
case Name -> Text
X.nameLocalName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ Element -> Name
X.elementName Element
e of
Text
"term" -> Cursor -> [Element]
parseTerm Cursor
cur
Text
"text" -> Cursor -> [Element]
parseText Cursor
cur
Text
"choose" -> Cursor -> [Element]
parseChoose Cursor
cur
Text
"group" -> Cursor -> [Element]
parseGroup Cursor
cur
Text
"label" -> Cursor -> [Element]
parseLabel Cursor
cur
Text
"number" -> Cursor -> [Element]
parseNumber Cursor
cur
Text
"substitute" -> Cursor -> [Element]
parseSubstitute Cursor
cur
Text
"names" -> Cursor -> [Element]
parseNames Cursor
cur
Text
"date" -> Cursor -> [Element]
parseDate Cursor
cur
Text
_ -> []
Node
_ -> []
getFormatting :: Cursor -> Formatting
getFormatting :: Cursor -> Formatting
getFormatting Cursor
cur =
Formatting
emptyFormatting{
prefix :: Text
prefix = Text -> Cursor -> Text
stringAttr Text
"prefix" Cursor
cur
, suffix :: Text
suffix = Text -> Cursor -> Text
stringAttr Text
"suffix" Cursor
cur
, fontFamily :: Text
fontFamily = Text -> Cursor -> Text
stringAttr Text
"font-family" Cursor
cur
, fontStyle :: Text
fontStyle = Text -> Cursor -> Text
stringAttr Text
"font-style" Cursor
cur
, fontVariant :: Text
fontVariant = Text -> Cursor -> Text
stringAttr Text
"font-variant" Cursor
cur
, fontWeight :: Text
fontWeight = Text -> Cursor -> Text
stringAttr Text
"font-weight" Cursor
cur
, textDecoration :: Text
textDecoration = Text -> Cursor -> Text
stringAttr Text
"text-decoration" Cursor
cur
, verticalAlign :: Text
verticalAlign = Text -> Cursor -> Text
stringAttr Text
"vertical-align" Cursor
cur
, textCase :: Text
textCase = Text -> Cursor -> Text
stringAttr Text
"text-case" Cursor
cur
, display :: Text
display = Text -> Cursor -> Text
stringAttr Text
"display" Cursor
cur
, quotes :: Quote
quotes = if Text -> Bool -> Cursor -> Bool
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"quotes" Bool
False Cursor
cur
then Quote
NativeQuote
else Quote
NoQuote
, stripPeriods :: Bool
stripPeriods = Text -> Bool -> Cursor -> Bool
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"strip-periods" Bool
False Cursor
cur
, noCase :: Bool
noCase = Text -> Bool -> Cursor -> Bool
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"no-case" Bool
False Cursor
cur
, noDecor :: Bool
noDecor = Text -> Bool -> Cursor -> Bool
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"no-decor" Bool
False Cursor
cur
}
parseDate :: Cursor -> [Element]
parseDate :: Cursor -> [Element]
parseDate Cursor
cur = [[Text]
-> DateForm -> Formatting -> Text -> [DatePart] -> Text -> Element
Date (Text -> [Text]
T.words Text
variable) DateForm
form Formatting
format Text
delim [DatePart]
parts Text
partsAttr]
where variable :: Text
variable = Text -> Cursor -> Text
stringAttr Text
"variable" Cursor
cur
form :: DateForm
form = case Text -> Cursor -> Text
stringAttr Text
"form" Cursor
cur of
Text
"text" -> DateForm
TextDate
Text
"numeric" -> DateForm
NumericDate
Text
_ -> DateForm
NoFormDate
format :: Formatting
format = Cursor -> Formatting
getFormatting Cursor
cur
delim :: Text
delim = Text -> Cursor -> Text
stringAttr Text
"delimiter" Cursor
cur
parts :: [DatePart]
parts = Cursor
cur Cursor -> (Cursor -> [DatePart]) -> [DatePart]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"date-part" (Cursor -> [Cursor])
-> (Cursor -> DatePart) -> Cursor -> [DatePart]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| DateForm -> Cursor -> DatePart
parseDatePart DateForm
form
partsAttr :: Text
partsAttr = Text -> Cursor -> Text
stringAttr Text
"date-parts" Cursor
cur
parseDatePart :: DateForm -> Cursor -> DatePart
parseDatePart :: DateForm -> Cursor -> DatePart
parseDatePart DateForm
defaultForm Cursor
cur =
DatePart :: Text -> Text -> Text -> Formatting -> DatePart
DatePart { dpName :: Text
dpName = Text -> Cursor -> Text
stringAttr Text
"name" Cursor
cur
, dpForm :: Text
dpForm = case Text -> Cursor -> Text
stringAttr Text
"form" Cursor
cur of
Text
"" -> case DateForm
defaultForm of
DateForm
TextDate -> Text
"long"
DateForm
NumericDate -> Text
"numeric"
DateForm
_ -> Text
"long"
Text
x -> Text
x
, dpRangeDelim :: Text
dpRangeDelim = case Text -> Cursor -> Text
stringAttr Text
"range-delimiter" Cursor
cur of
Text
"" -> Text
"-"
Text
x -> Text
x
, dpFormatting :: Formatting
dpFormatting = Cursor -> Formatting
getFormatting Cursor
cur
}
parseNames :: Cursor -> [Element]
parseNames :: Cursor -> [Element]
parseNames Cursor
cur = [[Text] -> [Name] -> Formatting -> Text -> [Element] -> Element
Names (Text -> [Text]
T.words Text
variable) [Name]
names Formatting
formatting Text
delim [Element]
others]
where variable :: Text
variable = Text -> Cursor -> Text
stringAttr Text
"variable" Cursor
cur
formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur
delim :: Text
delim = Text -> Cursor -> Text
stringAttr Text
"delimiter" Cursor
cur
elts :: [Either Element Name]
elts = Cursor
cur Cursor
-> (Cursor -> [Either Element Name]) -> [Either Element Name]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Either Element Name]
parseName
names :: [Name]
names = case [Either Element Name] -> [Name]
forall a b. [Either a b] -> [b]
rights [Either Element Name]
elts of
[] -> [Form -> Formatting -> [Option] -> Text -> [NamePart] -> Name
Name Form
NotSet Formatting
emptyFormatting [] Text
"" []]
[Name]
xs -> [Name]
xs
others :: [Element]
others = [Either Element Name] -> [Element]
forall a b. [Either a b] -> [a]
lefts [Either Element Name]
elts
parseName :: Cursor -> [Either Element Name]
parseName :: Cursor -> [Either Element Name]
parseName Cursor
cur =
case Cursor -> Node
forall node. Cursor node -> node
node Cursor
cur of
X.NodeElement Element
e ->
case Name -> Text
X.nameLocalName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ Element -> Name
X.elementName Element
e of
Text
"name" -> [Name -> Either Element Name
forall a b. b -> Either a b
Right (Name -> Either Element Name) -> Name -> Either Element Name
forall a b. (a -> b) -> a -> b
$ Form -> Formatting -> [Option] -> Text -> [NamePart] -> Name
Name (Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"form" Form
NotSet Cursor
cur)
Formatting
format (Element -> [Option]
nameAttrs Element
e) Text
delim [NamePart]
nameParts]
Text
"label" -> [Name -> Either Element Name
forall a b. b -> Either a b
Right (Name -> Either Element Name) -> Name -> Either Element Name
forall a b. (a -> b) -> a -> b
$ Form -> Formatting -> Plural -> Name
NameLabel (Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"form" Form
Long Cursor
cur)
Formatting
format Plural
plural]
Text
"et-al" -> [Name -> Either Element Name
forall a b. b -> Either a b
Right (Name -> Either Element Name) -> Name -> Either Element Name
forall a b. (a -> b) -> a -> b
$ Formatting -> Text -> Name
EtAl Formatting
format (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text
stringAttr Text
"term" Cursor
cur]
Text
_ -> (Element -> Either Element Name)
-> [Element] -> [Either Element Name]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Either Element Name
forall a b. a -> Either a b
Left ([Element] -> [Either Element Name])
-> [Element] -> [Either Element Name]
forall a b. (a -> b) -> a -> b
$ Cursor -> [Element]
parseElement Cursor
cur
Node
_ -> (Element -> Either Element Name)
-> [Element] -> [Either Element Name]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Either Element Name
forall a b. a -> Either a b
Left ([Element] -> [Either Element Name])
-> [Element] -> [Either Element Name]
forall a b. (a -> b) -> a -> b
$ Cursor -> [Element]
parseElement Cursor
cur
where format :: Formatting
format = Cursor -> Formatting
getFormatting Cursor
cur
plural :: Plural
plural = Text -> Plural -> Cursor -> Plural
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"plural" Plural
Contextual Cursor
cur
delim :: Text
delim = Text -> Cursor -> Text
stringAttr Text
"delimiter" Cursor
cur
nameParts :: [NamePart]
nameParts = Cursor
cur Cursor -> (Cursor -> [NamePart]) -> [NamePart]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"name-part" (Cursor -> [Cursor])
-> (Cursor -> NamePart) -> Cursor -> [NamePart]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> NamePart
parseNamePart
nameAttrs :: Element -> [Option]
nameAttrs Element
x = [(Text
n, Text
v) |
(X.Name Text
n Maybe Text
_ Maybe Text
_, Text
v) <- Map Name Text -> [(Name, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Element -> Map Name Text
X.elementAttributes Element
x),
Text
n Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
nameAttrKeys]
nameAttrKeys :: [Text]
nameAttrKeys = [ Text
"et-al-min"
, Text
"et-al-use-first"
, Text
"et-al-subsequent-min"
, Text
"et-al-subsequent-use-first"
, Text
"et-al-use-last"
, Text
"delimiter-precedes-et-al"
, Text
"and"
, Text
"delimiter-precedes-last"
, Text
"sort-separator"
, Text
"initialize"
, Text
"initialize-with"
, Text
"name-as-sort-order" ]
parseNamePart :: Cursor -> NamePart
parseNamePart :: Cursor -> NamePart
parseNamePart Cursor
cur = Text -> Formatting -> NamePart
NamePart Text
s Formatting
format
where format :: Formatting
format = Cursor -> Formatting
getFormatting Cursor
cur
s :: Text
s = Text -> Cursor -> Text
stringAttr Text
"name" Cursor
cur
parseSubstitute :: Cursor -> [Element]
parseSubstitute :: Cursor -> [Element]
parseSubstitute Cursor
cur = [[Element] -> Element
Substitute (Cursor
cur Cursor -> (Cursor -> [Element]) -> [Element]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Element]
parseElement)]
parseTerm :: Cursor -> [Element]
parseTerm :: Cursor -> [Element]
parseTerm Cursor
cur =
let termForm' :: Form
termForm' = Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"form" Form
Long Cursor
cur
formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur
plural :: Bool
plural = Text -> Bool -> Cursor -> Bool
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"plural" Bool
True Cursor
cur
name :: Text
name = Text -> Cursor -> Text
stringAttr Text
"name" Cursor
cur
in [Text -> Form -> Formatting -> Bool -> Element
Term Text
name Form
termForm' Formatting
formatting Bool
plural]
parseText :: Cursor -> [Element]
parseText :: Cursor -> [Element]
parseText Cursor
cur =
let term :: Text
term = Text -> Cursor -> Text
stringAttr Text
"term" Cursor
cur
variable :: Text
variable = Text -> Cursor -> Text
stringAttr Text
"variable" Cursor
cur
macro :: Text
macro = Text -> Cursor -> Text
stringAttr Text
"macro" Cursor
cur
value :: Text
value = Text -> Cursor -> Text
stringAttr Text
"value" Cursor
cur
delim :: Text
delim = Text -> Cursor -> Text
stringAttr Text
"delimiter" Cursor
cur
formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur
plural :: Bool
plural = Text -> Bool -> Cursor -> Bool
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"plural" Bool
True Cursor
cur
textForm :: Form
textForm = Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"form" Form
Long Cursor
cur
in if Bool -> Bool
not (Text -> Bool
T.null Text
term)
then [Text -> Form -> Formatting -> Bool -> Element
Term Text
term Form
textForm Formatting
formatting Bool
plural]
else if Bool -> Bool
not (Text -> Bool
T.null Text
macro)
then [Text -> Formatting -> Element
Macro Text
macro Formatting
formatting]
else if Bool -> Bool
not (Text -> Bool
T.null Text
variable)
then [[Text] -> Form -> Formatting -> Text -> Element
Variable (Text -> [Text]
T.words Text
variable) Form
textForm Formatting
formatting Text
delim]
else [Text -> Formatting -> Element
Const Text
value Formatting
formatting | Bool -> Bool
not (Text -> Bool
T.null Text
value)]
parseChoose :: Cursor -> [Element]
parseChoose :: Cursor -> [Element]
parseChoose Cursor
cur =
let ifPart :: [IfThen]
ifPart = Cursor
cur Cursor -> (Cursor -> [IfThen]) -> [IfThen]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"if" (Cursor -> [Cursor]) -> (Cursor -> IfThen) -> Cursor -> [IfThen]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> IfThen
parseIf
elseIfPart :: [IfThen]
elseIfPart = Cursor
cur Cursor -> (Cursor -> [IfThen]) -> [IfThen]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"else-if" (Cursor -> [Cursor]) -> (Cursor -> IfThen) -> Cursor -> [IfThen]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> IfThen
parseIf
elsePart :: [Element]
elsePart = Cursor
cur Cursor -> (Cursor -> [Element]) -> [Element]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"else" (Cursor -> [Cursor])
-> (Cursor -> [Element]) -> Cursor -> [Element]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Element]
parseElement
in [IfThen -> [IfThen] -> [Element] -> Element
Choose ([IfThen] -> IfThen
forall a. [a] -> a
head [IfThen]
ifPart) [IfThen]
elseIfPart [Element]
elsePart]
parseIf :: Cursor -> IfThen
parseIf :: Cursor -> IfThen
parseIf Cursor
cur = Condition -> Match -> [Element] -> IfThen
IfThen Condition
cond Match
mat [Element]
elts
where cond :: Condition
cond = Condition :: [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> Condition
Condition {
isType :: [Text]
isType = Text -> [Text]
go Text
"type"
, isSet :: [Text]
isSet = Text -> [Text]
go Text
"variable"
, isNumeric :: [Text]
isNumeric = Text -> [Text]
go Text
"is-numeric"
, isUncertainDate :: [Text]
isUncertainDate = Text -> [Text]
go Text
"is-uncertain-date"
, isPosition :: [Text]
isPosition = Text -> [Text]
go Text
"position"
, disambiguation :: [Text]
disambiguation = Text -> [Text]
go Text
"disambiguate"
, isLocator :: [Text]
isLocator = Text -> [Text]
go Text
"locator"
}
mat :: Match
mat = Text -> Match -> Cursor -> Match
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"match" Match
All Cursor
cur
elts :: [Element]
elts = Cursor
cur Cursor -> (Cursor -> [Element]) -> [Element]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Element]
parseElement
go :: Text -> [Text]
go Text
x = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text
stringAttr Text
x Cursor
cur
parseLabel :: Cursor -> [Element]
parseLabel :: Cursor -> [Element]
parseLabel Cursor
cur = [Text -> Form -> Formatting -> Plural -> Element
Label Text
variable Form
form Formatting
formatting Plural
plural]
where variable :: Text
variable = Text -> Cursor -> Text
stringAttr Text
"variable" Cursor
cur
form :: Form
form = Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"form" Form
Long Cursor
cur
formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur
plural :: Plural
plural = Text -> Plural -> Cursor -> Plural
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"plural" Plural
Contextual Cursor
cur
parseNumber :: Cursor -> [Element]
parseNumber :: Cursor -> [Element]
parseNumber Cursor
cur = [Text -> NumericForm -> Formatting -> Element
Number Text
variable NumericForm
numForm Formatting
formatting]
where variable :: Text
variable = Text -> Cursor -> Text
stringAttr Text
"variable" Cursor
cur
numForm :: NumericForm
numForm = Text -> NumericForm -> Cursor -> NumericForm
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"form" NumericForm
Numeric Cursor
cur
formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur
parseGroup :: Cursor -> [Element]
parseGroup :: Cursor -> [Element]
parseGroup Cursor
cur =
let elts :: [Element]
elts = Cursor
cur Cursor -> (Cursor -> [Element]) -> [Element]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Element]
parseElement
delim :: Text
delim = Text -> Cursor -> Text
stringAttr Text
"delimiter" Cursor
cur
formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur
in [Formatting -> Text -> [Element] -> Element
Group Formatting
formatting Text
delim [Element]
elts]
parseMacroMap :: Cursor -> MacroMap
parseMacroMap :: Cursor -> MacroMap
parseMacroMap Cursor
cur = (Text
name, [Element]
elts)
where name :: Text
name = Cursor
cur Cursor -> (Cursor -> Text) -> Text
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> Text
stringAttr Text
"name"
elts :: [Element]
elts = Cursor
cur Cursor -> (Cursor -> [Element]) -> [Element]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Element]
parseElement
parseCitation :: Cursor -> Citation
parseCitation :: Cursor -> Citation
parseCitation Cursor
cur = Citation :: [Option] -> [Sort] -> Layout -> Citation
Citation{ citOptions :: [Option]
citOptions = Cursor -> [Option]
parseOptions Cursor
cur
, citSort :: [Sort]
citSort = [[Sort]] -> [Sort]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Sort]] -> [Sort]) -> [[Sort]] -> [Sort]
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [[Sort]]) -> [[Sort]]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"sort" (Cursor -> [Cursor]) -> (Cursor -> [Sort]) -> Cursor -> [[Sort]]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> [Sort]
parseSort
, citLayout :: Layout
citLayout = case Cursor
cur Cursor -> (Cursor -> [Layout]) -> [Layout]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"layout" (Cursor -> [Cursor]) -> (Cursor -> Layout) -> Cursor -> [Layout]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Layout
parseLayout of
(Layout
x:[Layout]
_) -> Layout
x
[] -> Layout :: Formatting -> Text -> [Element] -> Layout
Layout
{ layFormat :: Formatting
layFormat = Formatting
emptyFormatting
, layDelim :: Text
layDelim = Text
""
, elements :: [Element]
elements = [] }
}
parseSort :: Cursor -> [Sort]
parseSort :: Cursor -> [Sort]
parseSort Cursor
cur = [[Sort]] -> [Sort]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Sort]] -> [Sort]) -> [[Sort]] -> [Sort]
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [[Sort]]) -> [[Sort]]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"key" (Cursor -> [Cursor]) -> (Cursor -> [Sort]) -> Cursor -> [[Sort]]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> [Sort]
parseKey
parseKey :: Cursor -> [Sort]
parseKey :: Cursor -> [Sort]
parseKey Cursor
cur =
case Text -> Cursor -> Text
stringAttr Text
"variable" Cursor
cur of
Text
"" ->
case Text -> Cursor -> Text
stringAttr Text
"macro" Cursor
cur of
Text
"" -> []
Text
x -> [Text -> Sorting -> Int -> Int -> Text -> Sort
SortMacro Text
x Sorting
sorting (Text -> Int -> Cursor -> Int
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"names-min" Int
0 Cursor
cur)
(Text -> Int -> Cursor -> Int
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault Text
"names-use-first" Int
0 Cursor
cur)
(Text -> Cursor -> Text
stringAttr Text
"names-use-last" Cursor
cur)]
Text
x -> [Text -> Sorting -> Sort
SortVariable Text
x Sorting
sorting]
where sorting :: Sorting
sorting = case Text -> Cursor -> Text
stringAttr Text
"sort" Cursor
cur of
Text
"descending" -> Text -> Sorting
Descending Text
""
Text
_ -> Text -> Sorting
Ascending Text
""
parseBiblio :: Cursor -> Bibliography
parseBiblio :: Cursor -> Bibliography
parseBiblio Cursor
cur =
Bibliography :: [Option] -> [Sort] -> Layout -> Bibliography
Bibliography{
bibOptions :: [Option]
bibOptions = Cursor -> [Option]
parseOptions Cursor
cur,
bibSort :: [Sort]
bibSort = [[Sort]] -> [Sort]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Sort]] -> [Sort]) -> [[Sort]] -> [Sort]
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [[Sort]]) -> [[Sort]]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"sort" (Cursor -> [Cursor]) -> (Cursor -> [Sort]) -> Cursor -> [[Sort]]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> [Sort]
parseSort,
bibLayout :: Layout
bibLayout = case Cursor
cur Cursor -> (Cursor -> [Layout]) -> [Layout]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get Text
"layout" (Cursor -> [Cursor]) -> (Cursor -> Layout) -> Cursor -> [Layout]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Layout
parseLayout of
(Layout
x:[Layout]
_) -> Layout
x
[] -> Layout :: Formatting -> Text -> [Element] -> Layout
Layout
{ layFormat :: Formatting
layFormat = Formatting
emptyFormatting
, layDelim :: Text
layDelim = Text
""
, elements :: [Element]
elements = [] }
}
parseOptions :: Cursor -> [Option]
parseOptions :: Cursor -> [Option]
parseOptions Cursor
cur =
case Cursor -> Node
forall node. Cursor node -> node
node Cursor
cur of
X.NodeElement Element
e ->
[(Text
n, Text
v) |
(X.Name Text
n Maybe Text
_ Maybe Text
_, Text
v) <- Map Name Text -> [(Name, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Element -> Map Name Text
X.elementAttributes Element
e)]
Node
_ -> []
parseLayout :: Cursor -> Layout
parseLayout :: Cursor -> Layout
parseLayout Cursor
cur =
Layout :: Formatting -> Text -> [Element] -> Layout
Layout
{ layFormat :: Formatting
layFormat = Cursor -> Formatting
getFormatting Cursor
cur
, layDelim :: Text
layDelim = Text -> Cursor -> Text
stringAttr Text
"delimiter" Cursor
cur
, elements :: [Element]
elements = Cursor
cur Cursor -> (Cursor -> [Element]) -> [Element]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Element]
parseElement
}