{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ViewPatterns          #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards         #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE ScopedTypeVariables   #-}
module Text.CSL.Util
  ( safeRead
  , readNum
  , (<^>)
  , capitalize
  , camelize
  , uncamelize
  , isPunct
  , last'
  , init'
  , words'
  , trim
  , triml
  , trimr
  , parseBool
  , parseString
  , parseInt
  , parseMaybeInt
  , mb
  , (.#?)
  , (.#:)
  , onBlocks
  , titlecase
  , unTitlecase
  , protectCase
  , splitWhen
  , splitStrWhen
  , proc
  , proc'
  , procM
  , query
  , orIfNull
  , toRead
  , inlinesToString
  , headInline
  , lastInline
  , tailInline
  , initInline
  , tailFirstInlineStr
  , toCapital
  , mapHeadInline
  , tr'
  , findFile
  , AddYaml(..)
  , mapping'
  , parseRomanNumeral
  , isRange
  , addSpaceAfterPeriod
  ) where
import           Prelude
import           Control.Monad.State
import           Data.Aeson
import           Data.Aeson.Types    (Parser)
import           Data.Char           (isAscii, isLower, isPunctuation,
                                      isUpper, isLetter, toLower, toUpper)
import           Data.Generics       (Data, Typeable, everything, everywhere,
                                      everywhere', everywhereM, mkM, mkQ, mkT)
import           Data.List.Split     (wordsBy)
import qualified Data.Set            as Set
import           Data.Text           (Text)
import qualified Data.Text           as T
import qualified Data.Traversable
import           Data.Yaml.Builder   (ToYaml (..), YamlBuilder)
import qualified Data.Yaml.Builder   as Y
import           System.Directory    (doesFileExist)
import           System.FilePath
import           Text.Pandoc
import           Text.Pandoc.Shared  (safeRead, stringify)
import           Text.Pandoc.Walk    (walk)
import qualified Text.Parsec         as P

#ifdef TRACE
import qualified Debug.Trace
import           Text.Show.Pretty    (ppShow)
#endif

#ifdef TRACE
tr' :: Show a => String -> a -> a
tr' note' x = Debug.Trace.trace ("=== " ++ note' ++ "\n" ++ ppShow x ++ "\n") x
#else
tr' :: String -> a -> a
tr' :: String -> a -> a
tr' String
_ a
x = a
x
#endif

readNum :: Text -> Int
readNum :: Text -> Int
readNum Text
s = case ReadS Int
forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
s) of
              [(Int
x,String
"")] -> Int
x
              [(Int, String)]
_        -> Int
0

-- | Conjoin strings, avoiding repeated punctuation.
(<^>) :: Text -> Text -> Text
Text
"" <^> :: Text -> Text -> Text
<^> Text
sb = Text
sb
Text
sa <^> Text
"" = Text
sa
Text
sa <^> Text
sb = case (,) ((Text, Char) -> (Char, Text) -> ((Text, Char), (Char, Text)))
-> Maybe (Text, Char)
-> Maybe ((Char, Text) -> ((Text, Char), (Char, Text)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Text, Char)
T.unsnoc Text
sa Maybe ((Char, Text) -> ((Text, Char), (Char, Text)))
-> Maybe (Char, Text) -> Maybe ((Text, Char), (Char, Text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe (Char, Text)
T.uncons Text
sb of
  Just ((Text
_,Char
la), (Char
c,Text
xs)) | Char -> Bool
isPunct' Char
la Bool -> Bool -> Bool
&& Char -> Bool
isPunct' Char
c -> Text
sa Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xs
  Maybe ((Text, Char), (Char, Text))
_ -> Text
sa Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sb
 where isPunct' :: Char -> Bool
isPunct' = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
";:,. " :: String))

capitalize :: Text -> Text
capitalize :: Text -> Text
capitalize Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Maybe (Char, Text)
Nothing      -> Text
""
  Just (Char
c, Text
cs) -> Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
c) Text
cs

isPunct :: Char -> Bool
isPunct :: Char -> Bool
isPunct Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
".;?!" :: String)

camelize :: Text -> String
camelize :: Text -> String
camelize =
  let camelize' :: String -> String
camelize' String
t = case String
t of
        (Char
'-':Char
y:String
ys) -> Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelize' String
ys
        (Char
'_':Char
y:String
ys) -> Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelize' String
ys
        (Char
y:String
ys)     ->         Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelize' String
ys
        String
_          -> []
  in String -> String
camelize' (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

uncamelize :: String -> String
uncamelize :: String -> String
uncamelize = (Char -> String -> String) -> String -> String -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> String -> String
g [] (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
    where g :: Char -> String -> String
g    Char
x String
xs  = if Char -> Bool
isUpper Char
x then Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs else Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
          f :: String -> String
f (  Char
x:String
xs) = Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
          f       [] = []

last' :: [a] -> [a]
last' :: [a] -> [a]
last' [] = []
last' [a]
xs = [[a] -> a
forall a. [a] -> a
last [a]
xs]

init' :: [a] -> [a]
init' :: [a] -> [a]
init' [] = []
init' [a]
xs = [a] -> [a]
forall a. [a] -> [a]
init [a]
xs

-- | Like words, but doesn't break on nonbreaking spaces etc.
words' :: String -> [String]
words' :: String -> [String]
words' = (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (\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
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

-- | Remove leading and trailing space (including newlines) from string.
trim :: Text -> Text
trim :: Text -> Text
trim = (Char -> Bool) -> Text -> Text
T.dropAround Char -> Bool
isSpaceOrNewline

triml :: Text -> Text
triml :: Text -> Text
triml = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpaceOrNewline

trimr :: Text -> Text
trimr :: Text -> Text
trimr = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpaceOrNewline

isSpaceOrNewline :: Char -> Bool
isSpaceOrNewline :: Char -> Bool
isSpaceOrNewline Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \r\n\t" :: String)

-- | Parse JSON Boolean or Number as Bool.
parseBool :: Value -> Parser Bool
parseBool :: Value -> Parser Bool
parseBool (Bool Bool
b)   = Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
parseBool (Number Scientific
n) = case Value -> Result Int
forall a. FromJSON a => Value -> Result a
fromJSON (Scientific -> Value
Number Scientific
n) of
                            Success (Int
0 :: Int) -> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                            Success Int
_          -> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                            Error String
e            -> String -> Parser Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser Bool) -> String -> Parser Bool
forall a b. (a -> b) -> a -> b
$ String
"Could not read boolean: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
parseBool Value
_          = String -> Parser Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Could not read boolean"

-- | Parse JSON value as String.
parseString :: Value -> Parser Text
parseString :: Value -> Parser Text
parseString (String Text
s) = Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
parseString (Number Scientific
n) = case Value -> Result Int
forall a. FromJSON a => Value -> Result a
fromJSON (Scientific -> Value
Number Scientific
n) of
                            Success (Int
x :: Int) -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> (String -> Text) -> String -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x
                            Error String
_ -> case Value -> Result Double
forall a. FromJSON a => Value -> Result a
fromJSON (Scientific -> Value
Number Scientific
n) of
                              Success (Double
x :: Double) -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> (String -> Text) -> String -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x
                              Error String
e -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ String
"Could not read string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
parseString (Bool Bool
b)   = Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> (String -> Text) -> String -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
b
parseString v :: Value
v@(Array Array
_)= [Inline] -> Text
inlinesToString ([Inline] -> Text) -> Parser [Inline] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Value -> Parser [Inline]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
parseString Value
v          = String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ String
"Could not read as string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v

-- | Parse JSON value as Int.
parseInt :: Value -> Parser Int
parseInt :: Value -> Parser Int
parseInt (Number Scientific
n) = case Value -> Result Int
forall a. FromJSON a => Value -> Result a
fromJSON (Scientific -> Value
Number Scientific
n) of
                            Success (Int
x :: Int) -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
x
                            Error String
e -> String -> Parser Int
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser Int) -> String -> Parser Int
forall a b. (a -> b) -> a -> b
$ String
"Could not read Int: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
parseInt Value
x = Value -> Parser Text
parseString Value
x Parser Text -> (Text -> Parser Int) -> Parser Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
s ->
              case Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
s of
                   Just Int
n  -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Maybe Int
Nothing -> String -> Parser Int
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Could not read Int"

-- | Parse JSON value as Maybe Int.
parseMaybeInt :: Maybe Value -> Parser (Maybe Int)
parseMaybeInt :: Maybe Value -> Parser (Maybe Int)
parseMaybeInt Maybe Value
Nothing = Maybe Int -> Parser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
parseMaybeInt (Just (Number Scientific
n)) = case Value -> Result Int
forall a. FromJSON a => Value -> Result a
fromJSON (Scientific -> Value
Number Scientific
n) of
                                       Success (Int
x :: Int) -> Maybe Int -> Parser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x)
                                       Error String
e -> String -> Parser (Maybe Int)
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser (Maybe Int)) -> String -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ String
"Could not read Int: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
parseMaybeInt (Just Value
x) =
  Value -> Parser Text
