{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
Module      : Text.Pandoc.Parsing.Citations
Copyright   : © 2006-2023 John MacFarlane
License     : GPL-2.0-or-later
Maintainer  : John MacFarlane <jgm@berkeley.edu>

Citation parsing.
-}

module Text.Pandoc.Parsing.Citations
  ( citeKey
  )
where

import Control.Monad (guard, MonadPlus(mzero))
import Data.Char (isAlphaNum , isSpace)
import Data.Text (Text)
import Text.Pandoc.Sources
import Text.Parsec
  ( (<|>)
  , Stream(..)
  , ParsecT
  , lookAhead
  , many
  , option
  , try
  )
import Text.Pandoc.Parsing.Capabilities (HasLastStrPosition, notAfterString)
import Text.Pandoc.Parsing.General

import qualified Data.Text as T

citeKey :: (Stream s m Char, UpdateSourcePos s Char, HasLastStrPosition st)
        => Bool -- ^ If True, allow expanded @{..} syntax.
        -> ParsecT s st m (Bool, Text)
citeKey :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, HasLastStrPosition st) =>
Bool -> ParsecT s st m (Bool, Text)
citeKey Bool
allowBraced = ParsecT s st m (Bool, Text) -> ParsecT s st m (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m (Bool, Text) -> ParsecT s st m (Bool, Text))
-> ParsecT s st m (Bool, Text) -> ParsecT s st m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
  Bool -> ParsecT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT s st m ())
-> ParsecT s st m Bool -> ParsecT s st m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT s st m Bool
forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParsecT s st m Bool
notAfterString
  Bool
suppress_author <- Bool -> ParsecT s st m Bool -> ParsecT s st m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (Bool
True Bool -> ParsecT s st m Char -> ParsecT s st m Bool
forall a b. a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-')
  Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'@'
  Text
key <- ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
simpleCiteIdentifier
        ParsecT s st m Text -> ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> if Bool
allowBraced
               then Char -> Char -> ParsecT s st m Text -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> Char -> ParsecT s st m Text -> ParsecT s st m Text
charsInBalanced Char
'{' Char
'}'
                     (Char -> Text
T.singleton (Char -> Text) -> ParsecT s st m Char -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)))
               else ParsecT s st m Text
forall a. ParsecT s st m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  (Bool, Text) -> ParsecT s st m (Bool, Text)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
suppress_author, Text
key)

simpleCiteIdentifier :: (Stream s m Char, UpdateSourcePos s Char)
                      => ParsecT s st m Text
simpleCiteIdentifier :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
simpleCiteIdentifier = do
  Char
firstChar <- ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_' ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*' -- @* for wildcard in nocite
  let regchar :: ParsecT s u m Char
regchar = (Char -> Bool) -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
  let internal :: ParsecT s u m a -> ParsecT s u m a
internal ParsecT s u m a
p = ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m a -> ParsecT s u m a)
-> ParsecT s u m a -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ ParsecT s u m a
p ParsecT s u m a -> ParsecT s u m Char -> ParsecT s u m a
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m Char -> ParsecT s u m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT s u m Char
forall {u}. ParsecT s u m Char
regchar
  [Char]
rest <- ParsecT s st m Char -> ParsecT s st m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s st m Char -> ParsecT s st m [Char])
-> ParsecT s st m Char -> ParsecT s st m [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
regchar ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m Char -> ParsecT s st m Char
forall {u} {a}. ParsecT s u m a -> ParsecT s u m a
internal ([Char] -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
":.#$%&-+?<>~/") ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                 ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
":/" ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s st m Char -> ParsecT s st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'/'))
  Text -> ParsecT s st m Text
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT s st m Text) -> Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Char
firstCharChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest