{-# 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           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)
import           Text.Pandoc.Shared     (safeRead)
import           Text.Pandoc.UTF8       (fromStringLazy)
import qualified Text.XML               as X
import           Text.XML.Cursor

-- | Parse a 'String' into a 'Style' (with default locale).
parseCSL :: String -> Style
parseCSL :: String -> Style
parseCSL = ByteString -> Style
parseCSL' (ByteString -> Style) -> (String -> ByteString) -> String -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
fromStringLazy

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

-- | Merge locale into a CSL style.
localizeCSL :: Maybe String -> Style -> IO Style
localizeCSL :: Maybe String -> Style -> IO Style
localizeCSL mbLocale :: Maybe String
mbLocale s :: Style
s = do
  let locale :: String
locale = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Style -> String
styleDefaultLocale Style
s) Maybe String
mbLocale
  Locale
l <- String -> IO Locale
parseLocale String
locale
  Style -> IO Style
forall (m :: * -> *) a. Monad m => a -> m a
return Style
s { styleLocale :: [Locale]
styleLocale = String -> Locale -> [Locale] -> [Locale]
mergeLocales String
locale Locale
l (Style -> [Locale]
styleLocale Style
s) }

-- | Read and parse a CSL style file into a localized sytle.
readCSLFile :: Maybe String -> FilePath -> IO Style
readCSLFile :: Maybe String -> String -> IO Style
readCSLFile mbLocale :: Maybe String
mbLocale src :: String
src = do
  String
csldir <- String -> IO String
getAppUserDataDirectory "csl"
  Maybe String
mbSrc <- [String] -> String -> IO (Maybe String)
findFile [".", String
csldir] String
src
  Either SomeException (ByteString, Maybe MimeType)
fetchRes <- String -> IO (Either SomeException (ByteString, Maybe MimeType))
fetchItem (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
src Maybe String
mbSrc)
  ByteString
f <- case Either SomeException (ByteString, Maybe MimeType)
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 = MimeType -> 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 -> MimeType -> Cursor -> [Cursor]
attributeIs (MimeType -> Maybe MimeType -> Maybe MimeType -> Name
X.Name "rel" Maybe MimeType
forall a. Maybe a
Nothing Maybe MimeType
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]
$/ MimeType -> 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' :: String
parent' = (Cursor -> String) -> [Cursor] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MimeType -> Cursor -> String
stringAttr "href") [Cursor]
parentCur
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
parent' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
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
$ String -> CiteprocException
DependentStyleHasItselfAsParent String
src
  case String
parent' of
       ""  -> Maybe String -> Style -> IO Style
localizeCSL Maybe String
mbLocale (Style -> IO Style) -> Style -> IO Style
forall a b. (a -> b) -> a -> b
$ Cursor -> Style
parseCSLCursor Cursor
cur
       y :: String
y   -> do
           -- note, we insert locale from the dependent style:
           let mbLocale' :: Maybe String
mbLocale' = case MimeType -> Cursor -> String
stringAttr "default-locale" Cursor
cur of
                                  "" -> Maybe String
mbLocale
                                  x :: String
x  -> String -> Maybe String
forall a. a -> Maybe a
Just String
x
           Maybe String -> String -> IO Style
readCSLFile Maybe String
mbLocale' String
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 :: String
-> String
-> Maybe CSInfo
-> String
-> [Locale]
-> Abbreviations
-> [Option]
-> [MacroMap]
-> Citation
-> Maybe Bibliography
-> Style
Style{ styleVersion :: String
styleVersion = String
version
       , styleClass :: String
styleClass = String
class_
       , styleInfo :: Maybe CSInfo
styleInfo = CSInfo -> Maybe CSInfo
forall a. a -> Maybe a
Just CSInfo
info
       , styleDefaultLocale :: String
styleDefaultLocale = String
defaultLocale
       , styleLocale :: [Locale]
styleLocale = [Locale]
locales
       , styleAbbrevs :: Abbreviations
styleAbbrevs = Map String (Map String (Map String String)) -> Abbreviations
Abbreviations Map String (Map String (Map String String))
forall k a. Map k a
M.empty
       , csOptions :: [Option]
csOptions = (Option -> Bool) -> [Option] -> [Option]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(k :: String
k,_) -> String
k String -> [String] -> 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 -> String -> [Element] -> Layout
Layout{ layFormat :: Formatting
layFormat = Formatting
emptyFormatting
                                                    , layDelim :: String
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]
$/ MimeType -> 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]
$/ MimeType -> 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 :: String
version = MimeType -> String
unpack (MimeType -> String)
-> ([MimeType] -> MimeType) -> [MimeType] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MimeType] -> MimeType
T.concat ([MimeType] -> String) -> [MimeType] -> String
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [MimeType]) -> [MimeType]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| MimeType -> Cursor -> [MimeType]
laxAttribute "version"
        class_ :: String