parseString Value
x Parser Text -> (Text -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
s ->
                   if Text -> Bool
T.null Text
s
                      then Maybe Int -> Parser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
                      else case Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
s of
                                Just Int
n  -> Maybe Int -> Parser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
                                Maybe Int
Nothing -> String -> Parser (Maybe Int)
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser (Maybe Int)) -> String -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ String
"Could not read as Int: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
s

mb :: Monad m => (b -> m a) -> (Maybe b -> m (Maybe a))
mb :: (b -> m a) -> Maybe b -> m (Maybe a)
mb  = (b -> m a) -> Maybe b -> m (Maybe a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Data.Traversable.mapM

-- | Parse as a string (even if the value is a number).
(.#?) :: Object -> Text -> Parser (Maybe Text)
Object
x .#? :: Object -> Text -> Parser (Maybe Text)
.#? Text
y = (Object
x Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
y) Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Text)) -> Parser (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser Text) -> Maybe Value -> Parser (Maybe Text)
forall (m :: * -> *) b a.
Monad m =>
(b -> m a) -> Maybe b -> m (Maybe a)
mb Value -> Parser Text
parseString

(.#:) :: Object -> Text -> Parser Text
Object
x .#: :: Object -> Text -> Parser Text
.#: Text
y = (Object
x Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
y) Parser Value -> (Value -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Text
parseString

onBlocks :: ([Inline] -> [Inline]) -> [Block] -> [Block]
onBlocks :: ([Inline] -> [Inline]) -> [Block] -> [Block]
onBlocks [Inline] -> [Inline]
f = (Block -> Block) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
f'
  where f' :: Block -> Block
f' (Para [Inline]
ils)  = [Inline] -> Block
Para ([Inline] -> [Inline]
f [Inline]
ils)
        f' (Plain [Inline]
ils) = [Inline] -> Block
Plain ([Inline] -> [Inline]
f [Inline]
ils)
        f' Block
