{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | This module defines a 'CiteprocOutput' instance for pandoc 'Inlines'.
module Citeproc.Pandoc
  ()
where
import Text.Pandoc.Definition
import Text.Pandoc.Builder as B
import Text.Pandoc.Walk
import qualified Data.Text as T
import qualified Data.Sequence as Seq
import Data.Text (Text)
import Citeproc.Types
import Citeproc.CaseTransform
import Control.Monad.Trans.State.Strict as S
import Control.Monad (unless, when)
import Citeproc.Locale (lookupQuotes)
import Data.Functor.Reverse
import Data.Char (isSpace, isPunctuation, isAlphaNum)

instance CiteprocOutput Inlines where
  toText :: Inlines -> Text
toText                = forall a. Walkable Inline a => a -> Text
stringify
  fromText :: Text -> Inlines
fromText Text
t            = (if Text
" " Text -> Text -> Bool
`T.isPrefixOf` Text
t
                              then Inlines
B.space
                              else forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<>
                          Text -> Inlines
B.text Text
t forall a. Semigroup a => a -> a -> a
<> -- B.text eats leading/trailing spaces
                          (if Text
" " Text -> Text -> Bool
`T.isSuffixOf` Text
t
                              then Inlines
B.space
                              else forall a. Monoid a => a
mempty)
  dropTextWhile :: (Char -> Bool) -> Inlines -> Inlines
dropTextWhile         = (Char -> Bool) -> Inlines -> Inlines
dropTextWhile'
  dropTextWhileEnd :: (Char -> Bool) -> Inlines -> Inlines
dropTextWhileEnd      = (Char -> Bool) -> Inlines -> Inlines
dropTextWhileEnd'
  addFontVariant :: FontVariant -> Inlines -> Inlines
addFontVariant FontVariant
x      =
    case FontVariant
x of
      FontVariant
NormalVariant    -> forall a. a -> a
id
      FontVariant
SmallCapsVariant -> Inlines -> Inlines
B.smallcaps
  addFontStyle :: FontStyle -> Inlines -> Inlines
addFontStyle FontStyle
x        =
    case FontStyle
x of
      FontStyle
NormalFont       -> forall a. a -> a
id
      FontStyle
ItalicFont       -> Inlines -> Inlines
B.emph
      FontStyle
ObliqueFont      -> Inlines -> Inlines
B.emph
  addFontWeight :: FontWeight -> Inlines -> Inlines
addFontWeight FontWeight
x       =
    case FontWeight
x of
      FontWeight
NormalWeight     -> forall a. a -> a
id
      FontWeight
LightWeight      -> forall a. a -> a
id
      FontWeight
BoldWeight       -> Inlines -> Inlines
B.strong
  addTextDecoration :: TextDecoration -> Inlines -> Inlines
addTextDecoration TextDecoration
x   =
    case TextDecoration
x of
      TextDecoration
NoDecoration        -> Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"nodecoration"],[])
      TextDecoration
UnderlineDecoration -> Inlines -> Inlines
B.underline
  addVerticalAlign :: VerticalAlign -> Inlines -> Inlines
addVerticalAlign VerticalAlign
x    =
    case VerticalAlign
x of
      VerticalAlign
BaselineAlign    -> forall a. a -> a
id
      VerticalAlign
SubAlign         -> Inlines -> Inlines
B.subscript
      VerticalAlign
SupAlign         -> Inlines -> Inlines
B.superscript
  addTextCase :: Maybe Lang -> TextCase -> Inlines -> Inlines
addTextCase Maybe Lang
mblang TextCase
x =
    case TextCase
x of
      TextCase
Lowercase        -> Maybe Lang -> CaseTransformer -> Inlines -> Inlines
caseTransform Maybe Lang
mblang CaseTransformer
withLowercaseAll
      TextCase
Uppercase        -> Maybe Lang -> CaseTransformer -> Inlines -> Inlines
caseTransform Maybe Lang
mblang CaseTransformer
withUppercaseAll
      TextCase
CapitalizeFirst  -> Maybe Lang -> CaseTransformer -> Inlines -> Inlines
caseTransform Maybe Lang
mblang CaseTransformer
withCapitalizeFirst
      TextCase
CapitalizeAll    -> Maybe Lang -> CaseTransformer -> Inlines -> Inlines
caseTransform Maybe Lang
mblang CaseTransformer
withCapitalizeWords
      TextCase
SentenceCase     -> Maybe Lang -> CaseTransformer -> Inlines -> Inlines
caseTransform Maybe Lang
mblang CaseTransformer
withSentenceCase
      TextCase
