{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Citeproc.Locator
  ( parseLocator
  , toLocatorMap
  , LocatorInfo(..)
  , LocatorMap(..) )
where
import Citeproc.Types
import Text.Pandoc.Citeproc.Util (splitStrWhen)
import Data.Text (Text)
import qualified Data.Text as T
import Data.List (foldl')
import Text.Pandoc.Definition
import Text.Pandoc.Parsing
import Text.Pandoc.Shared (stringify)
import Control.Monad (mzero)
import qualified Data.Map as M
import Data.Char (isSpace, isPunctuation, isDigit)


data LocatorInfo =
  LocatorInfo{ LocatorInfo -> Text
locatorRaw :: Text
             , LocatorInfo -> Text
locatorLabel :: Text
             , LocatorInfo -> Text
locatorLoc :: Text
             }
  deriving (Int -> LocatorInfo -> ShowS
[LocatorInfo] -> ShowS
LocatorInfo -> String
(Int -> LocatorInfo -> ShowS)
-> (LocatorInfo -> String)
-> ([LocatorInfo] -> ShowS)
-> Show LocatorInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocatorInfo -> ShowS
showsPrec :: Int -> LocatorInfo -> ShowS
$cshow :: LocatorInfo -> String
show :: LocatorInfo -> String
$cshowList :: [LocatorInfo] -> ShowS
showList :: [LocatorInfo] -> ShowS
Show)

parseLocator :: LocatorMap -> [Inline] -> (Maybe LocatorInfo, [Inline])
parseLocator :: LocatorMap -> [Inline] -> (Maybe LocatorInfo, [Inline])
parseLocator LocatorMap
locmap [Inline]
inp =
  case Parsec [Inline] () (Maybe LocatorInfo, [Inline])
-> String
-> [Inline]
-> Either ParseError (Maybe LocatorInfo, [Inline])
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (LocatorMap -> Parsec [Inline] () (Maybe LocatorInfo, [Inline])
pLocatorWords LocatorMap
locmap) String
"suffix" ([Inline] -> Either ParseError (Maybe LocatorInfo, [Inline]))
-> [Inline] -> Either ParseError (Maybe LocatorInfo, [Inline])
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
splitInp [Inline]
inp of
       Right (Maybe LocatorInfo, [Inline])
r -> (Maybe LocatorInfo, [Inline])
r
       Left ParseError
_  -> (Maybe LocatorInfo
forall a. Maybe a
Nothing, [Inline] -> [Inline]
maybeAddComma [Inline]
inp)

splitInp :: [Inline] -> [Inline]
splitInp :: [Inline] -> [Inline]
splitInp = (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| (Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':'))

--
-- Locator parsing
--

type LocatorParser = Parsec [Inline] ()

pLocatorWords :: LocatorMap
              -> LocatorParser (Maybe LocatorInfo, [Inline])
pLocatorWords :: LocatorMap -> Parsec [Inline] () (Maybe LocatorInfo, [Inline])
pLocatorWords LocatorMap
locMap = do
  ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT [Inline] () Identity Inline
 -> ParsecT [Inline] () Identity ())
-> ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar String
"," (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')
  ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Inline] () Identity Inline
pSpace
  LocatorInfo
info <- LocatorMap -> LocatorParser LocatorInfo
pLocatorDelimited LocatorMap
locMap LocatorParser LocatorInfo
-> LocatorParser LocatorInfo -> LocatorParser LocatorInfo
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> LocatorMap -> LocatorParser LocatorInfo
pLocatorIntegrated LocatorMap
locMap
  [Inline]
s <- ParsecT [Inline] () Identity [Inline]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput -- rest is suffix
  (Maybe LocatorInfo, [Inline])
-> Parsec [Inline] () (Maybe LocatorInfo, [Inline])
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe LocatorInfo, [Inline])
 -> Parsec [Inline] () (Maybe LocatorInfo, [Inline]))
-> (Maybe LocatorInfo, [Inline])
-> Parsec [Inline] () (Maybe LocatorInfo, [Inline])
forall a b. (a -> b) -> a -> b
$
    if Text -> Bool