x           = Block
x

hasLowercaseWord :: [Inline] -> Bool
hasLowercaseWord :: [Inline] -> Bool
hasLowercaseWord = (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Inline -> Bool
startsWithLowercase ([Inline] -> Bool) -> ([Inline] -> [Inline]) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen Char -> Bool
isPunctuation
  where startsWithLowercase :: Inline -> Bool
startsWithLowercase (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
x,Text
_))) = Char -> Bool
isLower Char
x
        startsWithLowercase Inline
_           = Bool
False

splitUpStr :: [Inline] -> [Inline]
splitUpStr :: [Inline] -> [Inline]
splitUpStr [Inline]
ils =
  case [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline]
combineInternalPeriods
         ((Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (\Char
c -> Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\160') [Inline]
ils)) of
         []     -> []
         (Inline
x:[Inline]
xs) -> [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span (Text
"",[Text
"lastword"],[]) [Inline
x] Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs

-- We want to make sure that the periods in www.example.com, for
-- example, are not interpreted as sentence-ending punctuation.
combineInternalPeriods :: [Inline] -> [Inline]
combineInternalPeriods :: [Inline] -> [Inline]
combineInternalPeriods [] = []
combineInternalPeriods (Str Text
xs:Str Text
".":Str Text
ys:[Inline]
zs) =
  [Inline] -> [Inline]
combineInternalPeriods ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Text
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ys) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs
combineInternalPeriods (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combineInternalPeriods [Inline]
xs

unTitlecase :: [Inline] -> [Inline]
unTitlecase :: [Inline] -> [Inline]
unTitlecase [Inline]
zs = State CaseTransformState [Inline] -> CaseTransformState -> [Inline]
forall s a. State s a -> s -> a
evalState ((Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
forall (m :: * -> *).
MonadState CaseTransformState m =>
Inline -> m Inline
untc [Inline]
zs) CaseTransformState
SentenceBoundary
  where untc :: Inline -> m Inline
untc Inline
w = do
          CaseTransformState
st <- m CaseTransformState
forall s (m :: * -> *). MonadState s m => m s
get
          case (Inline
w, CaseTransformState
st) of
               (Inline
y, CaseTransformState
NoBoundary) -> Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
y
               (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
x,Text
xs)), CaseTransformState
LastWordBoundary) | Char -> Bool
isUpper Char
x ->
                 Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Text -> Text
T.toLower (Char -> Text -> Text
T.cons Char
x Text
xs))
               (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
x,Text
xs)), CaseTransformState
WordBoundary) | Char -> Bool
isUpper Char
x ->
                 Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Text -> Text
T.toLower (Char -> Text -> Text
T.cons Char
x Text
xs))
               (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
x,Text
xs)), CaseTransformState
SentenceBoundary) | Char -> Bool
isLower Char
x ->
                 Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
x) Text
xs)
               (Span (Text
"",[],[]) [Inline]
xs, CaseTransformState
_) | [Inline] -> Bool
hasLowercaseWord [Inline]
xs ->
                 Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span (Text
"",[Text
"nocase"],[]) [Inline]
xs
               (Inline, CaseTransformState)
_ -> Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
w

