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