T.null (LocatorInfo -> Text
locatorLabel LocatorInfo
info) Bool -> Bool -> Bool
&& Text -> Bool
T.null (LocatorInfo -> Text
locatorLoc LocatorInfo
info)
       then (Maybe LocatorInfo
forall a. Maybe a
Nothing, [Inline] -> [Inline]
maybeAddComma [Inline]
s)
       else (LocatorInfo -> Maybe LocatorInfo
forall a. a -> Maybe a
Just LocatorInfo
info, [Inline]
s)

maybeAddComma :: [Inline] -> [Inline]
maybeAddComma :: [Inline] -> [Inline]
maybeAddComma [] = []
maybeAddComma ils :: [Inline]
ils@(Inline
Space : [Inline]
_) = [Inline]
ils
maybeAddComma ils :: [Inline]
ils@(Str Text
t : [Inline]
_)
  | Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
t
  , Char -> Bool
isPunctuation Char
c = [Inline]
ils
maybeAddComma [Inline]
ils = Text -> Inline
Str Text
"," Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils

pLocatorDelimited :: LocatorMap -> LocatorParser LocatorInfo
pLocatorDelimited :: LocatorMap -> LocatorParser LocatorInfo
pLocatorDelimited LocatorMap
locMap = LocatorParser LocatorInfo -> LocatorParser LocatorInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LocatorParser LocatorInfo -> LocatorParser LocatorInfo)
-> LocatorParser LocatorInfo -> LocatorParser LocatorInfo
forall a b. (a -> b) -> a -> b
$ do
  Inline
_ <- String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar String
"{" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{')
  ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Inline] () Identity Inline
pSpace -- gobble pre-spaces so label doesn't try to include them
  (Text
rawlab, Text
la, Bool
_) <- LocatorMap -> LocatorParser (Text, Text, Bool)
pLocatorLabelDelimited LocatorMap
locMap
  -- we only care about balancing {} and [] (because of the outer [] scope);
  -- the rest can be anything
  let inner :: ParsecT [Inline] u Identity (Bool, Text)
inner = do { Inline
t <- ParsecT [Inline] u Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken; (Bool, Text) -> ParsecT [Inline] u Identity (Bool, Text)
forall a. a -> ParsecT [Inline] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
t) }
  [(Bool, Text)]
gs <- ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity [(Bool, Text)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([(Char, Char)]
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
pBalancedBraces [(Char
'{',Char
'}'), (Char
'[',Char
']')] ParsecT [Inline] () Identity (Bool, Text)
forall {u}. ParsecT [Inline] u Identity (Bool, Text)
inner)
  Inline
_ <- String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar String
"}" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}')
  let lo :: Text
lo = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Bool, Text) -> Text) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Text) -> Text
forall a b. (a, b) -> b
snd [(Bool, Text)]
gs
  LocatorInfo -> LocatorParser LocatorInfo
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatorInfo -> LocatorParser LocatorInfo)
-> LocatorInfo -> LocatorParser LocatorInfo
forall a b. (a -> b) -> a -> b
$ LocatorInfo{ locatorLoc :: Text
locatorLoc = Text
lo,
                        locatorLabel :: Text
locatorLabel = Text
la,
                        locatorRaw :: Text
locatorRaw = Text
rawlab Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" }

pLocatorLabelDelimited :: LocatorMap -> LocatorParser (Text, Text, Bool)
pLocatorLabelDelimited :: LocatorMap -> LocatorParser (Text, Text, Bool)
pLocatorLabelDelimited LocatorMap
locMap
  = LocatorMap
-> LocatorParser Text -> LocatorParser (Text, Text, Bool)
pLocatorLabel' LocatorMap
locMap (Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text)
-> ParsecT [Inline] () Identity Inline -> LocatorParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Inline] () Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken)
      LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Text
"", Text
"page", Bool
True) (Text, Text, Bool)
-> ParsecT [Inline] () Identity Inline
-> LocatorParser (Text, Text, Bool)
forall a b.
a
-> ParsecT [Inline] () Identity b -> ParsecT [Inline] () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity Inline
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar String
"digit" Char -> Bool
isDigit))
      LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Text, Text, Bool) -> LocatorParser (Text, Text, Bool)