protectCase :: [Inline] -> [Inline]
protectCase :: [Inline] -> [Inline]
protectCase [Inline]
zs = State CaseTransformState [Inline] -> CaseTransformState -> [Inline]
forall s a. State s a -> s -> a
evalState ((Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
forall (m :: * -> *).
MonadState CaseTransformState m =>
Inline -> m Inline
protect [Inline]
zs) CaseTransformState
SentenceBoundary
  where protect :: Inline -> m Inline
protect (Span (Text
"",[],[]) [Inline]
xs)
          | [Inline] -> Bool
hasLowercaseWord [Inline]
xs = do
            CaseTransformState
st <- m CaseTransformState
forall s (m :: * -> *). MonadState s m => m s
get
            case CaseTransformState
st of
                 CaseTransformState
NoBoundary -> Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span (Text
"",[],[]) [Inline]
xs
                 CaseTransformState
_          -> Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span (Text
"",[Text
"nocase"],[]) [Inline]
xs
        protect Inline
x = Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

-- From CSL docs:
-- "Title case conversion (with text-case set to “title”) for English-language
-- items is performed by:
--
-- For uppercase strings, the first character of each word remains capitalized.
-- All other letters are lowercased.
-- For lower or mixed case strings, the first character of each lowercase word
-- is capitalized. The case of words in mixed or uppercase stays the same.
-- In both cases, stop words are lowercased, unless they are the first or last
-- word in the string, or follow a colon. The stop words are “a”, “an”, “and”,
-- “as”, “at”, “but”, “by”, “down”, “for”, “from”, “in”, “into”, “nor”, “of”,
-- “on”, “onto”, “or”, “over”, “so”, “the”, “till”, “to”, “up”, “via”, “with”,
-- and “yet”.
titlecase :: [Inline] -> [Inline]
titlecase :: [Inline] -> [Inline]
titlecase [Inline]
zs = State CaseTransformState [Inline] -> CaseTransformState -> [Inline]
forall s a. State s a -> s -> a
evalState ((Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
forall (m :: * -> *).
MonadState CaseTransformState m =>
Inline -> m Inline
tc [Inline]
zs) CaseTransformState
SentenceBoundary
  where tc :: Inline -> m Inline
tc (Str (Text -> String
T.unpack -> (Char
x:String
xs))) = do
          CaseTransformState
st <- m CaseTransformState
forall s (m :: * -> *). MonadState s m => m s
get
          Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ case CaseTransformState
st of
                        CaseTransformState
LastWordBoundary ->
                          case (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) of
                           String
s | Bool -> Bool
not (Char -> Bool
isAscii Char
x) -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
                             | String -> Bool
isShortWord String
s   -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
                             | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isUpperOrPunct String
s   -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
                             | String -> Bool
isMixedCase String
s   -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
                             | Bool
otherwise       -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Char -> Char
toUpper Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
                        CaseTransformState
WordBoundary ->
                          case (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) of
                           String
s | Bool -> Bool
not (Char -> Bool
isAscii Char
x) -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
                             | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isUpperOrPunct String
s   -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
                             | String -> Bool
isShortWord String
s   -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s)
                             | String -> Bool
isMixedCase String
s   -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
                             | Bool
otherwise       -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Char -> Char
toUpper Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
                        CaseTransformState
SentenceBoundary ->
                           if String -> Bool
isMixedCase (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) Bool -> Bool -> Bool
|| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isUpperOrPunct (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
                              then Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
                              else Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Char -> Char
toUpper Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs)
                        CaseTransformState
_ -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
        tc (Span (Text
"",[Text
"nocase"],[]) [Inline]
xs) = Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span (Text
"",[Text
"nocase"],[]) [Inline]
xs
        tc Inline
x = Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
        isShortWord :: String -> Bool
isShortWord  String
s = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
shortWords

shortWords :: Set.Set String
shortWords :: Set String
shortWords = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList
                 [String
"a",String
"an",String
"and",String
"as",String
"at",String
"but",String
"by",String
"c",String
"ca",String
"d",String
"de"
                 ,String
"down",String
"et",String
"for",String
"from"
                 ,String
"in",String
"into",String
"nor",String
"of",String
"on",String
"onto",String
"or",String
"over",String
"so"
                 ,String
"the",String
"till",String
"to",String
"up",String
"van",String
"von",String
"via",String
"with",String
"yet"]

isMixedCase :: String -> Bool
isMixedCase :: String -> Bool
isMixedCase String
xs = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isUpper String
xs Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isLower String
xs

isUpperOrPunct :: Char -> Bool
isUpperOrPunct :: Char -> Bool
isUpperOrPunct Char
c = Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c

data CaseTransformState = WordBoundary
                        | LastWordBoundary
                        | SentenceBoundary
                        | NoBoundary

caseTransform :: (Inline -> State CaseTransformState Inline) -> [Inline]
              -> State CaseTransformState [Inline]
caseTransform :: (Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
xform = ([Inline] -> [Inline])
-> State CaseTransformState [Inline]
-> State CaseTransformState [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Inline] -> [Inline]
forall a. [a] -> [a]
reverse (State CaseTransformState [Inline]
 -> State CaseTransformState [Inline])
-> ([Inline] -> State CaseTransformState [Inline])
-> [Inline]
-> State CaseTransformState [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> Inline -> State CaseTransformState [Inline])
-> [Inline] -> [Inline] -> State CaseTransformState [Inline]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [Inline] -> Inline -> State CaseTransformState [Inline]
go [] ([Inline] -> State CaseTransformState [Inline])
-> ([Inline] -> [Inline])
-> [Inline]
-> State CaseTransformState [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
splitUpStr
  where go :: [Inline] -> Inline -> State CaseTransformState [Inline]
go [Inline]
acc Inline
s | Inline
s Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
Space Bool -> Bool -> Bool
|| Inline
s Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
SoftBreak = do
               (CaseTransformState -> CaseTransformState)
-> StateT CaseTransformState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\CaseTransformState
st ->
                 case CaseTransformState
st of
                      CaseTransformState
SentenceBoundary -> CaseTransformState
SentenceBoundary
                      CaseTransformState
_                -> CaseTransformState
WordBoundary)
               [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> State CaseTransformState [Inline])
-> [Inline] -> State CaseTransformState [Inline]
forall a b. (a -> b) -> a -> b
$ Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
acc
        go [Inline]
acc Inline
LineBreak = do
               CaseTransformState -> StateT CaseTransformState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CaseTransformState
WordBoundary
               [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> State CaseTransformState [Inline])
-> [Inline] -> State CaseTransformState [Inline]
forall a b. (a -> b) -> a -> b
$ Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
acc
        go [Inline]
acc (Str (Text -> String
T.unpack -> [Char
c]))
          | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
".?!:" :: String) = do
               CaseTransformState -> StateT CaseTransformState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CaseTransformState
SentenceBoundary
               [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> State CaseTransformState [Inline])
-> [Inline] -> State CaseTransformState [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Char -> Text
T.singleton Char
c) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
acc
          | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"-/\x2013\x2014\160" :: String) = do
               CaseTransformState -> StateT CaseTransformState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CaseTransformState
WordBoundary
               [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> State CaseTransformState [Inline])
-> [Inline] -> State CaseTransformState [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Char -> Text
T.singleton Char
c) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
acc
          | Char -> Bool
isPunctuation Char
c = [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> State CaseTransformState [Inline])
-> [Inline] -> State CaseTransformState [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Char -> Text
T.singleton Char
c) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
acc -- leave state unchanged
        go [Inline]
