{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Parser
-- Copyright   :  (C) 2014 John MacFarlane
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  John MacFarlane <jgm@berkeley.edu>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Parser for CSL XML files.
-----------------------------------------------------------------------------

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

-- | Parse a 'String' into a 'Style' (with default locale).
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

-- | Parse locale.  Raises 'CSLLocaleException' on error.
parseLocale :: Text -> IO Locale
parseLocale :: Text -> IO Locale
parseLocale locale :: 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

-- | Merge locale into a CSL style.
localizeCSL :: Maybe Text -> Style -> IO Style
localizeCSL :: Maybe Text -> Style -> IO Style
localizeCSL mbLocale :: Maybe Text
mbLocale s :: 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) }

-- | Read and parse a CSL style file into a localized sytle.
readCSLFile :: Maybe Text -> FilePath -> IO Style
readCSLFile :: Maybe Text -> FilePath -> IO Style
readCSLFile mbLocale :: Maybe Text
mbLocale src :: FilePath
src = do
  FilePath
csldir <- FilePath -> IO FilePath
getAppUserDataDirectory "csl"
  Maybe FilePath
mbSrc <- [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile [".", 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 err :: SomeException
err         -> SomeException -> IO ByteString
forall e a. Exception e => e -> IO a
E.throwIO SomeException
err
            Right (rawbs :: ByteString
rawbs, _) -> 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
  -- see if it's a dependent style, and if so, try to fetch its parent:
  let pickParentCur :: Cursor -> [Cursor]
pickParentCur = Text -> Cursor -> [Cursor]
get "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 "rel" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) "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 "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 "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
       ""  -> 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
       y :: Text
y   -> do
           -- note, we insert locale from the dependent style:
           let mbLocale' :: Maybe Text
mbLocale' = case Text -> Cursor -> Text
stringAttr "default-locale" Cursor
cur of
                                  "" -> Maybe Text
mbLocale
                                  x :: 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 cur :: 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 (\(k :: Text
k,_) -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`
                                       ["class",
                                        "xmlns",
                                        "version",
                                        "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 = ""
                                                    , 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 "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 "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 "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 "class"
        defaultLocale :: Text
defaultLocale = case Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> [Text]
laxAttribute "default-locale" of
                             (x :: Text
x:_) -> Text
x
                             []    -> "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 "info" (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get "author" of
                      (x :: Cursor
x:_) -> 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 "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 "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 "uri"   (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content)
                      _     -> Text -> Text -> Text -> CSAuthor
CSAuthor "" "" ""
        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 "info" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get "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 = []  -- TODO we don't really use this, and the type
                                -- in Style doesn't match current CSL at all
          , 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 "info" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get "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 "info" (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get "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 "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 "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 name :: 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 "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 t :: Text
t d :: a
d cur :: 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 t :: Text
t cur :: Cursor
cur =
  case Cursor -> Node
forall node. Cursor node -> node
node Cursor
cur of
    X.NodeElement e :: 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 x :: Text
x  -> Text
x
           Nothing -> ""
    _ -> ""

parseCslTerm :: Cursor -> CslTerm
parseCslTerm :: Cursor -> CslTerm
parseCslTerm cur :: 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 "name" Cursor
cur
      , termForm :: Form
termForm       = Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "form" Form
Long Cursor
cur
      , termGender :: Gender
termGender     = Text -> Gender -> Cursor -> Gender
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "gender" Gender
Neuter Cursor
cur
      , termGenderForm :: Gender
termGenderForm = Text -> Gender -> Cursor -> Gender
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "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 "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 "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 "match" Cursor
cur
      }

parseLocaleElement :: Cursor -> Locale
parseLocaleElement :: Cursor -> Locale
parseLocaleElement cur :: 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 "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 "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 "version"
        lang :: [Text]
lang    = Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> [Text]
laxAttribute "lang"
        terms :: [CslTerm]
terms   = Cursor
cur Cursor -> (Cursor -> [CslTerm]) -> [CslTerm]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Cursor]
get "terms" (Cursor -> [Cursor])
-> (Cursor -> [CslTerm]) -> Cursor -> [CslTerm]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
get "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 cur :: Cursor
cur =
  case Cursor -> Node
forall node. Cursor node -> node
node Cursor
cur of
       X.NodeElement e :: 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
              "term"       -> Cursor -> [Element]
parseTerm Cursor
cur
              "text"       -> Cursor -> [Element]
parseText Cursor
cur
              "choose"     -> Cursor -> [Element]
parseChoose Cursor
cur
              "group"      -> Cursor -> [Element]
parseGroup Cursor
cur
              "label"      -> Cursor -> [Element]
parseLabel Cursor
cur
              "number"     -> Cursor -> [Element]
parseNumber Cursor
cur
              "substitute" -> Cursor -> [Element]
parseSubstitute Cursor
cur
              "names"      -> Cursor -> [Element]
parseNames Cursor
cur
              "date"       -> Cursor -> [Element]
parseDate Cursor
cur
              _            -> []
       _ -> []

getFormatting :: Cursor -> Formatting
getFormatting :: Cursor -> Formatting
getFormatting cur :: Cursor
cur =
  Formatting
emptyFormatting{
    prefix :: Text
prefix  = Text -> Cursor -> Text
stringAttr "prefix" Cursor
cur
  , suffix :: Text
suffix  = Text -> Cursor -> Text
stringAttr "suffix" Cursor
cur
  , fontFamily :: Text
fontFamily = Text -> Cursor -> Text
stringAttr "font-family" Cursor
cur
  , fontStyle :: Text
fontStyle = Text -> Cursor -> Text
stringAttr "font-style" Cursor
cur
  , fontVariant :: Text
fontVariant = Text -> Cursor -> Text
stringAttr "font-variant" Cursor
cur
  , fontWeight :: Text
fontWeight = Text -> Cursor -> Text
stringAttr "font-weight" Cursor
cur
  , textDecoration :: Text
textDecoration = Text -> Cursor -> Text
stringAttr "text-decoration" Cursor
cur
  , verticalAlign :: Text
verticalAlign = Text -> Cursor -> Text
stringAttr "vertical-align" Cursor
cur
  , textCase :: Text
textCase = Text -> Cursor -> Text
stringAttr "text-case" Cursor
cur
  , display :: Text
display = Text -> Cursor -> Text
stringAttr "display" Cursor
cur
  , quotes :: Quote
quotes = if Text -> Bool -> Cursor -> Bool
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "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 "strip-periods" Bool
False Cursor
cur
  , noCase :: Bool
noCase = Text -> Bool -> Cursor -> Bool
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "no-case" Bool
False Cursor
cur
  , noDecor :: Bool
noDecor = Text -> Bool -> Cursor -> Bool
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "no-decor" Bool
False Cursor
cur
  }

parseDate :: Cursor -> [Element]
parseDate :: Cursor -> [Element]
parseDate cur :: 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 "variable" Cursor
cur
        form :: DateForm
form       = case Text -> Cursor -> Text
stringAttr "form" Cursor
cur of
                           "text"    -> DateForm
TextDate
                           "numeric" -> DateForm
NumericDate
                           _         -> DateForm
NoFormDate
        format :: Formatting
format     = Cursor -> Formatting
getFormatting Cursor
cur
        delim :: Text
delim      = Text -> Cursor -> Text
stringAttr "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 "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 "date-parts" Cursor
cur

parseDatePart :: DateForm -> Cursor -> DatePart
parseDatePart :: DateForm -> Cursor -> DatePart
parseDatePart defaultForm :: DateForm
defaultForm cur :: Cursor
cur =
  DatePart :: Text -> Text -> Text -> Formatting -> DatePart
DatePart { dpName :: Text
dpName       = Text -> Cursor -> Text
stringAttr "name" Cursor
cur
           , dpForm :: Text
dpForm       = case Text -> Cursor -> Text
stringAttr "form" Cursor
cur of
                                  ""  -> case DateForm
defaultForm of
                                              TextDate    -> "long"
                                              NumericDate -> "numeric"
                                              _           -> "long"
                                  x :: Text
x    -> Text
x
           , dpRangeDelim :: Text
dpRangeDelim = case Text -> Cursor -> Text
stringAttr "range-delimiter" Cursor
cur of
                                  "" -> "-"
                                  x :: Text
x  -> Text
x
           , dpFormatting :: Formatting
dpFormatting = Cursor -> Formatting
getFormatting Cursor
cur
           }

parseNames :: Cursor -> [Element]
parseNames :: Cursor -> [Element]
parseNames cur :: 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 "variable" Cursor
cur
        formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur
        delim :: Text
delim      = Text -> Cursor -> Text
stringAttr "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 [] "" []]
                          xs :: [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 cur :: Cursor
cur =
  case Cursor -> Node
forall node. Cursor node -> node
node Cursor
cur of
       X.NodeElement e :: 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
              "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 "form" Form
NotSet Cursor
cur)
                              Formatting
format (Element -> [Option]
nameAttrs Element
e) Text
delim [NamePart]
nameParts]
              "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 "form" Form
Long Cursor
cur)
                              Formatting
format Plural
plural]
              "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 "term" Cursor
cur]
              _        -> (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
       _ -> (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 "plural" Plural
Contextual Cursor
cur
         delim :: Text
delim     = Text -> Cursor -> Text
stringAttr "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 "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 x :: Element
x = [(Text
n, Text
v) |
                 (X.Name n :: Text
n _ _, v :: 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 =  [ "et-al-min"
                         , "et-al-use-first"
                         , "et-al-subsequent-min"
                         , "et-al-subsequent-use-first"
                         , "et-al-use-last"
                         , "delimiter-precedes-et-al"
                         , "and"
                         , "delimiter-precedes-last"
                         , "sort-separator"
                         , "initialize"
                         , "initialize-with"
                         , "name-as-sort-order" ]


parseNamePart :: Cursor -> NamePart
parseNamePart :: Cursor -> NamePart
parseNamePart cur :: 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 "name" Cursor
cur

parseSubstitute :: Cursor -> [Element]
parseSubstitute :: Cursor -> [Element]
parseSubstitute cur :: 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 cur :: Cursor
cur =
  let termForm' :: Form
termForm'      = Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "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 "plural" Bool
True Cursor
cur
      name :: Text
name           = Text -> Cursor -> Text
stringAttr "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 cur :: Cursor
cur =
  let term :: Text
term           = Text -> Cursor -> Text
stringAttr "term" Cursor
cur
      variable :: Text
variable       = Text -> Cursor -> Text
stringAttr "variable" Cursor
cur
      macro :: Text
macro          = Text -> Cursor -> Text
stringAttr "macro" Cursor
cur
      value :: Text
value          = Text -> Cursor -> Text
stringAttr "value" Cursor
cur
      delim :: Text
delim          = Text -> Cursor -> Text
stringAttr "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 "plural" Bool
True Cursor
cur
      textForm :: Form
textForm       = Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "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 cur :: 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 "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 "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 "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 cur :: 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 "type"
               , isSet :: [Text]
isSet           = Text -> [Text]
go "variable"
               , isNumeric :: [Text]
isNumeric       = Text -> [Text]
go "is-numeric"
               , isUncertainDate :: [Text]
isUncertainDate = Text -> [Text]
go "is-uncertain-date"
               , isPosition :: [Text]
isPosition      = Text -> [Text]
go "position"
               , disambiguation :: [Text]
disambiguation  = Text -> [Text]
go "disambiguate"
               , isLocator :: [Text]
isLocator       = Text -> [Text]
go "locator"
               }
        mat :: Match
mat  = Text -> Match -> Cursor -> Match
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "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 x :: 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 cur :: Cursor
cur = [Text -> Form -> Formatting -> Plural -> Element
Label Text
variable Form
form Formatting
formatting Plural
plural]
  where variable :: Text
variable   = Text -> Cursor -> Text
stringAttr "variable" Cursor
cur
        form :: Form
form       = Text -> Form -> Cursor -> Form
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "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 "plural" Plural
Contextual Cursor
cur

parseNumber :: Cursor -> [Element]
parseNumber :: Cursor -> [Element]
parseNumber cur :: Cursor
cur = [Text -> NumericForm -> Formatting -> Element
Number Text
variable NumericForm
numForm Formatting
formatting]
  where variable :: Text
variable   = Text -> Cursor -> Text
stringAttr "variable" Cursor
cur
        numForm :: NumericForm
numForm    = Text -> NumericForm -> Cursor -> NumericForm
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "form" NumericForm
Numeric Cursor
cur
        formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur

parseGroup :: Cursor -> [Element]
parseGroup :: Cursor -> [Element]
parseGroup cur :: 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 "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 cur :: 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 "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 cur :: 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 "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 "layout" (Cursor -> [Cursor]) -> (Cursor -> Layout) -> Cursor -> [Layout]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Layout
parseLayout of
                                            (x :: Layout
x:_) -> Layout
x
                                            []    -> Layout :: Formatting -> Text -> [Element] -> Layout
Layout
                                                      { layFormat :: Formatting
layFormat = Formatting
emptyFormatting
                                                      , layDelim :: Text
layDelim = ""
                                                      , elements :: [Element]
elements = [] }
                             }

parseSort :: Cursor -> [Sort]
parseSort :: Cursor -> [Sort]
parseSort cur :: 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 "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 cur :: Cursor
cur =
  case Text -> Cursor -> Text
stringAttr "variable" Cursor
cur of
       "" ->
         case Text -> Cursor -> Text
stringAttr "macro" Cursor
cur of
           "" -> []
           x :: 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 "names-min" 0 Cursor
cur)
                       (Text -> Int -> Cursor -> Int
forall a. Read a => Text -> a -> Cursor -> a
attrWithDefault "names-use-first" 0 Cursor
cur)
                       (Text -> Cursor -> Text
stringAttr "names-use-last" Cursor
cur)]
       x :: Text
x  -> [Text -> Sorting -> Sort
SortVariable Text
x Sorting
sorting]
  where sorting :: Sorting
sorting = case Text -> Cursor -> Text
stringAttr "sort" Cursor
cur of
                       "descending" -> Text -> Sorting
Descending ""
                       _            -> Text -> Sorting
Ascending ""

parseBiblio :: Cursor -> Bibliography
parseBiblio :: Cursor -> Bibliography
parseBiblio cur :: 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 "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 "layout" (Cursor -> [Cursor]) -> (Cursor -> Layout) -> Cursor -> [Layout]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Layout
parseLayout of
                       (x :: Layout
x:_) -> Layout
x
                       []    -> Layout :: Formatting -> Text -> [Element] -> Layout
Layout
                                 { layFormat :: Formatting
layFormat = Formatting
emptyFormatting
                                 , layDelim :: Text
layDelim = ""
                                 , elements :: [Element]
elements = [] }
    }

parseOptions :: Cursor -> [Option]
parseOptions :: Cursor -> [Option]
parseOptions cur :: Cursor
cur =
  case Cursor -> Node
forall node. Cursor node -> node
node Cursor
cur of
    X.NodeElement e :: Element
e ->
     [(Text
n, Text
v) |
      (X.Name n :: Text
n _ _, v :: 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)]
    _ -> []

parseLayout :: Cursor -> Layout
parseLayout :: Cursor -> Layout
parseLayout cur :: Cursor
cur =
  Layout :: Formatting -> Text -> [Element] -> Layout
Layout
    { layFormat :: Formatting
layFormat = Cursor -> Formatting
getFormatting Cursor
cur
    , layDelim :: Text
layDelim = Text -> Cursor -> Text
stringAttr "delimiter" Cursor
cur
    , elements :: [Element]
elements = Cursor
cur Cursor -> (Cursor -> [Element]) -> [Element]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Element]
parseElement
    }