class_ = MimeType -> String
unpack (MimeType -> String)
-> ([MimeType] -> MimeType) -> [MimeType] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MimeType] -> MimeType
T.concat ([MimeType] -> String) -> [MimeType] -> String
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [MimeType]) -> [MimeType]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| MimeType -> Cursor -> [MimeType]
laxAttribute "class"
        defaultLocale :: String
defaultLocale = case Cursor
cur Cursor -> (Cursor -> [MimeType]) -> [MimeType]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| MimeType -> Cursor -> [MimeType]
laxAttribute "default-locale" of
                             (x :: MimeType
x:_) -> MimeType -> String
unpack MimeType
x
                             []    -> "en-US"
        author :: CSAuthor
author = case Cursor
cur Cursor -> (Cursor -> [Cursor]) -> [Cursor]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// MimeType -> Cursor -> [Cursor]
get "info" (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ MimeType -> Cursor -> [Cursor]
get "author" of
                      (x :: Cursor
x:_) -> String -> String -> String -> CSAuthor
CSAuthor (Cursor
x Cursor -> (Cursor -> String) -> String
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> Cursor -> [Cursor]
get "name" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> String
string)
                                 (Cursor
x Cursor -> (Cursor -> String) -> String
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> Cursor -> [Cursor]
get "email" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> String
string)
                                 (Cursor
x Cursor -> (Cursor -> String) -> String
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> Cursor -> [Cursor]
get "uri"   (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> String
string)
                      _     -> String -> String -> String -> CSAuthor
CSAuthor "" "" ""
        info :: CSInfo
info = CSInfo :: String -> CSAuthor -> [CSCategory] -> String -> String -> CSInfo
CSInfo
          { csiTitle :: String
csiTitle      = Cursor
cur Cursor -> (Cursor -> String) -> String
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> Cursor -> [Cursor]
get "info" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ MimeType -> Cursor -> [Cursor]
get "title" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> String
string
          , 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 :: String
csiId         = Cursor
cur Cursor -> (Cursor -> String) -> String
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> Cursor -> [Cursor]
get "info" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ MimeType -> Cursor -> [Cursor]
get "id" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> String
string
          , csiUpdated :: String
csiUpdated    = Cursor
cur Cursor -> (Cursor -> String) -> String
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> Cursor -> [Cursor]
get "info" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ MimeType -> Cursor -> [Cursor]
get "updated" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> String
string
          }
        locales :: [Locale]
locales = Cursor
cur Cursor -> (Cursor -> [Locale]) -> [Locale]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> 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]
$/ MimeType -> 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 :: MimeType -> Cursor -> [Cursor]
get name :: MimeType
name =
  Name -> Cursor -> [Cursor]
element (MimeType -> Maybe MimeType -> Maybe MimeType -> Name
X.Name MimeType
name (MimeType -> Maybe MimeType
forall a. a -> Maybe a
Just "http://purl.org/net/xbiblio/csl") Maybe MimeType
forall a. Maybe a
Nothing)

string :: Cursor -> String
string :: Cursor -> String
string = MimeType -> String
unpack (MimeType -> String) -> (Cursor -> MimeType) -> Cursor -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MimeType] -> MimeType
T.concat ([MimeType] -> MimeType)
-> (Cursor -> [MimeType]) -> Cursor -> MimeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> [MimeType]
content