TitleCase        -> Maybe Lang -> CaseTransformer -> Inlines -> Inlines
caseTransform Maybe Lang
mblang CaseTransformer
withTitleCase
  addDisplay :: DisplayStyle -> Inlines -> Inlines
addDisplay DisplayStyle
x          =
    case DisplayStyle
x of
      DisplayStyle
DisplayBlock       -> Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"csl-block"],[])
      DisplayStyle
DisplayLeftMargin  -> Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"csl-left-margin"],[])
      DisplayStyle
DisplayRightInline -> Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"csl-right-inline"],[])
      DisplayStyle
DisplayIndent      -> Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"csl-indent"],[])
  addQuotes :: Inlines -> Inlines
addQuotes             = Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"csl-quoted"],[])
  inNote :: Inlines -> Inlines
inNote                = Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"csl-note"],[])
  movePunctuationInsideQuotes :: Inlines -> Inlines
movePunctuationInsideQuotes
                        = Inlines -> Inlines
punctuationInsideQuotes
  mapText :: (Text -> Text) -> Inlines -> Inlines
mapText Text -> Text
f             = forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
go
    where go :: Inline -> Inline
go (Str Text
t) = Text -> Inline
Str (Text -> Text
f Text
t)
          go Inline
x       = Inline
x
  addHyperlink :: Text -> Inlines -> Inlines
addHyperlink Text
t        = Text -> Text -> Inlines -> Inlines
B.link Text
t Text
""
  localizeQuotes :: Locale -> Inlines -> Inlines
localizeQuotes        = Locale -> Inlines -> Inlines
convertQuotes

-- localized quotes
convertQuotes :: Locale -> Inlines -> Inlines
convertQuotes :: Locale -> Inlines -> Inlines
convertQuotes Locale
locale = forall a. [a] -> Many a
B.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
DoubleQuote) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
B.toList
 where
  ((Text
oqOuter, Text
cqOuter), (Text
oqInner, Text
cqInner)) = Locale -> ((Text, Text), (Text, Text))
lookupQuotes Locale
locale

  oq :: QuoteType -> Text
oq QuoteType
DoubleQuote  = Text
oqOuter
  oq QuoteType
SingleQuote  = Text
oqInner
  cq :: QuoteType -> Text
cq QuoteType
DoubleQuote  = Text
cqOuter
  cq QuoteType
SingleQuote  = Text
cqInner

  flipflop :: QuoteType -> QuoteType
flipflop QuoteType
SingleQuote = QuoteType
DoubleQuote
  flipflop QuoteType
DoubleQuote = QuoteType
SingleQuote

  go :: QuoteType -> Inline -> Inline
  go :: QuoteType -> Inline -> Inline
go QuoteType
q (Span (Text
"",[Text
"csl-quoted"],[]) [Inline]
ils) =
    Attr -> [Inline] -> Inline
Span (Text
"",[Text
"csl-quoted"],[])
      (Text -> Inline
Str (QuoteType -> Text
oq QuoteType
q) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go (QuoteType -> QuoteType
flipflop QuoteType
q)) [Inline]
ils forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str (QuoteType -> Text
cq QuoteType
q)])
  go QuoteType