forall a. a -> ParsecT [Inline] () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"", Text
"", Bool
True))

pLocatorIntegrated :: LocatorMap -> LocatorParser LocatorInfo
pLocatorIntegrated :: LocatorMap -> LocatorParser LocatorInfo
pLocatorIntegrated LocatorMap
locMap = LocatorParser LocatorInfo -> LocatorParser LocatorInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LocatorParser LocatorInfo -> LocatorParser LocatorInfo)
-> LocatorParser LocatorInfo -> LocatorParser LocatorInfo
forall a b. (a -> b) -> a -> b
$ do
  (Text
rawlab, Text
la, Bool
wasImplicit) <- LocatorMap -> LocatorParser (Text, Text, Bool)
pLocatorLabelIntegrated LocatorMap
locMap
  -- if we got the label implicitly, we have presupposed the first one is
  -- going to have a digit, so guarantee that. You _can_ have p. (a)
  -- because you specified it.
  let modifier :: (Bool, Text) -> LocatorParser Text
modifier = if Bool
wasImplicit
                    then (Bool, Text) -> LocatorParser Text
requireDigits
                    else (Bool, Text) -> LocatorParser Text
requireRomansOrDigits
  Text
g <- LocatorParser Text -> LocatorParser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LocatorParser Text -> LocatorParser Text)
-> LocatorParser Text -> LocatorParser Text
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT [Inline] () Identity (Bool, Text)
pLocatorWordIntegrated (Bool -> Bool
not Bool
wasImplicit) ParsecT [Inline] () Identity (Bool, Text)
-> ((Bool, Text) -> LocatorParser Text) -> LocatorParser Text
forall a b.
ParsecT [Inline] () Identity a
-> (a -> ParsecT [Inline] () Identity b)
-> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, Text) -> LocatorParser Text
modifier
  [Text]
gs <- LocatorParser Text -> ParsecT [Inline] () Identity [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (LocatorParser Text -> LocatorParser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LocatorParser Text -> LocatorParser Text)
-> LocatorParser Text -> LocatorParser Text
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT [Inline] () Identity (Bool, Text)
pLocatorWordIntegrated Bool
False ParsecT [Inline] () Identity (Bool, Text)
-> ((Bool, Text) -> LocatorParser Text) -> LocatorParser Text
forall a b.
ParsecT [Inline] () Identity a
-> (a -> ParsecT [Inline] () Identity b)
-> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, Text) -> LocatorParser Text
modifier)
  let lo :: Text
lo = [Text] -> Text
T.concat (Text
gText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
gs)
  LocatorInfo -> LocatorParser LocatorInfo
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatorInfo -> LocatorParser LocatorInfo)
-> LocatorInfo -> LocatorParser LocatorInfo
forall a b. (a -> b) -> a -> b
$ LocatorInfo{ locatorLabel :: Text
locatorLabel = Text
la,
                        locatorLoc :: Text
locatorLoc = Text
lo,
                        locatorRaw :: Text
locatorRaw = Text
rawlab Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lo }

pLocatorLabelIntegrated :: LocatorMap -> LocatorParser (Text, Text, Bool)
pLocatorLabelIntegrated :: LocatorMap -> LocatorParser (Text, Text, Bool)
pLocatorLabelIntegrated LocatorMap
locMap
  = LocatorMap
-> LocatorParser Text -> LocatorParser (Text, Text, Bool)
pLocatorLabel' LocatorMap
locMap LocatorParser Text
lim LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
     (LocatorParser Text -> LocatorParser Text
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead LocatorParser Text
digital LocatorParser Text
-> LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
forall a b.
ParsecT [Inline] () Identity a
-> ParsecT [Inline] () Identity b -> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Text, Text, Bool) -> LocatorParser (Text, Text, Bool)
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"", Text
"page", Bool
True))
    where
      lim :: LocatorParser Text