attrWithDefault :: Read a => Text -> a -> Cursor -> a
attrWithDefault :: MimeType -> a -> Cursor -> a
attrWithDefault t :: MimeType
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
$ MimeType -> Maybe a
forall (m :: * -> *) a. (MonadPlus m, Read a) => MimeType -> m a
safeRead (String -> MimeType
T.pack (String -> MimeType) -> String -> MimeType
forall a b. (a -> b) -> a -> b
$ String -> String
toRead (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ MimeType -> Cursor -> String
stringAttr MimeType
t Cursor
cur)

stringAttr :: Text -> Cursor -> String
stringAttr :: MimeType -> Cursor -> String
stringAttr t :: MimeType
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 MimeType -> Maybe MimeType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (MimeType -> Maybe MimeType -> Maybe MimeType -> Name
X.Name MimeType
t Maybe MimeType
forall a. Maybe a
Nothing Maybe MimeType
forall a. Maybe a
Nothing)
           (Element -> Map Name MimeType
X.elementAttributes Element
e) of
           Just x :: MimeType
x  -> MimeType -> String
unpack MimeType
x
           Nothing -> ""
    _ -> ""

parseCslTerm :: Cursor -> CslTerm
parseCslTerm :: Cursor -> CslTerm
parseCslTerm cur :: Cursor
cur =
    let body :: String
body = MimeType -> String
unpack (MimeType -> String) -> MimeType -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> MimeType -> MimeType
T.dropAround (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (" \t\r\n" :: String)) (MimeType -> MimeType) -> MimeType -> MimeType
forall a b. (a -> b) -> a -> b
$
                  [MimeType] -> MimeType
T.concat ([MimeType] -> MimeType) -> [MimeType] -> MimeType
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [MimeType]) -> [MimeType]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [MimeType]
content
    in CT :: String
-> Form
-> Gender
-> Gender
-> String
-> String
-> String
-> CslTerm
CT
      { cslTerm :: String
cslTerm        = MimeType -> Cursor -> String
stringAttr "name" Cursor
cur
      , termForm :: Form
termForm       = MimeType -> Form -> Cursor -> Form
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "form" Form
Long Cursor
cur
      , termGender :: Gender
termGender     = MimeType -> Gender -> Cursor -> Gender
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "gender" Gender
Neuter Cursor
cur
      , termGenderForm :: Gender
termGenderForm = MimeType -> Gender -> Cursor -> Gender
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "gender-form" Gender
Neuter Cursor
cur
      , termSingular :: String
termSingular   = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
body
                            then Cursor
cur Cursor -> (Cursor -> String) -> String
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> Cursor -> [Cursor]
get "single" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> String
string
                            else String
body
      , termPlural :: String
termPlural     = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
body
                            then Cursor
cur Cursor -> (Cursor -> String) -> String
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> Cursor -> [Cursor]
get "multiple" (Cursor -> [Cursor]) -> (Cursor -> String) -> Cursor -> String
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> String
string
                            else String
body
      , termMatch :: String
termMatch      = MimeType -> Cursor -> String
stringAttr "match" Cursor
cur
      }

parseLocaleElement :: Cursor -> Locale
parseLocaleElement :: Cursor -> Locale
parseLocaleElement cur :: Cursor
cur = Locale :: String -> String -> [Option] -> [CslTerm] -> [Element] -> Locale
Locale
      { localeVersion :: String
localeVersion = MimeType -> String
unpack (MimeType -> String) -> MimeType -> String
forall a b. (a -> b) -> a -> b
$ [MimeType] -> MimeType
T.concat [MimeType]
version
      , localeLang :: String
localeLang    = MimeType -> String
unpack (MimeType -> String) -> MimeType -> String
forall a b. (a -> b) -> a -> b
$ [MimeType] -> MimeType
T.concat [MimeType]
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]
$/ MimeType -> 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]
$/ MimeType -> 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 :: [MimeType]
version = Cursor
cur Cursor -> (Cursor -> [MimeType]) -> [MimeType]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| MimeType -> Cursor -> [MimeType]
laxAttribute "version"
        lang :: [MimeType]
lang    = Cursor
cur Cursor -> (Cursor -> [MimeType]) -> [MimeType]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| MimeType -> Cursor -> [MimeType]
laxAttribute "lang"
        terms :: [CslTerm]