q (Span Attr
attr [Inline]
zs) = Attr -> [Inline] -> Inline
Span Attr
attr (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (Quoted QuoteType
qt' [Inline]
zs) = QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt' (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (SmallCaps [Inline]
zs) = [Inline] -> Inline
SmallCaps (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (Superscript [Inline]
zs) = [Inline] -> Inline
Superscript (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (Subscript [Inline]
zs) = [Inline] -> Inline
Subscript (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (Emph [Inline]
zs) = [Inline] -> Inline
Emph (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (Underline [Inline]
zs) = [Inline] -> Inline
Underline (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (Strong [Inline]
zs) = [Inline] -> Inline
Strong (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (Strikeout [Inline]
zs) = [Inline] -> Inline
Strikeout (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (Cite [Citation]
cs [Inline]
zs) = [Citation] -> [Inline] -> Inline
Cite [Citation]
cs (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs)
  go QuoteType
q (Link Attr
attr [Inline]
zs (Text, Text)
t) = Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs) (Text, Text)
t
  go QuoteType
q (Image Attr
attr [Inline]
zs (Text, Text)
t) = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr (forall a b. (a -> b) -> [a] -> [b]
map (QuoteType -> Inline -> Inline
go QuoteType
q) [Inline]
zs) (Text, Text)
t
  go QuoteType
_ Inline
x = Inline
x

punctuationInsideQuotes :: Inlines -> Inlines
punctuationInsideQuotes :: Inlines -> Inlines
punctuationInsideQuotes = forall a. [a] -> Many a
B.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
B.toList
 where
  startsWithMovable :: Text -> Bool
startsWithMovable Text
t =
    case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Just (Char
c,Text
_) -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
','
      Maybe (Char, Text)
Nothing    -> Bool
False
  go :: [Inline] -> [Inline]
go [] = []
  go (Span (Text
"",[Text
"csl-quoted"],[]) [Inline]
xs : Str Text
t : [Inline]
rest)
    | Text -> Bool
startsWithMovable Text
t
      = Attr -> [Inline] -> Inline
Span (Text
"",[Text
"csl-quoted"],[])
           ([Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str (Int -> Text -> Text
T.take Int
1 Text
t) | Bool -> Bool
not (Bool -> [Inline] -> Bool
endWithPunct Bool
True [Inline]
xs)]) forall a. a -> [a] -> [a]
:
        if Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
1
           then [Inline] -> [Inline]
go [Inline]
rest
           else Text -> Inline
Str (Int -> Text -> Text
T.drop Int
1 Text
t) forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
go [Inline]
rest
  go (Quoted QuoteType
qt [Inline]
xs : Str Text
t : [Inline]
rest)
    | Text -> Bool
startsWithMovable Text
t
      = QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt
           ([Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str (Int -> Text -> Text
T.take Int
1 Text
t) | Bool -> Bool
not (Bool -> [Inline] -> Bool
endWithPunct Bool
True [Inline]
xs)]) forall a. a -> [a] -> [a]
:
        if Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
1
           then [Inline] -> [Inline]
go [Inline]
rest
           else Text -> Inline
Str (Int -> Text -> Text
T.drop Int
1 Text
t) forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
go [Inline]
rest
  go (Inline
x:[Inline]
xs) = Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
go [Inline]
xs

endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct Bool
_ [] = Bool
False
endWithPunct Bool
onlyFinal xs :: [Inline]
xs@(Inline
_:[Inline]
_) =
  case forall a. [a] -> [a]
reverse (Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs) of
       []                       -> Bool
True
       -- covers .), .", etc.:
       (Char
d:Char
c:String
_) | Char -> Bool
isPunctuation Char
d
                 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onlyFinal
                 Bool -> Bool -> Bool
&& Char -> Bool
isEndPunct Char
c -> Bool
True
       (Char
c:String
_) | Char -> Bool
isEndPunct Char
c      -> Bool
True
             | Bool
otherwise         -> Bool
False
  where isEndPunct :: Char -> Bool
isEndPunct Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
".,;:!?" :: String)

dropTextWhile' :: (Char -> Bool) -> Inlines -> Inlines
dropTextWhile' :: (Char -> Bool) -> Inlines -> Inlines
dropTextWhile' Char -> Bool
f Inlines
ils = forall s a. State s a -> s -> a
evalState (forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM forall {m :: * -> *}. Monad m => Inline -> StateT Bool m Inline
go Inlines
ils) Bool
True
 where
  go :: Inline -> StateT Bool m Inline
go Inline
x = do
    Bool
atStart <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    if Bool
atStart
       then
         case Inline
x of
           Str Text
t -> do
             let t' :: Text
t' = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
f Text
t
             forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
t') forall a b. (a -> b) -> a -> b
$
               forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Bool
False
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
t'
           Inline
Space ->
             if Char -> Bool
f Char
' '
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
""
                else do
                  forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Bool
False
                  forall (m :: * -> *) a. Monad m => a -> m a
return Inline
Space
           Inline
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
       else forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x


dropTextWhileEnd' :: (Char -> Bool) -> Inlines -> Inlines
dropTextWhileEnd' :: (Char -> Bool) -> Inlines -> Inlines
dropTextWhileEnd' Char -> Bool
f Inlines
ils =
  forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> a
evalState (forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM forall {m :: * -> *}. Monad m => Inline -> StateT Bool m Inline
go forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse Inlines
ils) Bool
True
 where
  go :: Inline -> StateT Bool m Inline
go Inline
x = do
    Bool
atEnd <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    if Bool
atEnd
       then
         case Inline
x of
           Str Text
t -> do
             let t' :: Text
t' = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
f Text
t
             forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
t') forall a b. (a -> b) -> a -> b
$
               forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Bool
False
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
t'
           Inline
Space | Char -> Bool
f Char
' ' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
""
           Inline
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
       else forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

-- taken from Text.Pandoc.Shared:

-- | Convert pandoc structure to a string with formatting removed.
-- Footnotes are skipped (since we don't want their contents in link
-- labels).
stringify :: Walkable Inline a => a -> T.Text
stringify :: forall a. Walkable Inline a => a -> Text
stringify = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
unNote forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
unQuote)
 where
  go :: Inline -> T.Text
  go :: Inline -> Text
go Inline
Space                                       = Text
" "
  go Inline
SoftBreak                                   = Text
" "
  go (Str Text
x)                                     = Text
x
  go (Code Attr
_ Text
x)                                  = Text
x
  go (Math MathType
_ Text
x)                                  = Text
x
  go (RawInline (Format Text
"html") (Text -> String
T.unpack -> (Char
'<':Char
'b':Char
'r':String
_)))
                                                 = Text
" " -- see #2105
  go Inline
LineBreak                                   = Text
" "
  go Inline
_                                           = Text
""

  unNote :: Inline -> Inline
  unNote :: Inline -> Inline
unNote (Note [Block]
_) = Text -> Inline
Str Text
""
  unNote Inline
x        = Inline
x

  unQuote :: Inline -> Inline
  unQuote :: Inline -> Inline
unQuote (Quoted QuoteType
SingleQuote [Inline]
xs) =
    Attr -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
"\8216" forall a. a -> [a] -> [a]
: [Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8217"])
  unQuote (Quoted QuoteType
DoubleQuote [Inline]
xs) =
    Attr -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
"\8220" forall a. a -> [a] -> [a]
: [Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8221"])
  unQuote Inline
x = Inline
x


caseTransform :: Maybe Lang
              -> CaseTransformer
              -> Inlines
              -> Inlines
caseTransform :: Maybe Lang -> CaseTransformer -> Inlines -> Inlines
caseTransform Maybe Lang
mblang CaseTransformer
f Inlines
x =
  forall s a. State s a -> s -> a
evalState ((CaseTransformState -> Text -> Text)
-> Inlines -> State CaseTransformState Inlines
caseTransform' (CaseTransformer -> Maybe Lang -> CaseTransformState -> Text -> Text
unCaseTransformer CaseTransformer
f Maybe Lang
mblang) Inlines
x) CaseTransformState
Start


-- custom traversal which does not descend into
-- SmallCaps, Superscript, Subscript, Span "nocase" (implicit nocase)
caseTransform' :: (CaseTransformState -> Text -> Text)
               -> Inlines
               -> State CaseTransformState Inlines
caseTransform' :: (CaseTransformState -> Text -> Text)
-> Inlines -> State CaseTransformState Inlines
caseTransform' CaseTransformState -> Text -> Text
f Inlines
ils =
  case forall a. Seq a -> ViewR a
Seq.viewr (forall a. Many a -> Seq a
unMany Inlines
ils) of
    Seq Inline
xs Seq.:> Str Text
t | Bool -> Bool
not (forall a. Seq a -> Bool
Seq.null Seq Inline
xs)
                    , Bool -> Bool
not (Text -> Bool
hasWordBreak Text
t) -> do
        Seq Inline
xs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go Seq Inline
xs
        CaseTransformState
st <- forall (m :: * -> *) s. Monad m => StateT s m s
get
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CaseTransformState
st forall a. Eq a => a -> a -> Bool
== CaseTransformState
AfterWordEnd Bool -> Bool -> Bool
|| CaseTransformState
st forall a. Eq a => a -> a -> Bool
== CaseTransformState
StartSentence Bool -> Bool -> Bool
|| CaseTransformState
st forall a. Eq a => a -> a -> Bool
== CaseTransformState
Start) forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put CaseTransformState
BeforeLastWord
        Inline
x' <- Inline -> StateT CaseTransformState Identity Inline
go (Text -> Inline
Str Text
t)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Many a
Many forall a b. (a -> b) -> a -> b
$ Seq Inline
xs' forall a. Seq a -> a -> Seq a
Seq.|> Inline
x'
    ViewR Inline
_ -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go Inlines
ils
 where
  go :: Inline -> StateT CaseTransformState Identity Inline
go (Str Text
t) = Text -> Inline
Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> State CaseTransformState Text
g (Text -> [Text]
splitUp Text
t)
  go Inline
Space = Inline
Space forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> State CaseTransformState Text
g Text
" "
  go (SmallCaps [Inline]
zs) = forall {b}.
Walkable Inline b =>
b -> StateT CaseTransformState Identity b
return' forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
SmallCaps [Inline]
zs
  go (Superscript [Inline]
zs) = forall {b}.
Walkable Inline b =>
b -> StateT CaseTransformState Identity b
return' forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Superscript [Inline]
zs
  go (Subscript [Inline]
zs) = forall {b}.
Walkable Inline b =>
b -> StateT CaseTransformState Identity b
return' forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Subscript [Inline]
zs
  go (Span attr :: Attr
attr@(Text
_,[Text]
classes,[(Text, Text)]
_) [Inline]
zs)
      | Text
"nocase" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
            CaseTransformState
st <- forall (m :: * -> *) s. Monad m => StateT s m s
get
            case CaseTransformState
st of
              CaseTransformState
AfterWordChar | [Text]
classes forall a. Eq a => a -> a -> Bool
== [Text
"nocase"]
                   -- we need to apply g to update the state:
                -> forall {b}.
Walkable Inline b =>
b -> StateT CaseTransformState Identity b
return' forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span Attr
nullAttr [Inline]
zs
              CaseTransformState
_ -> forall {b}.
Walkable Inline b =>
b -> StateT CaseTransformState Identity b
return' forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span Attr
attr [Inline]
zs
      | Bool
otherwise = Attr -> [Inline] -> Inline
Span Attr
attr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go [Inline]
zs
  go (Emph [Inline]
zs) = [Inline] -> Inline
Emph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go [Inline]
zs
  go (Underline [Inline]
zs) = [Inline] -> Inline
Underline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go [Inline]
zs
  go (Strong [Inline]
zs) = [Inline] -> Inline
Strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go [Inline]
zs
  go (Strikeout [Inline]
zs) = [Inline] -> Inline
Strikeout forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go [Inline]
zs
  go (Quoted QuoteType
qt [Inline]
zs) = QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go [Inline]
zs
  go (Cite [Citation]
cs [Inline]
zs) = [Citation] -> [Inline] -> Inline
Cite [Citation]
cs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go [Inline]
zs
  go (Link Attr
attr [Inline]
zs (Text, Text)
t) = (\[Inline]
x -> Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
x (Text, Text)
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go [Inline]
zs
  go (Image Attr
attr [Inline]
zs (Text, Text)
t) = (\[Inline]
x -> Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
x (Text, Text)
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> StateT CaseTransformState Identity Inline
go [Inline]
zs
  go Inline
x = forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

  -- we need to apply g to update the state:
  return' :: b -> StateT CaseTransformState Identity b
return' b
x = b
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> State CaseTransformState Text
g (forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
fromStr b
x)

  fromStr :: Inline -> Text
fromStr (Str Text
t) = Text
t
  fromStr Inline
_ = forall a. Monoid a => a
mempty

  g :: Text -> State CaseTransformState Text
  g :: Text -> State CaseTransformState Text
g Text
t = do
    CaseTransformState
st <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall a b. (a -> b) -> a -> b
$ case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
            Maybe (Text, Char)
Nothing -> CaseTransformState
st
            Just (Text
_,Char
c)
              | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'?' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
':' ->
                CaseTransformState
AfterSentenceEndingPunctuation
              | Char -> Bool
isAlphaNum Char
c -> CaseTransformState
AfterWordChar
              | Char -> Bool
isSpace Char
c
              , CaseTransformState
st forall a. Eq a => a -> a -> Bool
== CaseTransformState
AfterSentenceEndingPunctuation -> CaseTransformState
StartSentence
              | Char -> Bool
isWordBreak Char
c -> CaseTransformState
AfterWordEnd
              | Bool
otherwise -> CaseTransformState
st
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
t
         then CaseTransformState -> Text -> Text
f CaseTransformState
st Text
t
         else Text
t
  isWordBreak :: Char -> Bool
isWordBreak Char
'-' = Bool
True
  isWordBreak Char
'/' = Bool
True
  isWordBreak Char
'\x2013' = Bool
True
  isWordBreak Char
'\x2014' = Bool
True
  isWordBreak Char
c = Char -> Bool
isSpace Char
c
  hasWordBreak :: Text -> Bool
hasWordBreak = (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isWordBreak
  splitUp :: Text -> [Text]
splitUp = (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy Char -> Char -> Bool
sameType
  sameType :: Char -> Char -> Bool
sameType Char
c Char
d =
    (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
d) Bool -> Bool -> Bool
|| (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Char -> Bool
isSpace Char
d) Bool -> Bool -> Bool
||
      (Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
&& Char -> Bool
isPunctuation Char
d)