acc (Str Text
"") = [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
acc
        go [Inline]
acc (Str Text
xs) = do
               Inline
res <- Inline -> State CaseTransformState Inline
xform (Text -> Inline
Str Text
xs)
               CaseTransformState -> StateT CaseTransformState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CaseTransformState
NoBoundary
               [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> State CaseTransformState [Inline])
-> [Inline] -> State CaseTransformState [Inline]
forall a b. (a -> b) -> a -> b
$ Inline
res Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
acc
        go [Inline]
acc (Span (Text
"",[Text
"lastword"],[]) [Inline
x]) = do
               CaseTransformState
b <- StateT CaseTransformState Identity CaseTransformState
forall s (m :: * -> *). MonadState s m => m s
get
               case CaseTransformState
b of
                    CaseTransformState
WordBoundary -> CaseTransformState -> StateT CaseTransformState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CaseTransformState
LastWordBoundary
                    CaseTransformState
_            -> () -> StateT CaseTransformState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               [Inline] -> Inline -> State CaseTransformState [Inline]
go [Inline]
acc Inline
x
        go [Inline]
acc (Span (Text
"",[Text]
classes,[]) [Inline]
xs)
          | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes Bool -> Bool -> Bool
|| [Text]
classes [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
"nocase"] = do
               Inline
res <- Inline -> State CaseTransformState Inline
xform (Attr -> [Inline] -> Inline
Span (Text
"",[Text]
classes,[]) [Inline]
xs)
               CaseTransformState -> StateT CaseTransformState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CaseTransformState
NoBoundary
               [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> State CaseTransformState [Inline])
-> [Inline] -> State CaseTransformState [Inline]
forall a b. (a -> b) -> a -> b
$ Inline
res Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
acc
        go [Inline]
acc (Quoted QuoteType
qt [Inline]
xs)    = (Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
acc) (Inline -> [Inline])
-> State CaseTransformState Inline
-> State CaseTransformState [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt ([Inline] -> Inline)
-> State CaseTransformState [Inline]
-> State CaseTransformState Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
xform [Inline]
xs)
        go [Inline]
acc (Emph [Inline]
xs)         = (Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
acc) (Inline -> [Inline])
-> State CaseTransformState Inline
-> State CaseTransformState [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> Inline
Emph ([Inline] -> Inline)
-> State CaseTransformState [Inline]
-> State CaseTransformState Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
xform [Inline]
xs)
        go [Inline]
acc (Strong [Inline]
xs)       = (Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
acc) (Inline -> [Inline])
-> State CaseTransformState Inline
-> State CaseTransformState [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> Inline
Strong ([Inline] -> Inline)
-> State CaseTransformState [Inline]
-> State CaseTransformState Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
xform [Inline]
xs)
        go [Inline]
acc (Link Attr
at [Inline]
xs (Text, Text)
t)    = (Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
acc) (Inline -> [Inline])
-> State CaseTransformState Inline
-> State CaseTransformState [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
at ([Inline] -> (Text, Text) -> Inline)
-> State CaseTransformState [Inline]
-> StateT CaseTransformState Identity ((Text, Text) -> Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
xform [Inline]
xs StateT CaseTransformState Identity ((Text, Text) -> Inline)
-> StateT CaseTransformState Identity (Text, Text)
-> State CaseTransformState Inline
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text, Text) -> StateT CaseTransformState Identity (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text, Text)
t)
        go [Inline]
acc (Image Attr
at [Inline]
xs (Text, Text)
t)   = (Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
acc) (Inline -> [Inline])
-> State CaseTransformState Inline
-> State CaseTransformState [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
at ([Inline] -> (Text, Text) -> Inline)
-> State CaseTransformState [Inline]
-> StateT CaseTransformState Identity ((Text, Text) -> Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
xform [Inline]
xs StateT CaseTransformState Identity ((Text, Text) -> Inline)
-> StateT CaseTransformState Identity (Text, Text)
-> State CaseTransformState Inline
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text, Text) -> StateT CaseTransformState Identity (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text, Text)
t)
        go [Inline]
acc (Span Attr
attr [Inline]
xs)    = (Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
acc) (Inline -> [Inline])
-> State CaseTransformState Inline
-> State CaseTransformState [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Attr -> [Inline] -> Inline
Span Attr
attr ([Inline] -> Inline)
-> State CaseTransformState [Inline]
-> State CaseTransformState Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> State CaseTransformState Inline)
-> [Inline] -> State CaseTransformState [Inline]
caseTransform Inline -> State CaseTransformState Inline
xform [Inline]
xs)
        go [Inline]
acc Inline
x                 = [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> State CaseTransformState [Inline])
-> [Inline] -> State CaseTransformState [Inline]
forall a b. (a -> b) -> a -> b
$ Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
acc

splitWhen :: (Char -> Bool) -> Text -> [Text]
splitWhen :: (Char -> Bool) -> Text -> [Text]
splitWhen Char -> Bool
f = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
f

splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen Char -> Bool
_ [] = []
splitStrWhen Char -> Bool
p (Str Text
xs : [Inline]
ys) = String -> [Inline]
go (Text -> String
T.unpack Text
xs) [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen Char -> Bool
p [Inline]
ys
  where go :: String -> [Inline]
go [] = []
        go String
s = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
s of
                     ([],[])     -> []
                     (String
zs,[])     -> [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
zs]
                     ([],Char
w:String
ws) -> Text -> Inline
Str (Char -> Text
T.singleton Char
w) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: String -> [Inline]
go String
ws
                     (String
zs,Char
w:String
ws) -> Text -> Inline
Str (String -> Text
T.pack String
zs) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str (Char -> Text
T.singleton Char
w) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: String -> [Inline]
go String
ws
splitStrWhen Char -> Bool
p (Inline
x : [Inline]
ys) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen Char -> Bool
p [Inline]
ys

-- | A generic processing function.
proc :: (Typeable a, Data b) => (a -> a) -> b -> b
proc :: (a -> a) -> b -> b
proc a -> a
f = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((a -> a) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT a -> a
f)

-- | A generic processing function: process a data structure in
-- top-down manner.
proc' :: (Typeable a, Data b) => (a -> a) -> b -> b
proc' :: (a -> a) -> b -> b
proc' a -> a
f = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere' ((a -> a) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT a -> a
f)

-- | A generic monadic processing function.
procM :: (Monad m, Typeable a, Data b) => (a -> m a) -> b -> m b
procM :: (a -> m a) -> b -> m b
procM a -> m a
f = GenericM m -> GenericM m
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((a -> m a) -> a -> m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM a -> m a
f)