lim = LocatorParser Text -> LocatorParser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LocatorParser Text -> LocatorParser Text)
-> LocatorParser Text -> LocatorParser Text
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT [Inline] () Identity (Bool, Text)
pLocatorWordIntegrated Bool
True ParsecT [Inline] () Identity (Bool, Text)
-> ((Bool, Text) -> LocatorParser Text) -> LocatorParser Text
forall a b.
ParsecT [Inline] () Identity a
-> (a -> ParsecT [Inline] () Identity b)
-> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, Text) -> LocatorParser Text
requireRomansOrDigits
      digital :: LocatorParser Text
digital = LocatorParser Text -> LocatorParser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LocatorParser Text -> LocatorParser Text)
-> LocatorParser Text -> LocatorParser Text
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT [Inline] () Identity (Bool, Text)
pLocatorWordIntegrated Bool
True ParsecT [Inline] () Identity (Bool, Text)
-> ((Bool, Text) -> LocatorParser Text) -> LocatorParser Text
forall a b.
ParsecT [Inline] () Identity a
-> (a -> ParsecT [Inline] () Identity b)
-> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, Text) -> LocatorParser Text
requireDigits

pLocatorLabel' :: LocatorMap -> LocatorParser Text
               -> LocatorParser (Text, Text, Bool)
pLocatorLabel' :: LocatorMap
-> LocatorParser Text -> LocatorParser (Text, Text, Bool)
pLocatorLabel' LocatorMap
locMap LocatorParser Text
lim = Text -> LocatorParser (Text, Text, Bool)
go Text
""
    where
      -- grow the match string until we hit the end
      -- trying to find the largest match for a label
      go :: Text -> LocatorParser (Text, Text, Bool)
go Text
acc = LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LocatorParser (Text, Text, Bool)
 -> LocatorParser (Text, Text, Bool))
-> LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
forall a b. (a -> b) -> a -> b
$ do
          -- advance at least one token each time
          -- the pathological case is "p.3"
          Inline
t <- ParsecT [Inline] () Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
          [Inline]
ts <- ParsecT [Inline] () Identity Inline
-> LocatorParser Text -> ParsecT [Inline] () Identity [Inline]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [Inline] () Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken (LocatorParser Text -> LocatorParser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LocatorParser Text -> LocatorParser Text)
-> LocatorParser Text -> LocatorParser Text
forall a b. (a -> b) -> a -> b
$ LocatorParser Text -> LocatorParser Text
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead LocatorParser Text
lim)
          let s :: Text
s = Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline
tInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ts)
          case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Text
T.toCaseFold (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
s) (LocatorMap -> Map Text Text
unLocatorMap LocatorMap
locMap) of
            -- try to find a longer one, or return this one
            Just Text
l -> Text -> LocatorParser (Text, Text, Bool)
go Text
s LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
-> LocatorParser (Text, Text, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text, Text, Bool) -> LocatorParser (Text, Text, Bool)
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, Text
l, Bool
False)
            Maybe Text
Nothing -> Text -> LocatorParser (Text, Text, Bool)
go Text
s

-- hard requirement for a locator to have some real digits in it
requireDigits :: (Bool, Text) -> LocatorParser Text
requireDigits :: (Bool, Text) -> LocatorParser Text
requireDigits (Bool
_, Text
s) = if Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
s)
                          then String -> LocatorParser Text
forall a. String -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"requireDigits"
                          else Text -> LocatorParser Text
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

-- soft requirement for a sequence with some roman or arabic parts
-- (a)(iv) -- because iv is roman
-- 1(a)  -- because 1 is an actual digit
-- NOT: a, (a)-(b), hello, (some text in brackets)
requireRomansOrDigits :: (Bool, Text) -> LocatorParser Text
requireRomansOrDigits :: (Bool, Text) -> LocatorParser Text
requireRomansOrDigits (Bool
d, Text
s) = if Bool -> Bool
not Bool
d
                                  then String -> LocatorParser Text
forall a. String -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"requireRomansOrDigits"
                                  else Text -> LocatorParser Text
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

