    {-# LANGUAGE ViewPatterns      #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Text.CSL.Input.Name
    -- Copyright   :  (c) John MacFarlane
    -- License     :  BSD-style (see LICENSE)
    --
    -- Maintainer  :  John MacFarlane <fiddlosopher@gmail.com>
    -- Stability   :  unstable
    -- Portability :  portable
    --
    -----------------------------------------------------------------------------

    module Text.Pandoc.Citeproc.Name
        ( toName
        , NameOpts(..)
        , emptyName
        )
        where

    import Text.Pandoc.Definition
    import Text.Pandoc.Shared (stringify)
    import Citeproc.Types
    import Citeproc.Pandoc ()
    import Text.Pandoc.Citeproc.Util (splitStrWhen)
    import qualified Data.Text              as T
    import           Data.List.Split        (splitWhen, wordsBy)
    import Data.Char (isUpper, isDigit)
    import Data.List (foldl')

    emptyName :: Name
    emptyName :: Name
    emptyName =
        Name {  nameFamily :: Maybe Text
    nameFamily              = Maybe Text
    forall a. Maybe a
    Nothing
              , nameGiven :: Maybe Text
    nameGiven               = Maybe Text
    forall a. Maybe a
    Nothing
              , nameDroppingParticle :: Maybe Text
    nameDroppingParticle    = Maybe Text
    forall a. Maybe a
    Nothing
              , nameNonDroppingParticle :: Maybe Text
    nameNonDroppingParticle = Maybe Text
    forall a. Maybe a
    Nothing
              , nameSuffix :: Maybe Text
    nameSuffix              = Maybe Text
    forall a. Maybe a
    Nothing
              , nameLiteral :: Maybe Text
    nameLiteral             = Maybe Text
    forall a. Maybe a
    Nothing
              , nameCommaSuffix :: Bool
    nameCommaSuffix         = Bool
    False
              , nameStaticOrdering :: Bool
    nameStaticOrdering      = Bool
    False
              }

    -- | Options for 'toName'.
    data NameOpts =
      NameOpts
        { NameOpts -> Bool
    nameOptsPrefixIsNonDroppingParticle :: Bool
            -- ^ Treat a prefix on the last name as a non-dropping particle
            -- (default is to treat it as a dropping particle). This corresponds
            -- to the biblatex option @useprefix@.
        , NameOpts -> Bool
    nameOptsUseJuniorComma              :: Bool
            -- ^ Put a comma before a suffix like "Jr." This corresponds to the
            -- biblatex option @juniorcomma@.
        } deriving (Int -> NameOpts -> ShowS
    [NameOpts] -> ShowS
    NameOpts -> String
    (Int -> NameOpts -> ShowS)
    -> (NameOpts -> String) -> ([NameOpts] -> ShowS) -> Show NameOpts
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> NameOpts -> ShowS
    showsPrec :: Int -> NameOpts -> ShowS
    $cshow :: NameOpts -> String
    show :: NameOpts -> String
    $cshowList :: [NameOpts] -> ShowS
    showList :: [NameOpts] -> ShowS
    Show)

    -- | Parse a list of 'Inline's into a citeproc 'Name', identifying
    -- first and last name, particles, suffixes.
    toName :: Monad m => NameOpts -> [Inline] -> m Name
    toName :: forall (m :: * -> *). Monad m => NameOpts -> [Inline] -> m Name
    toName NameOpts
    _ [Str Text
    "others"] =
      Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    emptyName{ nameLiteral = Just "others" }
    toName NameOpts
    _ [Span (Text
    "",[],[]) [Inline]
    ils] = -- corporate author
      Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    emptyName{ nameLiteral = Just $ stringify ils }
    -- extended BibLaTeX name format - see #266
    toName NameOpts
    _ ils :: [Inline]
    ils@(Str Text
    ys:[Inline]
    _) | (Char -> Bool) -> Text -> Bool
    T.any (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '=') Text
    ys = do
      let commaParts :: [[Inline]]
    commaParts = (Inline -> Bool) -> [Inline] -> [[Inline]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    splitWhen (Inline -> Inline -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Inline
    Str Text
    ",")
                       ([Inline] -> [[Inline]])
    -> ([Inline] -> [Inline]) -> [Inline] -> [[Inline]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> [Inline] -> [Inline]
    splitStrWhen (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ',' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '=' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\160')
                       ([Inline] -> [[Inline]]) -> [Inline] -> [[Inline]]
    forall a b. (a -> b) -> a -> b
    $ [Inline]
    ils
      let addPart :: Name -> [Inline] -> Name
    addPart Name
    ag (Str Text
    "given" : Str Text
    "=" : [Inline]
    xs) =
            Name
    ag{ nameGiven = case nameGiven ag of
                              Maybe Text
    Nothing -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    xs
                              Just Text
    t  -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    xs }
          addPart Name
    ag (Str Text
    "family" : Str Text
    "=" : [Inline]
    xs) =
            Name
    ag{ nameFamily = Just $ stringify xs }
          addPart Name
    ag (Str Text
    "prefix" : Str Text
    "=" : [Inline]
    xs) =
            Name
    ag{ nameDroppingParticle =  Just $ stringify xs }
          addPart Name
    ag (Str Text
    "useprefix" : Str Text
    "=" : Str Text
    "true" : [Inline]
    _) =
            Name
    ag{ nameNonDroppingParticle = nameDroppingParticle ag
              , nameDroppingParticle    = Nothing }
          addPart Name
    ag (Str Text
    "suffix" : Str Text
    "=" : [Inline]
    xs) =
            Name
    ag{ nameSuffix = Just $ stringify xs }
          addPart Name
    ag (Inline
    Space : [Inline]
    xs) = Name -> [Inline] -> Name
    addPart Name
    ag [Inline]
    xs
          addPart Name
    ag [Inline]
    _ = Name
    ag
      Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> m Name) -> Name -> m Name
    forall a b. (a -> b) -> a -> b
    $ (Name -> [Inline] -> Name) -> Name -> [[Inline]] -> Name
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Name -> [Inline] -> Name
    addPart Name
    emptyName [[Inline]]
    commaParts
    -- First von Last
    -- von Last, First
    -- von Last, Jr ,First
    -- NOTE: biblatex and bibtex differ on:
    -- Drummond de Andrade, Carlos
    -- bibtex takes "Drummond de" as the von;
    -- biblatex takes the whole as a last name.
    -- See https://github.com/plk/biblatex/issues/236
    -- Here we implement the more sensible biblatex behavior.
    toName NameOpts
    opts [Inline]
    ils = do
      let words' :: [Inline] -> [[Inline]]
    words' = (Inline -> Bool) -> [Inline] -> [[Inline]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    wordsBy (\Inline
    x -> Inline
    x Inline -> Inline -> Bool
    forall a. Eq a => a -> a -> Bool
    == Inline
    Space Bool -> Bool -> Bool
    || Inline
    x Inline -> Inline -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Inline
    Str Text
    "\160")
      let commaParts :: [[[Inline]]]
    commaParts = ([Inline] -> [[Inline]]) -> [[Inline]] -> [[[Inline]]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Inline] -> [[Inline]]
    words' ([[Inline]] -> [[[Inline]]]) -> [[Inline]] -> [[[Inline]]]
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Bool) -> [Inline] -> [[Inline]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    splitWhen (Inline -> Inline -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Inline
    Str Text
    ",")
                                  ([Inline] -> [[Inline]]) -> [Inline] -> [[Inline]]
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> [Inline] -> [Inline]
    splitStrWhen
                                       (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ',' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\160') [Inline]
    ils
      let ([[Inline]]
    first, [[Inline]]
    vonlast, [[Inline]]
    jr) =
              case [[[Inline]]]
    commaParts of
                   --- First is the longest sequence of white-space separated
                   -- words starting with an uppercase and that is not the
                   -- whole string. von is the longest sequence of whitespace
                   -- separated words whose last word starts with lower case
                   -- and that is not the whole string.
                   [[[Inline]]
    fvl]      -> let ([[Inline]]
    caps', [[Inline]]
    rest') = ([Inline] -> Bool) -> [[Inline]] -> ([[Inline]], [[Inline]])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span [Inline] -> Bool
    isCapitalized [[Inline]]
    fvl
                                 in  if [[Inline]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Inline]]
    rest' Bool -> Bool -> Bool
    && Bool -> Bool
    not ([[Inline]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Inline]]
    caps')
                                     then ([[Inline]] -> [[Inline]]
    forall a. HasCallStack => [a] -> [a]
    init [[Inline]]
    caps', [[[Inline]] -> [Inline]
    forall a. HasCallStack => [a] -> a
    last [[Inline]]
    caps'], [])
                                     else ([[Inline]]
    caps', [[Inline]]
    rest', [])
                   [[[Inline]]
    vl,[[Inline]]
    f]     -> ([[Inline]]
    f, [[Inline]]
    vl, [])
                   ([[Inline]]
    vl:[[Inline]]
    j:[[Inline]]
    f:[[[Inline]]]
    _) -> ([[Inline]]
    f, [[Inline]]
    vl, [[Inline]]
    j )
                   []         -> ([], [], [])

      let ([[Inline]]
    von, [[Inline]]
    lastname) =
                     case ([Inline] -> Bool) -> [[Inline]] -> ([[Inline]], [[Inline]])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break [Inline] -> Bool
    isCapitalized [[Inline]]
    vonlast of
                            (vs :: [[Inline]]
    vs@([Inline]
    _:[[Inline]]
    _), []) -> ([[Inline]] -> [[Inline]]
    forall a. HasCallStack => [a] -> [a]
    init [[Inline]]
    vs, [[[Inline]] -> [Inline]
    forall a. HasCallStack => [a] -> a
    last [[Inline]]
    vs])
                            ([[Inline]]
    vs, [[Inline]]
    ws)       -> ([[Inline]]
    vs, [[Inline]]
    ws)
      let prefix :: Text
    prefix = [Text] -> Text
    T.unwords ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ ([Inline] -> Text) -> [[Inline]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [[Inline]]
    von
      let family :: Text
    family = [Text] -> Text
    T.unwords ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ ([Inline] -> Text) -> [[Inline]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [[Inline]]
    lastname
      let suffix :: Text
    suffix = [Text] -> Text
    T.unwords ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ ([Inline] -> Text) -> [[Inline]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [[Inline]]
    jr
      let given :: Text
    given = [Text] -> Text
    T.unwords ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ ([Inline] -> Text) -> [[Inline]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [[Inline]]
    first
      Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        Name {  nameFamily :: Maybe Text
    nameFamily              = if Text -> Bool
    T.null Text
    family
                                             then Maybe Text
    forall a. Maybe a
    Nothing
                                             else Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    family
              , nameGiven :: Maybe Text
    nameGiven               = if Text -> Bool
    T.null Text
    given
                                             then Maybe Text
    forall a. Maybe a
    Nothing
                                             else Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    given
              , nameDroppingParticle :: Maybe Text
    nameDroppingParticle    = if NameOpts -> Bool
    nameOptsPrefixIsNonDroppingParticle NameOpts
    opts Bool -> Bool -> Bool
    ||
                                              Text -> Bool
    T.null Text
    prefix
                                             then Maybe Text
    forall a. Maybe a
    Nothing
                                             else Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    prefix
              , nameNonDroppingParticle :: Maybe Text
    nameNonDroppingParticle = if NameOpts -> Bool
    nameOptsPrefixIsNonDroppingParticle NameOpts
    opts Bool -> Bool -> Bool
    &&
                                              Bool -> Bool
    not (Text -> Bool
    T.null Text
    prefix)
                                             then Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    prefix
                                             else Maybe Text
    forall a. Maybe a
    Nothing
              , nameSuffix :: Maybe Text
    nameSuffix              = if Text -> Bool
    T.null Text
    suffix
                                             then Maybe Text
    forall a. Maybe a
    Nothing
                                             else Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    suffix
              , nameLiteral :: Maybe Text
    nameLiteral             = Maybe Text
    forall a. Maybe a
    Nothing
              , nameCommaSuffix :: Bool
    nameCommaSuffix         = NameOpts -> Bool
    nameOptsUseJuniorComma NameOpts
    opts
              , nameStaticOrdering :: Bool
    nameStaticOrdering      = Bool
    False
              }

    isCapitalized :: [Inline] -> Bool
    isCapitalized :: [Inline] -> Bool
    isCapitalized (Str (Text -> Maybe (Char, Text)
    T.uncons -> Just (Char
    c,Text
    cs)) : [Inline]
    rest)
      | Char -> Bool
    isUpper Char
    c = Bool
    True
      | Char -> Bool
    isDigit Char
    c = [Inline] -> Bool
    isCapitalized (Text -> Inline
    Str Text
    cs Inline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    : [Inline]
    rest)
      | Bool
    otherwise = Bool
    False
    isCapitalized (Inline
    _:[Inline]
    rest) = [Inline] -> Bool
    isCapitalized [Inline]
    rest
    isCapitalized [] = Bool
    True