{-# 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
  , 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' _ x :: a
x = a
x
#endif

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

-- | Conjoin strings, avoiding repeated punctuation.
(<^>) :: String -> String -> String
[] <^> :: String -> String -> String
<^> sb :: String
sb         = String
sb
sa :: String
sa <^> []         = String
sa
sa :: String
sa <^> (s :: Char
s:xs :: String
xs)
  | Char
s Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
puncts Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
sa Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
puncts = String
sa String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs
  where puncts :: String
puncts = ";:,. " :: String
sa :: String
sa <^> sb :: String
sb         = String
sa String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sb

capitalize :: String -> String
capitalize :: String -> String
capitalize []     = []
capitalize (c :: Char
c:cs :: String
cs) = Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs

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

camelize :: String -> String
camelize :: String -> String
camelize ('-':y :: Char
y:ys :: String
ys) = Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelize String
ys
camelize ('_':y :: Char
y:ys :: String
ys) = Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelize String
ys
camelize     (y :: Char
y:ys :: String
ys) =         Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelize String
ys
camelize      _     = []

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    x :: Char
x xs :: String
xs  = if Char -> Bool
isUpper Char
x then '-' 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 (  x :: Char
x:xs :: 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' xs :: [a]
xs = [[a] -> a
forall a. [a] -> a
last [a]
xs]

init' :: [a] -> [a]
init' :: [a] -> [a]
init' [] = []
init' xs :: [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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n')

-- | Remove leading and trailing space (including newlines) from string.
trim :: String -> String
trim :: String -> String
trim = String -> String
triml (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trimr

triml :: String -> String
triml :: String -> String
triml = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (" \r\n\t" :: String))

trimr :: String -> String
trimr :: String -> String
trimr = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
triml (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

-- | Parse JSON Boolean or Number as Bool.
parseBool :: Value -> Parser Bool
parseBool :: Value -> Parser Bool
parseBool (Bool b :: Bool
b)   = Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
parseBool (Number n :: 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 _          -> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                            Error e :: 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
$ "Could not read boolean: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
parseBool _          = String -> Parser Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "Could not read boolean"

-- | Parse JSON value as String.
parseString :: Value -> Parser String
parseString :: Value -> Parser String
parseString (String s :: Text
s) = String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
parseString (Number n :: Scientific
n) = case Value -> Result Int
forall a. FromJSON a => Value -> Result a
fromJSON (Scientific -> Value
Number Scientific
n) of
                            Success (Int
x :: Int) -> String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x
                            Error _ -> case Value -> Result Double
forall a. FromJSON a => Value -> Result a
fromJSON (Scientific -> Value
Number Scientific
n) of
                                            Success (Double
x :: Double) -> String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x
                                            Error e :: String
e -> String -> Parser String
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ "Could not read string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
parseString (Bool b :: Bool
b)   = String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
b
parseString v :: Value
v@(Array _)= [Inline] -> String
inlinesToString ([Inline] -> String) -> Parser [Inline] -> Parser String
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 v :: Value
v          = String -> Parser String
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ "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 n :: 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 e :: 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
$ "Could not read Int: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
parseInt x :: Value
x = Value -> Parser String
parseString Value
x Parser String -> (String -> Parser Int) -> Parser Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s :: String
s ->
              case Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (String -> Text
T.pack String
s) of
                   Just n :: Int
n  -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Nothing -> String -> Parser Int
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "Could not read Int"

-- | Parse JSON value as Maybe Int.
parseMaybeInt :: Maybe Value -> Parser (Maybe Int)
parseMaybeInt :: Maybe Value -> Parser (Maybe Int)
parseMaybeInt 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 n :: 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 e :: 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
$ "Could not read Int: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
parseMaybeInt (Just x :: Value
x) =
  Value -> Parser String
parseString Value
x Parser String
-> (String -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s :: String
s ->
                   if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
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 (String -> Text
T.pack String
s) of
                                Just n :: 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)
                                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
$ "Could not read as Int: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
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 String)
x :: Object
x .#? :: Object -> Text -> Parser (Maybe String)
.#? y :: 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 String)) -> Parser (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser String) -> Maybe Value -> Parser (Maybe String)
forall (m :: * -> *) b a.
Monad m =>
(b -> m a) -> Maybe b -> m (Maybe a)
mb Value -> Parser String
parseString

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

onBlocks :: ([Inline] -> [Inline]) -> [Block] -> [Block]
onBlocks :: ([Inline] -> [Inline]) -> [Block] -> [Block]
onBlocks f :: [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 ils :: [Inline]
ils)  = [Inline] -> Block
Para ([Inline] -> [Inline]
f [Inline]
ils)
        f' (Plain ils :: [Inline]
ils) = [Inline] -> Block
Plain ([Inline] -> [Inline]
f [Inline]
ils)
        f' x :: 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 (x :: Char
x,_))) = Char -> Bool
isLower Char
x
        startsWithLowercase _           = Bool