-- | A generic query function.
query :: (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query :: (a -> m) -> b -> m
query a -> m
f = (m -> m -> m) -> GenericQ m -> GenericQ m
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (m
forall a. Monoid a => a
mempty m -> (a -> m) -> a -> m
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`mkQ` a -> m
f)

orIfNull :: [a] -> [a] -> [a]
orIfNull :: [a] -> [a] -> [a]
orIfNull [] [a]
b = [a]
b
orIfNull [a]
a  [a]
_ = [a]
a

toRead :: Text -> Text
toRead :: Text -> Text
toRead Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Maybe (Char, Text)
Nothing     -> Text
""
  Just (Char
s,Text
ss) -> Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
s) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
camel (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
ss
    where
      camel :: String -> String
camel String
x
          | Char
'-':Char
y:String
ys <- String
x = Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camel String
ys
          | Char
'_':Char
y:String
ys <- String
x = Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camel String
ys
          |     Char
y:String
ys <- String
x =         Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camel String
ys
          | Bool
otherwise     = []

inlinesToString :: [Inline] -> Text
inlinesToString :: [Inline] -> Text
inlinesToString = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify

headInline :: [Inline] -> Maybe Char
headInline :: [Inline] -> Maybe Char
headInline = ((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, Text) -> Char
forall a b. (a, b) -> a
fst (Maybe (Char, Text) -> Maybe Char)
-> ([Inline] -> Maybe (Char, Text)) -> [Inline] -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text))
-> ([Inline] -> Text) -> [Inline] -> Maybe (Char, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify

lastInline :: [Inline] -> Maybe Char
lastInline :: [Inline] -> Maybe Char
lastInline = ((Text, Char) -> Char) -> Maybe (Text, Char) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Char) -> Char
forall a b. (a, b) -> b
snd (Maybe (Text, Char) -> Maybe Char)
-> ([Inline] -> Maybe (Text, Char)) -> [Inline] -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Text, Char)
T.unsnoc (Text -> Maybe (Text, Char))
-> ([Inline] -> Text) -> [Inline] -> Maybe (Text, Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify

initInline :: [Inline] -> [Inline]
initInline :: [Inline] -> [Inline]
initInline [] = []
initInline [Inline
i]
    | Str          Text
s <- Inline
i
    , Bool -> Bool
not (Text -> Bool
T.null Text
s)      = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str         (Text -> Text
T.init      Text
s)
    | Emph        [Inline]
is <- Inline
i = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Emph        ([Inline] -> [Inline]
initInline [Inline]
is)
    | Strong      [Inline]
is <- Inline
i = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Strong      ([Inline] -> [Inline]
initInline [Inline]
is)
    | Superscript [Inline]
is <- Inline
i = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Superscript ([Inline] -> [Inline]
initInline [Inline]
is)
    | Subscript   [Inline]
is <- Inline
i = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Subscript   ([Inline] -> [Inline]
initInline [Inline]
is)
    | Quoted QuoteType
q    [Inline]
is <- Inline
i = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ QuoteType -> [Inline] -> Inline
Quoted QuoteType
q    ([Inline] -> [Inline]
initInline [Inline]
is)
    | SmallCaps   [Inline]
is <- Inline
i = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
SmallCaps   ([Inline] -> [Inline]
initInline [Inline]
is)
    | Strikeout   [Inline]
is <- Inline
i = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Strikeout   ([Inline] -> [Inline]
initInline [Inline]
is)
    | Link   Attr
at [Inline]
is (Text, Text)
t <- Inline
i = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
at     ([Inline] -> [Inline]
initInline [Inline]
is) (Text, Text)
t
    | Span Attr
at     [Inline]
is <- Inline
i = Inline -> [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span Attr
at     ([Inline] -> [Inline]
initInline [Inline]
is)
    | Bool
otherwise           = []
initInline (Inline
i:[Inline]
xs) = Inline
i Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
initInline [Inline]
xs

tailInline :: [Inline] -> [Inline]
tailInline :: [Inline] -> [Inline]
tailInline (Inline
Space:[Inline]
xs)     = [Inline]
xs
tailInline (Inline
SoftBreak:[Inline]
xs) = [Inline]
xs
tailInline [Inline]
xs             = [Inline] -> [Inline]
tailFirstInlineStr [Inline]
xs

tailFirstInlineStr :: [Inline] -> [Inline]
tailFirstInlineStr :: [Inline] -> [Inline]
tailFirstInlineStr = (Text -> Text) -> [Inline] -> [Inline]
mapHeadInline (Int -> Text -> Text
T.drop Int
1)

toCapital :: [Inline] -> [Inline]
toCapital :: [Inline] -> [Inline]
toCapital ils :: [Inline]
ils@(Span (Text
_,[Text
"nocase"],[(Text, Text)]
_) [Inline]
_:[Inline]
_) = [Inline]
ils
toCapital [Inline]
ils                             = (Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
capitalize [Inline]
ils

mapHeadInline :: (Text -> Text) -> [Inline] -> [Inline]
mapHeadInline :: (Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
_ [] = []
mapHeadInline Text -> Text
f (Inline
i:[Inline]
xs)
    | Str         Text
"" <- Inline
i =                      (Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
xs
    | Str          Text
s <- Inline
i = case Text -> Text
f Text
s of
                              Text
"" -> [Inline]
xs
                              Text
t  -> Text -> Inline
Str Text
t Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Emph        [Inline]
is <- Inline
i = [Inline] -> Inline
Emph        ((Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Strong      [Inline]
is <- Inline
i = [Inline] -> Inline
Strong      ((Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Superscript [Inline]
is <- Inline
i = [Inline] -> Inline
Superscript ((Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Subscript   [Inline]
is <- Inline
i = [Inline] -> Inline
Subscript   ((Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Quoted QuoteType
q    [Inline]
is <- Inline
i = QuoteType -> [Inline] -> Inline
Quoted QuoteType
q    ((Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | SmallCaps   [Inline]
is <- Inline
i = [Inline] -> Inline
SmallCaps   ((Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Strikeout   [Inline]
is <- Inline
i = [Inline] -> Inline
Strikeout   ((Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Link   Attr
at [Inline]
is (Text, Text)
t <- Inline
i = Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
at     ((Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
is) (Text, Text)
t    Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Span     Attr
at [Inline]
is <- Inline
i = Attr -> [Inline] -> Inline
Span Attr
at     ((Text -> Text) -> [Inline] -> [Inline]
mapHeadInline Text -> Text
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Bool
otherwise           = Inline
i Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs

findFile :: [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile :: [String] -> String -> IO (Maybe String)
findFile [] String
_ = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
findFile (String
p:[String]
ps) String
f
 | String -> Bool
isAbsolute String
f = do
     Bool
exists <- String -> IO Bool
doesFileExist String
f
     if Bool
exists
        then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
f)
        else Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
 | Bool
otherwise = do
     Bool
exists <- String -> IO Bool
doesFileExist (String
p String -> String -> String
</> String
f)
     if Bool
exists
        then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String
p String -> String -> String
</> String
f)
        else [String] -> String -> IO (Maybe String)
findFile [String]
ps String
f

class AddYaml a where
  (&=) :: Text -> a -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]

instance ToYaml a => AddYaml [a] where
  Text
x &= :: Text -> [a] -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
&= [a]
y = \[(Text, YamlBuilder)]
acc -> if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
y
                      then [(Text, YamlBuilder)]
acc
                      else (Text
x Text -> [a] -> (Text, YamlBuilder)
forall a. ToYaml a => Text -> a -> (Text, YamlBuilder)
Y..= [a]
y) (Text, YamlBuilder)
-> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
forall a. a -> [a] -> [a]
: [(Text, YamlBuilder)]
acc

instance ToYaml a => AddYaml (Maybe a) where
  Text
x &= :: Text -> Maybe a -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
&= Maybe a
y = \[(Text, YamlBuilder)]
acc -> case Maybe a
y of
                        Maybe a
Nothing -> [(Text, YamlBuilder)]
acc
                        Just a
z  -> (Text
x Text -> a -> (Text, YamlBuilder)
forall a. ToYaml a => Text -> a -> (Text, YamlBuilder)
Y..= a
z) (Text, YamlBuilder)
-> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
forall a. a -> [a] -> [a]
: [(Text, YamlBuilder)]
acc

instance AddYaml Text where
  Text
x &= :: Text -> Text -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
&= Text
y = \[(Text, YamlBuilder)]
acc -> if Text -> Bool
T.null Text
y
                      then [(Text, YamlBuilder)]
acc
                      else (Text
x Text -> Text -> (Text, YamlBuilder)
forall a. ToYaml a => Text -> a -> (Text, YamlBuilder)
Y..= Text
y) (Text, YamlBuilder)
-> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
forall a. a -> [a] -> [a]
: [(Text, YamlBuilder)]
acc

instance AddYaml Bool where
  Text
_ &= :: Text -> Bool -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
&= Bool
False = [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
forall a. a -> a
id
  Text
x &= Bool
True = \[(Text, YamlBuilder)]
acc -> (Text
x Text -> YamlBuilder -> (Text, YamlBuilder)
forall a. ToYaml a => Text -> a -> (Text, YamlBuilder)
Y..= Bool -> YamlBuilder
Y.bool Bool
True) (Text, YamlBuilder)
-> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
forall a. a -> [a] -> [a]
: [(Text, YamlBuilder)]
acc

mapping' :: [[(Text, YamlBuilder)] -> [(Text, YamlBuilder)]] -> YamlBuilder
mapping' :: [[(Text, YamlBuilder)] -> [(Text, YamlBuilder)]] -> YamlBuilder
mapping' = [(Text, YamlBuilder)] -> YamlBuilder
Y.mapping ([(Text, YamlBuilder)] -> YamlBuilder)
-> ([[(Text, YamlBuilder)] -> [(Text, YamlBuilder)]]
    -> [(Text, YamlBuilder)])
-> [[(Text, YamlBuilder)] -> [(Text, YamlBuilder)]]
-> YamlBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Text, YamlBuilder)] -> [(Text, YamlBuilder)])
 -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)])
-> [(Text, YamlBuilder)]
-> [[(Text, YamlBuilder)] -> [(Text, YamlBuilder)]]
-> [(Text, YamlBuilder)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([(Text, YamlBuilder)] -> [(Text, YamlBuilder)])
-> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
forall a b. (a -> b) -> a -> b
($) []

-- TODO: romanNumeral is defined in Text.Pandoc.Parsing, but it's
-- not exported there. Eventually we should remove this code duplication
-- by exporting something from pandoc.

parseRomanNumeral :: String -> Maybe Int
parseRomanNumeral :: String -> Maybe Int
parseRomanNumeral String
s = case Parsec String () Int -> String -> String -> Either ParseError Int
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse (Parsec String () Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pRomanNumeral Parsec String () Int
-> ParsecT String () Identity () -> Parsec String () Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof) String
"" String
s of
                           Left ParseError
_  -> Maybe Int
forall a. Maybe a
Nothing
                           Right Int
x -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x

-- | Parses a roman numeral (uppercase or lowercase), returns number.
pRomanNumeral :: P.Stream s m Char => P.ParsecT s st m Int
pRomanNumeral :: ParsecT s st m Int
pRomanNumeral = do
    let lowercaseRomanDigits :: String
lowercaseRomanDigits = [Char
'i',Char
'v',Char
'x',Char
'l',Char
'c',Char
'd',Char
'm']
    let uppercaseRomanDigits :: String
uppercaseRomanDigits = [Char
'I',Char
'V',Char
'X',Char
'L',Char
'C',Char
'D',Char
'M']
    Char
c <- 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
P.lookAhead (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
$ String -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf (String
lowercaseRomanDigits String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
uppercaseRomanDigits)
    let romanDigits :: String
romanDigits = if Char -> Bool
isUpper Char
c
                         then String
uppercaseRomanDigits
                         else String
lowercaseRomanDigits
    let [ParsecT s u m Char
one, ParsecT s u m Char
five, ParsecT s u m Char
ten, ParsecT s u m Char
fifty, ParsecT s u m Char
hundred, ParsecT s u m Char
fivehundred, ParsecT s u m Char
thousand] =
          (Char -> ParsecT s u m Char) -> String -> [ParsecT s u m Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char String
romanDigits
    Int
thousands <- ((Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (String -> Int) -> ParsecT s st m String -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT s st m Char
forall u. ParsecT s u m Char
thousand
    Int
ninehundreds <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
hundred ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
thousand ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
900
    Int
fivehundreds <- ((Int
500 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (String -> Int) -> ParsecT s st m String -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT s st m Char
forall u. ParsecT s u m Char
fivehundred
    Int
fourhundreds <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
hundred ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
fivehundred ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
400
    Int
hundreds <- ((Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (String -> Int) -> ParsecT s st m String -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT s st m Char
forall u. ParsecT s u m Char
hundred
    Int
nineties <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
ten ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
hundred ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
90
    Int
fifties <- ((Int
50 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (String -> Int) -> ParsecT s st m String -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT s st m Char
forall u. ParsecT s u m Char
fifty
    Int
forties <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
ten ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
fifty ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
40
    Int
tens <- ((Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (String -> Int) -> ParsecT s st m String -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT s st m Char
forall u. ParsecT s u m Char
ten
    Int
nines <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
one ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
ten ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
9
    Int
fives <- ((Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (String -> Int) -> ParsecT s st m String -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT s st m Char
forall u. ParsecT s u m Char
five
    Int
fours <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
one ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
five ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
    Int
ones <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ParsecT s st m String -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT s st m Char
forall u. ParsecT s u m Char
one
    let total :: Int
total = Int
thousands Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ninehundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fivehundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fourhundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                Int
hundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nineties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fifties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tens Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nines Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                Int
fives Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fours Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ones
    if Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
       then String -> ParsecT s st m Int
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"not a roman numeral"
       else Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
total

isRange :: Text -> Bool
isRange :: Text -> Bool
isRange = (Char -> Bool) -> Text -> Bool
T.any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
',', Char
'-', Char
'\x2013'])

-- see issue 392 for motivation.  We want to treat
-- "J.G. Smith" and "J. G. Smith" the same.
addSpaceAfterPeriod :: [Inline] -> [Inline]
addSpaceAfterPeriod :: [Inline] -> [Inline]
addSpaceAfterPeriod = [Inline] -> [Inline]
go ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.')
  where
    go :: [Inline] -> [Inline]
go [] = []
    go (Str (Text -> String
T.unpack -> [Char
c]):Str Text
".":Str (Text -> String
T.unpack -> [Char
d]):[Inline]
xs)
      | Char -> Bool
isLetter Char
d
      , Char -> Bool
isLetter Char
c
      , Char -> Bool
isUpper Char
c
      , Char -> Bool
isUpper Char
d   = Text -> Inline
Str (Char -> Text
T.singleton Char
c)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:Text -> Inline
Str Text
"."Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:Inline
SpaceInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline] -> [Inline]
go (Text -> Inline
Str (Char -> Text
T.singleton Char
d)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
xs)
    go (Inline
x:[Inline]
xs) = Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline] -> [Inline]
go [Inline]
xs