pLocatorWordIntegrated :: Bool -> LocatorParser (Bool, Text)
pLocatorWordIntegrated :: Bool -> ParsecT [Inline] () Identity (Bool, Text)
pLocatorWordIntegrated Bool
isFirst = ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] () Identity (Bool, Text)
 -> ParsecT [Inline] () Identity (Bool, Text))
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
  Text
punct <- if Bool
isFirst
              then Text -> LocatorParser Text
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
              else (Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text)
-> ParsecT [Inline] () Identity Inline -> LocatorParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Inline] () Identity Inline
pLocatorSep) LocatorParser Text -> LocatorParser Text -> LocatorParser Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> LocatorParser Text
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
  Text
sp <- Text -> LocatorParser Text -> LocatorParser Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (ParsecT [Inline] () Identity Inline
pSpace ParsecT [Inline] () Identity Inline
-> LocatorParser Text -> LocatorParser Text
forall a b.
ParsecT [Inline] () Identity a
-> ParsecT [Inline] () Identity b -> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> LocatorParser Text
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" ")
  (Bool
dig, Text
s) <- [(Char, Char)]
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
pBalancedBraces [(Char
'(',Char
')'), (Char
'[',Char
']'), (Char
'{',Char
'}')] ParsecT [Inline] () Identity (Bool, Text)
pPageSeq
  (Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text)
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
dig, Text
punct Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s)

-- we want to capture:  123, 123A, C22, XVII, 33-44, 22-33; 22-11
--                      34(1), 34A(A), 34(1)(i)(i), (1)(a)
--                      [17], [17]-[18], '591 [84]'
--                      (because CSL cannot pull out individual pages/sections
--                      to wrap in braces on a per-style basis)
pBalancedBraces :: [(Char, Char)]
                -> LocatorParser (Bool, Text)
                -> LocatorParser (Bool, Text)
pBalancedBraces :: [(Char, Char)]
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
pBalancedBraces [(Char, Char)]
braces ParsecT [Inline] () Identity (Bool, Text)
p = ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] () Identity (Bool, Text)
 -> ParsecT [Inline] () Identity (Bool, Text))
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
  [(Bool, Text)]
ss <- ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity [(Bool, Text)]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Inline] () Identity (Bool, Text)
surround
  (Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text)
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text))
-> (Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text)
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> (Bool, Text)
anyWereDigitLike [(Bool, Text)]
ss
  where
      except :: ParsecT [Inline] () Identity (Bool, Text)
except = ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] () Identity Inline
pBraces ParsecT [Inline] () Identity ()
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall a b.
ParsecT [Inline] () Identity a
-> ParsecT [Inline] () Identity b -> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Inline] () Identity (Bool, Text)
p
      -- outer and inner
      surround :: ParsecT [Inline] () Identity (Bool, Text)
surround = (ParsecT [Inline] () Identity (Bool, Text)
 -> (Char, Char) -> ParsecT [Inline] () Identity (Bool, Text))
-> ParsecT [Inline] () Identity (Bool, Text)
-> [(Char, Char)]
-> ParsecT [Inline] () Identity (Bool, Text)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ParsecT [Inline] () Identity (Bool, Text)
a (Char
open, Char
close) -> Char
-> Char
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
sur Char
open Char
close ParsecT [Inline] () Identity (Bool, Text)
except ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Inline] () Identity (Bool, Text)
a)
                       ParsecT [Inline] () Identity (Bool, Text)
except
                       [(Char, Char)]
braces

      isc :: Char -> LocatorParser Text
isc Char
c = Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text)
-> ParsecT [Inline] () Identity Inline -> LocatorParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar [Char
c] (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)

      sur :: Char