False

splitUpStr :: [Inline] -> [Inline]
splitUpStr :: [Inline] -> [Inline]
splitUpStr ils :: [Inline]
ils =
  case [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline]
combineInternalPeriods
         ((Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (\c :: Char
c -> Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\160') [Inline]
ils)) of
         []     -> []
         (x :: Inline
x:xs :: [Inline]
xs) -> [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span ("",["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 xs :: Text
xs:Str ".":Str ys :: Text
ys:zs :: [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
forall a. Semigroup a => a -> a -> a
<> Text
ys) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs
combineInternalPeriods (x :: Inline
x:xs :: [Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combineInternalPeriods [Inline]
xs

unTitlecase :: [Inline] -> [Inline]
unTitlecase :: [Inline] -> [Inline]
unTitlecase zs :: [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 w :: Inline
w = do
          CaseTransformState
st <- m CaseTransformState
forall s (m :: * -> *). MonadState s m => m s
get
          case (Inline
w, CaseTransformState
st) of
               (y :: Inline
y, NoBoundary) -> Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
y
               (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (x :: Char
x,xs :: Text
xs)), 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 (x :: Char
x,xs :: Text
xs)), 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 (x :: Char
x,xs :: Text
xs)), 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 ("",[],[]) xs :: [Inline]
xs, _) | [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 ("",["nocase"],[]) [Inline]
xs
               _ -> Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
w

protectCase :: [Inline] -> [Inline]
protectCase :: [Inline] -> [Inline]
protectCase zs :: [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 ("",[],[]) xs :: [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
                 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 ("",[],[]) [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 ("",["nocase"],[]) [Inline]
xs
        protect x :: 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 zs :: [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 -> (x :: Char
x:xs :: 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
                        LastWordBoundary ->
                          case (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) of
                           s :: 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)
                        WordBoundary ->
                          case (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) of
                           s :: 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)
                        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)
                        _ -> 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 ("",["nocase"],[]) xs :: [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 ("",["nocase"],[]) [Inline]
xs
        tc x :: Inline
x = Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
        isShortWord :: String -> Bool
isShortWord  s :: 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
                 ["a","an","and","as","at","but","by","c","ca","d","de"
                 ,"down","et","for","from"
                 ,"in","into","nor","of","on","onto","or","over","so"
                 ,"the","till","to","up","van","von","via","with","yet"]

isMixedCase :: String -> Bool
isMixedCase :: String -> Bool
isMixedCase xs :: 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 c :: 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 xform :: 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 acc :: [Inline]
acc s :: 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 (\st :: CaseTransformState
st ->
                 case CaseTransformState
st of
                      SentenceBoundary -> CaseTransformState
SentenceBoundary
                      _                -> 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 acc :: [Inline]
acc 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 acc :: [Inline]
acc (Str (Text -> String
T.unpack -> [c :: Char
c]))
          | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (".?!:" :: 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` ("-/\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 acc :: [Inline]
acc (Str "") = [Inline] -> State CaseTransformState [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
acc
        go acc :: [Inline]
acc (Str xs :: 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 acc :: [Inline]
acc (Span ("",["lastword"],[]) [x :: Inline
x]) = do
               CaseTransformState
b <- StateT CaseTransformState Identity CaseTransformState
forall s (m :: * -> *). MonadState s m => m s
get
               case CaseTransformState
b of
                    WordBoundary -> CaseTransformState -> StateT CaseTransformState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CaseTransformState
LastWordBoundary
                    _            -> () -> StateT CaseTransformState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               [Inline] -> Inline -> State CaseTransformState [Inline]
go [Inline]
acc Inline
x
        go acc :: [Inline]
acc (Span ("",classes :: [Text]
classes,[]) xs :: [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
== ["nocase"] = do
               Inline
res <- Inline -> State CaseTransformState Inline
xform (Attr -> [Inline] -> Inline
Span ("",[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 acc :: [Inline]
acc (Quoted qt :: QuoteType
qt xs :: [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 acc :: [Inline]
acc (Emph xs :: [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 acc :: [Inline]
acc (Strong xs :: [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 acc :: [Inline]
acc (Link at :: Attr
at xs :: [Inline]
xs t :: Target
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] -> Target -> Inline
Link Attr
at ([Inline] -> Target -> Inline)
-> State CaseTransformState [Inline]
-> StateT CaseTransformState Identity (Target -> 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 (Target -> Inline)
-> StateT CaseTransformState Identity Target
-> State CaseTransformState Inline
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Target -> StateT CaseTransformState Identity Target
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target
t)
        go acc :: [Inline]
acc (Image at :: Attr
at xs :: [Inline]
xs t :: Target
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] -> Target -> Inline
Link Attr
at ([Inline] -> Target -> Inline)
-> State CaseTransformState [Inline]
-> StateT CaseTransformState Identity (Target -> 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 (Target -> Inline)
-> StateT CaseTransformState Identity Target
-> State CaseTransformState Inline
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Target -> StateT CaseTransformState Identity Target
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target
t)
        go acc :: [Inline]
acc (Span attr :: Attr
attr xs :: [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 acc :: [Inline]
acc x :: 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

splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen _ [] = []
splitStrWhen p :: Char -> Bool
p (Str xs :: Text
xs : ys :: [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 s :: String
s = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
s of
                     ([],[])     -> []
                     (zs :: String
zs,[])     -> [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
zs]
                     ([],(w :: Char
w:ws :: String
ws)) -> Text -> Inline
Str (Char -> Text
T.singleton Char
w) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: String -> [Inline]
go String
ws
                     (zs :: String
zs,(w :: Char
w:ws :: 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 p :: Char -> Bool
p (x :: Inline
x : ys :: [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 f :: 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' f :: 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 f :: 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 f :: 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 [] b :: [a]
b = [a]
b
orIfNull a :: [a]
a  _ = [a]
a

toRead :: String -> String
toRead :: String -> String
toRead    []  = []
toRead (s :: Char
s:ss :: String
ss) = Char -> Char
toUpper Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camel String
ss
    where
      camel :: String -> String
camel x :: String
x
          | '-':y :: Char
y:ys :: String
ys <- String
x = Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camel String
ys
          | '_':y :: Char
y:ys :: String
ys <- String
x = Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camel String
ys
          |     y :: Char
y:ys :: String
ys <- String
x =         Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camel String
ys
          | Bool
otherwise     = []

inlinesToString :: [Inline] -> String
inlinesToString :: [Inline] -> String
inlinesToString = Text -> String
T.unpack (Text -> String) -> ([Inline] -> Text) -> [Inline] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify

headInline :: [Inline] -> String
headInline :: [Inline] -> String
headInline = Int -> String -> String
forall a. Int -> [a] -> [a]
take 1 (String -> String) -> ([Inline] -> String) -> [Inline] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> ([Inline] -> Text) -> [Inline] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify

lastInline :: [Inline] -> String
lastInline :: [Inline] -> String
lastInline xs :: [Inline]
xs = case Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs of
                      [] -> []
                      ys :: String
ys -> [String -> Char
forall a. [a] -> a
last String
ys]

initInline :: [Inline] -> [Inline]
initInline :: [Inline] -> [Inline]
initInline [] = []
initInline [i :: Inline
i]
    | Str          s :: 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        is :: [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      is :: [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 is :: [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   is :: [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 q :: QuoteType
q    is :: [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   is :: [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   is :: [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   at :: Attr
at is :: [Inline]
is t :: Target
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] -> Target -> Inline
Link Attr
at     ([Inline] -> [Inline]
initInline [Inline]
is) Target
t
    | Span at :: Attr
at     is :: [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 (i :: Inline
i:xs :: [Inline]
xs) = Inline
i Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
initInline [Inline]
xs

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

tailFirstInlineStr :: [Inline] -> [Inline]
tailFirstInlineStr :: [Inline] -> [Inline]
tailFirstInlineStr = (String -> String) -> [Inline] -> [Inline]
mapHeadInline (Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1)

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

mapHeadInline :: (String -> String) -> [Inline] -> [Inline]
mapHeadInline :: (String -> String) -> [Inline] -> [Inline]
mapHeadInline _ [] = []
mapHeadInline f :: String -> String
f (i :: Inline
i:xs :: [Inline]
xs)
    | Str         "" <- Inline
i =                      (String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
f [Inline]
xs
    | Str          s :: Text
s <- Inline
i = case String -> String
f (Text -> String
T.unpack Text
s) of
                              "" -> [Inline]
xs
                              _  -> Text -> Inline
Str (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
f (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Emph        is :: [Inline]
is <- Inline
i = [Inline] -> Inline
Emph        ((String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Strong      is :: [Inline]
is <- Inline
i = [Inline] -> Inline
Strong      ((String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Superscript is :: [Inline]
is <- Inline
i = [Inline] -> Inline
Superscript ((String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Subscript   is :: [Inline]
is <- Inline
i = [Inline] -> Inline
Subscript   ((String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Quoted q :: QuoteType
q    is :: [Inline]
is <- Inline
i = QuoteType -> [Inline] -> Inline
Quoted QuoteType
q    ((String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | SmallCaps   is :: [Inline]
is <- Inline
i = [Inline] -> Inline
SmallCaps   ((String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Strikeout   is :: [Inline]
is <- Inline
i = [Inline] -> Inline
Strikeout   ((String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
f [Inline]
is)      Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Link   at :: Attr
at is :: [Inline]
is t :: Target
t <- Inline
i = Attr -> [Inline] -> Target -> Inline
Link Attr
at     ((String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
f [Inline]
is) Target
t    Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
    | Span     at :: Attr
at is :: [Inline]
is <- Inline
i = Attr -> [Inline] -> Inline
Span Attr
at     ((String -> String) -> [Inline] -> [Inline]
mapHeadInline String -> String
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 [] _ = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
findFile (p :: String
p:ps :: [String]
ps) f :: 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
  x :: Text
x &= :: Text -> [a] -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
&= y :: [a]
y = \acc :: [(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
  x :: Text
x &= :: Text -> Maybe a -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
&= y :: Maybe a
y = \acc :: [(Text, YamlBuilder)]
acc -> case Maybe a
y of
                        Nothing -> [(Text, YamlBuilder)]
acc
                        Just z :: 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
  x :: Text
x &= :: Text -> Text -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
&= y :: Text
y = \acc :: [(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 -> Bool -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
&= False = [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
forall a. a -> a
id
  x :: Text
x &= True = \acc :: [(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 s :: 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
s of
                           Left _  -> Maybe Int
forall a. Maybe a
Nothing
                           Right x :: 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 = ['i','v','x','l','c','d','m']
    let uppercaseRomanDigits :: String
uppercaseRomanDigits = ['I','V','X','L','C','D','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 [one :: ParsecT s u m Char
one, five :: ParsecT s u m Char
five, ten :: ParsecT s u m Char
ten, fifty :: ParsecT s u m Char
fifty, hundred :: ParsecT s u m Char
hundred, fivehundred :: ParsecT s u m Char
fivehundred, thousand :: 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 <- ((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 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 900
    Int
fivehundreds <- ((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 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 400
    Int
hundreds <- ((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 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 90
    Int
fifties <- ((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 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 40
    Int
tens <- ((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 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 9
    Int
fives <- ((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 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 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
== 0
       then String -> ParsecT s st m Int
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "not a roman numeral"
       else Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
total

isRange :: String -> Bool
isRange :: String -> Bool
isRange s :: String
s = ',' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s Bool -> Bool -> Bool
|| '-' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s Bool -> Bool -> Bool
|| '\x2013' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s

-- 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
=='.')
  where
    go :: [Inline] -> [Inline]
go [] = []
    go (Str (Text -> String
T.unpack -> [c :: Char
c]):Str ".":Str (Text -> String
T.unpack -> [d :: Char
d]):xs :: [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 "."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 (x :: Inline
x:xs :: [Inline]
xs) = Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline] -> [Inline]
go [Inline]
xs