{-# 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
(<^>) :: 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
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')
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)
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"
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
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"
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
(.#?) :: 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
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
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
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
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)
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)
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)
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
($) []
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
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'])
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