-> Char
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
sur Char
c Char
c' ParsecT [Inline] () Identity (Bool, Text)
m = ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] () Identity (Bool, Text)
 -> ParsecT [Inline] () Identity (Bool, Text))
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
          (Bool
d, Text
mid) <- Char -> LocatorParser Text
isc Char
c LocatorParser Text
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall a b.
ParsecT [Inline] () Identity a
-> ParsecT [Inline] () Identity b -> ParsecT [Inline] () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Bool
False, Text
"") ParsecT [Inline] () Identity (Bool, Text)
m ParsecT [Inline] () Identity (Bool, Text)
-> LocatorParser Text -> ParsecT [Inline] () Identity (Bool, Text)
forall a b.
ParsecT [Inline] () Identity a
-> ParsecT [Inline] () Identity b -> ParsecT [Inline] () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> LocatorParser Text
isc Char
c'
          (Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text)
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
d, Char -> Text -> Text
T.cons Char
c (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
c' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$  Text
mid)

      flattened :: String
flattened = ((Char, Char) -> String) -> [(Char, Char)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Char
o, Char
c) -> [Char
o, Char
c]) [(Char, Char)]
braces
      pBraces :: ParsecT [Inline] () Identity Inline
pBraces = String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar String
"braces" (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
flattened)


-- YES 1, 1.2, 1.2.3
-- NO  1., 1.2. a.6
-- can't use sepBy because we want to leave trailing .s
pPageSeq :: LocatorParser (Bool, Text)
pPageSeq :: ParsecT [Inline] () Identity (Bool, Text)
pPageSeq = ParsecT [Inline] () Identity (Bool, Text)
oneDotTwo ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Inline] () Identity (Bool, Text)
withPeriod
  where
      oneDotTwo :: ParsecT [Inline] () Identity (Bool, Text)
oneDotTwo = do
          (Bool, Text)
u <- ParsecT [Inline] () Identity (Bool, Text)
pPageUnit
          [(Bool, Text)]
us <- ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity [(Bool, Text)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Inline] () Identity (Bool, Text)
withPeriod
          (Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text)
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text))
-> (Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text)
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> (Bool, Text)
anyWereDigitLike ((Bool, Text)
u(Bool, Text) -> [(Bool, Text)] -> [(Bool, Text)]
forall a. a -> [a] -> [a]
:[(Bool, Text)]
us)
      withPeriod :: ParsecT [Inline] () Identity (Bool, Text)
withPeriod = ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] () Identity (Bool, Text)
 -> ParsecT [Inline] () Identity (Bool, Text))
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
          -- .2
          Inline
p <- String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar String
"." (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
          (Bool, Text)
u <- ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Inline] () Identity (Bool, Text)
pPageUnit
          (Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text)
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Text) -> Bool
forall a b. (a, b) -> a
fst (Bool, Text)
u, Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Bool, Text) -> Text
forall a b. (a, b) -> b
snd (Bool, Text)
u)

anyWereDigitLike :: [(Bool, Text)] -> (Bool, Text)
anyWereDigitLike :: [(Bool, Text)] -> (Bool, Text)
anyWereDigitLike [(Bool, Text)]
as = (((Bool, Text) -> Bool) -> [(Bool, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, Text) -> Bool
forall a b. (a, b) -> a
fst [(Bool, Text)]
as, [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Bool, Text) -> Text) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Text) -> Text
forall a b. (a, b) -> b
snd [(Bool, Text)]
as)

pPageUnit :: LocatorParser (Bool, Text)
pPageUnit :: ParsecT [Inline] () Identity (Bool, Text)
pPageUnit = ParsecT [Inline] () Identity (Bool, Text)
roman ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
-> ParsecT [Inline] () Identity (Bool, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Inline] () Identity (Bool, Text)
plainUnit
  where
      -- roman is a 'digit'
      roman :: ParsecT [Inline] () Identity (Bool, Text)