terms   = Cursor
cur Cursor -> (Cursor -> [CslTerm]) -> [CslTerm]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> Cursor -> [Cursor]
get "terms" (Cursor -> [Cursor])
-> (Cursor -> [CslTerm]) -> Cursor -> [CslTerm]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ MimeType -> 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 -> MimeType
X.nameLocalName (Name -> MimeType) -> Name -> MimeType
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 :: String
prefix  = MimeType -> Cursor -> String
stringAttr "prefix" Cursor
cur
  , suffix :: String
suffix  = MimeType -> Cursor -> String
stringAttr "suffix" Cursor
cur
  , fontFamily :: String
fontFamily = MimeType -> Cursor -> String
stringAttr "font-family" Cursor
cur
  , fontStyle :: String
fontStyle = MimeType -> Cursor -> String
stringAttr "font-style" Cursor
cur
  , fontVariant :: String
fontVariant = MimeType -> Cursor -> String
stringAttr "font-variant" Cursor
cur
  , fontWeight :: String
fontWeight = MimeType -> Cursor -> String
stringAttr "font-weight" Cursor
cur
  , textDecoration :: String
textDecoration = MimeType -> Cursor -> String
stringAttr "text-decoration" Cursor
cur
  , verticalAlign :: String
verticalAlign = MimeType -> Cursor -> String
stringAttr "vertical-align" Cursor
cur
  , textCase :: String
textCase = MimeType -> Cursor -> String
stringAttr "text-case" Cursor
cur
  , display :: String
display = MimeType -> Cursor -> String
stringAttr "display" Cursor
cur
  , quotes :: Quote
quotes = if MimeType -> Bool -> Cursor -> Bool
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "quotes" Bool
False Cursor
cur
                then Quote
NativeQuote
                else Quote
NoQuote
  , stripPeriods :: Bool
stripPeriods = MimeType -> Bool -> Cursor -> Bool
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "strip-periods" Bool
False Cursor
cur
  , noCase :: Bool
noCase = MimeType -> Bool -> Cursor -> Bool
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "no-case" Bool
False Cursor
cur
  , noDecor :: Bool
noDecor = MimeType -> Bool -> Cursor -> Bool
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "no-decor" Bool
False Cursor
cur
  }

parseDate :: Cursor -> [Element]
parseDate :: Cursor -> [Element]
parseDate cur :: Cursor
cur = [[String]
-> DateForm
-> Formatting
-> String
-> [DatePart]
-> String
-> Element
Date (String -> [String]
words String
variable) DateForm
form Formatting
format String
delim [DatePart]
parts String
partsAttr]
  where variable :: String
variable   = MimeType -> Cursor -> String
stringAttr "variable" Cursor
cur
        form :: DateForm
form       = case MimeType -> Cursor -> String
stringAttr "form" Cursor
cur of
                           "text"    -> DateForm
TextDate
                           "numeric" -> DateForm
NumericDate
                           _         -> DateForm
NoFormDate
        format :: Formatting
format     = Cursor -> Formatting
getFormatting Cursor
cur
        delim :: String
delim      = MimeType -> Cursor -> String
stringAttr "delimiter" Cursor
cur
        parts :: [DatePart]
parts      = Cursor
cur Cursor -> (Cursor -> [DatePart]) -> [DatePart]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> 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 :: String
partsAttr  = MimeType -> Cursor -> String
stringAttr "date-parts" Cursor
cur

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

parseNames :: Cursor -> [Element]
parseNames :: Cursor -> [Element]
parseNames cur :: Cursor
cur = [[String] -> [Name] -> Formatting -> String -> [Element] -> Element
Names (String -> [String]
words String
variable) [Name]
names Formatting
formatting String
delim [Element]
others]
  where variable :: String
variable   = MimeType -> Cursor -> String
stringAttr "variable" Cursor
cur
        formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur
        delim :: String
delim      = MimeType -> Cursor -> String
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] -> String -> [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 -> MimeType
X.nameLocalName (Name -> MimeType) -> Name -> MimeType
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] -> String -> [NamePart] -> Name
Name (MimeType -> Form -> Cursor -> Form
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "form" Form
NotSet Cursor
cur)
                              Formatting
format (Element -> [Option]
nameAttrs Element
e) String
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 (MimeType -> Form -> Cursor -> Form
forall a. Read a => MimeType -> 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 -> String -> Name
EtAl Formatting
format (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ MimeType -> Cursor -> String
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    = MimeType -> Plural -> Cursor -> Plural
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "plural" Plural
Contextual Cursor
cur
         delim :: String
delim     = MimeType -> Cursor -> String
stringAttr "delimiter" Cursor
cur
         nameParts :: [NamePart]
nameParts = Cursor
cur Cursor -> (Cursor -> [NamePart]) -> [NamePart]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ MimeType -> 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 = [(MimeType -> String
T.unpack MimeType
n, MimeType -> String
T.unpack MimeType
v) |
                 (X.Name n :: MimeType
n _ _, v :: MimeType
v) <- Map Name MimeType -> [(Name, MimeType)]
forall k a. Map k a -> [(k, a)]
M.toList (Element -> Map Name MimeType
X.elementAttributes Element
x),
                 MimeType
n MimeType -> [MimeType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MimeType]
nameAttrKeys]
         nameAttrKeys :: [MimeType]
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 = String -> Formatting -> NamePart
NamePart String
s Formatting
format
   where format :: Formatting
format    = Cursor -> Formatting
getFormatting Cursor
cur
         s :: String
s         = MimeType -> Cursor -> String
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'      = MimeType -> Form -> Cursor -> Form
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "form" Form
Long Cursor
cur
      formatting :: Formatting
formatting     = Cursor -> Formatting
getFormatting Cursor
cur
      plural :: Bool
plural         = MimeType -> Bool -> Cursor -> Bool
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "plural" Bool
True Cursor
cur
      name :: String
name           = MimeType -> Cursor -> String
stringAttr "name" Cursor
cur
  in  [String -> Form -> Formatting -> Bool -> Element
Term String
name Form
termForm' Formatting
formatting Bool
plural]

parseText :: Cursor -> [Element]
parseText :: Cursor -> [Element]
parseText cur :: Cursor
cur =
  let term :: String
term           = MimeType -> Cursor -> String
stringAttr "term" Cursor
cur
      variable :: String
variable       = MimeType -> Cursor -> String
stringAttr "variable" Cursor
cur
      macro :: String
macro          = MimeType -> Cursor -> String
stringAttr "macro" Cursor
cur
      value :: String
value          = MimeType -> Cursor -> String
stringAttr "value" Cursor
cur
      delim :: String
delim          = MimeType -> Cursor -> String
stringAttr "delimiter" Cursor
cur
      formatting :: Formatting
formatting     = Cursor -> Formatting
getFormatting Cursor
cur
      plural :: Bool
plural         = MimeType -> Bool -> Cursor -> Bool
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "plural" Bool
True Cursor
cur
      textForm :: Form
textForm       = MimeType -> Form -> Cursor -> Form
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "form" Form
Long Cursor
cur
  in  if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
term)
         then [String -> Form -> Formatting -> Bool -> Element
Term String
term Form
textForm Formatting
formatting Bool
plural]
         else if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
macro)
              then [String -> Formatting -> Element
Macro String
macro Formatting
formatting]
              else if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