roman = (Bool
True,) (Text -> (Bool, Text))
-> LocatorParser Text -> ParsecT [Inline] () Identity (Bool, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocatorParser Text
pRoman
      plainUnit :: ParsecT [Inline] () Identity (Bool, Text)
plainUnit = do
          [Inline]
ts <- ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity [Inline]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] () Identity Inline
pSpace ParsecT [Inline] () Identity ()
-> ParsecT [Inline] () Identity ()
-> ParsecT [Inline] () Identity ()
forall a b.
ParsecT [Inline] () Identity a
-> ParsecT [Inline] () Identity b -> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] () Identity Inline
pLocatorPunct ParsecT [Inline] () Identity ()
-> ParsecT [Inline] () Identity ()
-> ParsecT [Inline] () Identity ()
forall a b.
ParsecT [Inline] () Identity a
-> ParsecT [Inline] () Identity b -> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] () Identity Inline
pMath ParsecT [Inline] () Identity ()
-> ParsecT [Inline] () Identity Inline
-> ParsecT [Inline] () Identity Inline
forall a b.
ParsecT [Inline] () Identity a
-> ParsecT [Inline] () Identity b -> ParsecT [Inline] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       ParsecT [Inline] () Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken)
          let s :: Text
s = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ts
          -- otherwise look for actual digits or -s
          (Bool, Text) -> ParsecT [Inline] () Identity (Bool, Text)
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
s, Text
s)

pRoman :: LocatorParser Text
pRoman :: LocatorParser Text
pRoman = LocatorParser Text -> LocatorParser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LocatorParser Text -> LocatorParser Text)
-> LocatorParser Text -> LocatorParser Text
forall a b. (a -> b) -> a -> b
$ do
  Inline
tok <- ParsecT [Inline] () Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
  case Inline
tok of
       Str Text
t -> case Parsec Text () () -> String -> Text -> Either ParseError ()
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Bool -> ParsecT Text () Identity Int
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Bool -> ParsecT s st m Int
romanNumeral Bool
True ParsecT Text () Identity Int
-> Parsec Text () () -> Parsec Text () ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Text () ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
                   String
"roman numeral" (Text -> Text
T.toUpper Text
t) of
                      Left ParseError
_    -> LocatorParser Text
forall a. ParsecT [Inline] () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                      Right ()  -> Text -> LocatorParser Text
forall a. a -> ParsecT [Inline] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
       Inline
_      -> LocatorParser Text
forall a. ParsecT [Inline] () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

pLocatorPunct :: LocatorParser Inline
pLocatorPunct :: ParsecT [Inline] () Identity Inline
pLocatorPunct = String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar String
"punctuation" Char -> Bool
isLocatorPunct

pLocatorSep :: LocatorParser Inline
pLocatorSep :: ParsecT [Inline] () Identity Inline
pLocatorSep = String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar String
"locator separator" Char -> Bool
isLocatorSep

pMatchChar :: String -> (Char -> Bool) -> LocatorParser Inline
pMatchChar :: String -> (Char -> Bool) -> ParsecT [Inline] () Identity Inline
pMatchChar String
msg Char -> Bool
f = (Inline -> Bool) -> ParsecT [Inline] () Identity Inline
satisfyTok Inline -> Bool
f' ParsecT [Inline] () Identity Inline
-> String -> ParsecT [Inline] () Identity Inline
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
msg
    where
        f' :: Inline -> Bool
f' (Str (Text -> String
T.unpack -> [Char
c])) = Char -> Bool
f Char
c
        f' Inline
_                       = Bool
False

pSpace :: LocatorParser Inline
pSpace :: ParsecT [Inline] () Identity Inline
pSpace = (Inline -> Bool) -> ParsecT [Inline] () Identity Inline
satisfyTok (\Inline
t -> Inline -> Bool
isSpacey Inline
t Bool -> Bool -> Bool
|| Inline
t Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Inline
Str Text
"\160") ParsecT [Inline] () Identity Inline
-> String -> ParsecT [Inline] () Identity Inline
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"space"

pMath :: LocatorParser Inline
pMath :: ParsecT [Inline] () Identity Inline
pMath = (Inline -> Bool) -> ParsecT [Inline] () Identity Inline
satisfyTok Inline -> Bool
isMath
 where
  isMath :: Inline -> Bool
isMath (Math{}) = Bool
True
  isMath Inline
_ = Bool
False

satisfyTok :: (Inline -> Bool) -> LocatorParser Inline
satisfyTok :: (Inline -> Bool) -> ParsecT [Inline] () Identity Inline
satisfyTok Inline -> Bool
f = (Inline -> String)
-> (SourcePos -> Inline -> [Inline] -> SourcePos)
-> (Inline -> Maybe Inline)
-> ParsecT [Inline] () Identity Inline
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim Inline -> String
forall a. Show a => a -> String
show (\SourcePos
sp Inline
_ [Inline]
_ -> SourcePos
sp) (\Inline
tok -> if Inline -> Bool
f Inline
tok
                                                          then Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
tok
                                                          else Maybe Inline
forall a. Maybe a
Nothing)

isSpacey :: Inline -> Bool
isSpacey :: Inline -> Bool
isSpacey Inline
Space     = Bool
True
isSpacey Inline
SoftBreak = Bool
True
isSpacey Inline
_         = Bool
False

isLocatorPunct :: Char -> Bool
isLocatorPunct :: Char -> Bool
isLocatorPunct Char
'-' = Bool
False -- page range
isLocatorPunct Char
'–' = Bool
False -- page range, en dash
isLocatorPunct Char
':' = Bool
False -- vol:page-range hack
isLocatorPunct Char
c   = Char -> Bool
isPunctuation Char
c -- includes [{()}]

isLocatorSep :: Char -> Bool
isLocatorSep :: Char -> Bool
isLocatorSep Char
',' = Bool
True
isLocatorSep Char
';' = Bool
True
isLocatorSep Char
_   = Bool
False

--
-- Locator Map
--

newtype LocatorMap = LocatorMap { LocatorMap -> Map Text Text
unLocatorMap :: M.Map Text Text }
  deriving (Int -> LocatorMap -> ShowS
[LocatorMap] -> ShowS
LocatorMap -> String
(Int -> LocatorMap -> ShowS)
-> (LocatorMap -> String)
-> ([LocatorMap] -> ShowS)
-> Show LocatorMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocatorMap -> ShowS
showsPrec :: Int -> LocatorMap -> ShowS
$cshow :: LocatorMap -> String
show :: LocatorMap -> String
$cshowList :: [LocatorMap] -> ShowS
showList :: [LocatorMap] -> ShowS
Show)

toLocatorMap :: Locale -> LocatorMap
toLocatorMap :: Locale -> LocatorMap
toLocatorMap Locale
locale =
  Map Text Text -> LocatorMap
LocatorMap (Map Text Text -> LocatorMap) -> Map Text Text -> LocatorMap
forall a b. (a -> b) -> a -> b
$ (Text -> Map Text Text -> Map Text Text)
-> Map Text Text -> [Text] -> Map Text Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Map Text Text -> Map Text Text
go Map Text Text
forall a. Monoid a => a
mempty [Text]
locatorTerms
 where
  go :: Text -> Map Text Text -> Map Text Text
go Text
tname Map Text Text
locmap =
    case Text -> Map Text [(Term, Text)] -> Maybe [(Term, Text)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
tname (Locale -> Map Text [(Term, Text)]
localeTerms Locale
locale) of
      Maybe [(Term, Text)]
Nothing -> Map Text Text
locmap
      Just [(Term, Text)]
ts -> ((Term, Text) -> Map Text Text -> Map Text Text)
-> Map Text Text -> [(Term, Text)] -> Map Text Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Term, Text)
x -> Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text -> Text
T.toCaseFold (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Term, Text) -> Text
forall a b. (a, b) -> b
snd (Term, Text)
x) Text
tname) Map Text Text
locmap [(Term, Text)]
ts
-- we store keys in "case-folded" (lowercase) form, so that both
-- "Chap." and "chap." will match, for example.

locatorTerms :: [Text]
locatorTerms :: [Text]
locatorTerms =
  [ Text
"book"
  , Text
"chapter"
  , Text
"column"
  , Text
"figure"
  , Text
"folio"
  , Text
"issue"
  , Text
"line"
  , Text
"note"
  , Text
"opus"
  , Text
"page"
  , Text
"number-of-pages"
  , Text
"paragraph"
  , Text
"part"
  , Text
"section"
  , Text
"sub-verbo"
  , Text
"verse"
  , Text
"volume" ]