variable)
                      then [[String] -> Form -> Formatting -> String -> Element
Variable (String -> [String]
words String
variable) Form
textForm Formatting
formatting String
delim]
                      else [String -> Formatting -> Element
Const String
value Formatting
formatting | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
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]
$/ MimeType -> 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]
$/ MimeType -> 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]
$/ MimeType -> 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 :: [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Condition
Condition {
                 isType :: [String]
isType          = MimeType -> [String]
go "type"
               , isSet :: [String]
isSet           = MimeType -> [String]
go "variable"
               , isNumeric :: [String]
isNumeric       = MimeType -> [String]
go "is-numeric"
               , isUncertainDate :: [String]
isUncertainDate = MimeType -> [String]
go "is-uncertain-date"
               , isPosition :: [String]
isPosition      = MimeType -> [String]
go "position"
               , disambiguation :: [String]
disambiguation  = MimeType -> [String]
go "disambiguate"
               , isLocator :: [String]
isLocator       = MimeType -> [String]
go "locator"
               }
        mat :: Match
mat  = MimeType -> Match -> Cursor -> Match
forall a. Read a => MimeType -> 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 :: MimeType -> [String]
go x :: MimeType
x = String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ MimeType -> Cursor -> String
stringAttr MimeType
x Cursor
cur

parseLabel :: Cursor -> [Element]
parseLabel :: Cursor -> [Element]
parseLabel cur :: Cursor
cur = [String -> Form -> Formatting -> Plural -> Element
Label String
variable Form
form Formatting
formatting Plural
plural]
  where variable :: String
variable   = MimeType -> Cursor -> String
stringAttr "variable" Cursor
cur
        form :: Form
form       = MimeType -> Form -> Cursor -> Form
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "form" Form
Long Cursor
cur
        formatting :: Formatting
formatting = Cursor -> Formatting
getFormatting Cursor
cur
        plural :: Plural
plural     = MimeType -> Plural -> Cursor -> Plural
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "plural" Plural
Contextual Cursor
cur

parseNumber :: Cursor -> [Element]
parseNumber :: Cursor -> [Element]
parseNumber cur :: Cursor
cur = [String -> NumericForm -> Formatting -> Element
Number String
variable NumericForm
numForm Formatting
formatting]
  where variable :: String
variable   = MimeType -> Cursor -> String
stringAttr "variable" Cursor
cur
        numForm :: NumericForm
numForm    = MimeType -> NumericForm -> Cursor -> NumericForm
forall a. Read a => MimeType -> 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 :: String
delim          = MimeType -> Cursor -> String
stringAttr "delimiter" Cursor
cur
      formatting :: Formatting
formatting     = Cursor -> Formatting
getFormatting Cursor
cur
  in  [Formatting -> String -> [Element] -> Element
Group Formatting
formatting String
delim [Element]
elts]

parseMacroMap :: Cursor -> MacroMap
parseMacroMap :: Cursor -> MacroMap
parseMacroMap cur :: Cursor
cur = (String
name, [Element]
elts)
  where name :: String
name = Cursor
cur Cursor -> (Cursor -> String) -> String
forall node a. Cursor node -> (Cursor node -> a) -> a
$| MimeType -> Cursor -> String
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]
$/ MimeType -> 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]
$/ MimeType -> 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 -> String -> [Element] -> Layout
Layout
                                                      { layFormat :: Formatting
layFormat = Formatting
emptyFormatting
                                                      , layDelim :: String
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]
$/ MimeType -> 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 MimeType -> Cursor -> String
stringAttr "variable" Cursor
cur of
       "" ->
         case MimeType -> Cursor -> String
stringAttr "macro" Cursor
cur of
           "" -> []
           x :: String
x  -> [String -> Sorting -> Int -> Int -> String -> Sort
SortMacro String
x Sorting
sorting (MimeType -> Int -> Cursor -> Int
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "names-min" 0 Cursor
cur)
                       (MimeType -> Int -> Cursor -> Int
forall a. Read a => MimeType -> a -> Cursor -> a
attrWithDefault "names-use-first" 0 Cursor
cur)
                       (MimeType -> Cursor -> String
stringAttr "names-use-last" Cursor
cur)]
       x :: String
x  -> [String -> Sorting -> Sort
SortVariable String
x Sorting
sorting]
  where sorting :: Sorting
sorting = case MimeType -> Cursor -> String
stringAttr "sort" Cursor
cur of
                       "descending" -> String -> Sorting
Descending ""
                       _            -> String -> 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]
$/ MimeType -> 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]
$/ MimeType -> 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 -> String -> [Element] -> Layout
Layout
                                 { layFormat :: Formatting
layFormat = Formatting
emptyFormatting
                                 , layDelim :: String
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 ->
     [(MimeType -> String
T.unpack MimeType
n, MimeType -> String
T.unpack MimeType
v) |
      (X.Name n :: MimeType
n _ _, v :: MimeType
v) <- Map Name MimeType -> [(Name, MimeType)]
forall k a. Map k a -> [(k, a)]
M.toList (Element -> Map Name MimeType
X.elementAttributes Element
e)]
    _ -> []

parseLayout :: Cursor -> Layout
parseLayout :: Cursor -> Layout
parseLayout cur :: Cursor
cur =
  Layout :: Formatting -> String -> [Element] -> Layout
Layout
    { layFormat :: Formatting
layFormat = Cursor -> Formatting
getFormatting Cursor
cur
    , layDelim :: String
layDelim = MimeType -> Cursor -> String
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
    }