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

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

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

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

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

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

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

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


dropTextWhileEnd' :: (Char -> Bool) -> Inlines -> Inlines
dropTextWhileEnd' :: (Char -> Bool) -> Inlines -> Inlines
dropTextWhileEnd' f :: Char -> Bool
f ils :: Inlines
ils =
  Reverse Many Inline -> Inlines
forall k (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse (Reverse Many Inline -> Inlines) -> Reverse Many Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ State Bool (Reverse Many Inline) -> Bool -> Reverse Many Inline
forall s a. State s a -> s -> a
evalState ((Inline -> StateT Bool Identity Inline)
-> Reverse Many Inline -> State Bool (Reverse Many Inline)
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Inline -> StateT Bool Identity Inline
forall (m :: * -> *). Monad m => Inline -> StateT Bool m Inline
go (Reverse Many Inline -> State Bool (Reverse Many Inline))
-> Reverse Many Inline -> State Bool (Reverse Many Inline)
forall a b. (a -> b) -> a -> b
$ Inlines -> Reverse Many Inline
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse Inlines
ils) Bool
True
 where
  go :: Inline -> StateT Bool m Inline
go x :: Inline
x = do
    Bool
atEnd <- StateT Bool m Bool
forall (m :: * -> *) s. Monad m => StateT s m s
get
    if Bool
atEnd
       then
         case Inline
x of
           Str t :: Text
t -> do
             let t' :: Text
t' = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
f Text
t
             Bool -> StateT Bool m () -> StateT Bool m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
t') (StateT Bool m () -> StateT Bool m ())
-> StateT Bool m () -> StateT Bool m ()
forall a b. (a -> b) -> a -> b
$
               Bool -> StateT Bool m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Bool
False
             Inline -> StateT Bool m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT Bool m Inline) -> Inline -> StateT Bool m Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
t'
           Space | Char -> Bool
f ' ' -> Inline -> StateT Bool m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT Bool m Inline) -> Inline -> StateT Bool m Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str ""
           _ -> Inline -> StateT Bool m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
       else Inline -> StateT Bool m Inline
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 :: a -> Text
stringify = (Inline -> Text) -> a -> Text
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
go (a -> Text) -> (a -> a) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> a -> a
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
unNote (Inline -> Inline) -> (Inline -> Inline) -> Inline -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
unQuote)
 where
  go :: Inline -> T.Text
  go :: Inline -> Text
go Space                                       = " "
  go SoftBreak                                   = " "
  go (Str x :: Text
x)                                     = Text
x
  go (Code _ x :: Text
x)                                  = Text
x
  go (Math _ x :: Text
x)                                  = Text
x
  go (RawInline (Format "html") (Text -> [Char]
T.unpack -> ('<':'b':'r':_)))
                                                 = " " -- see #2105
  go LineBreak                                   = " "
  go _                                           = ""

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

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


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

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

  g :: Text -> State CaseTransformState Text
  g :: Text -> StateT CaseTransformState Identity Text
g t :: Text
t = do
    CaseTransformState
st <- StateT CaseTransformState Identity CaseTransformState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    CaseTransformState -> StateT CaseTransformState Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (CaseTransformState -> StateT CaseTransformState Identity ())
-> CaseTransformState -> StateT CaseTransformState Identity ()
forall a b. (a -> b) -> a -> b
$ case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
            Nothing -> CaseTransformState
st
            Just (_,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
== '?' Bool -> Bool -> Bool
|| 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
== ':' ->
                CaseTransformState
AfterSentenceEndingPunctuation
              | Char -> Bool
isAlphaNum Char
c -> CaseTransformState
AfterWordChar
              | Char -> Bool
isSpace Char
c
              , CaseTransformState
st CaseTransformState -> CaseTransformState -> Bool
forall a. Eq a => a -> a -> Bool
== CaseTransformState
AfterSentenceEndingPunctuation -> CaseTransformState
StartSentence
              | Char -> Bool
isWordBreak Char
c -> CaseTransformState
AfterWordEnd
              | Bool
otherwise -> CaseTransformState
st
    Text -> StateT CaseTransformState Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT CaseTransformState Identity Text)
-> Text -> StateT CaseTransformState Identity Text
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 '-' = Bool
True
  isWordBreak '/' = Bool
True
  isWordBreak '\x2013' = Bool
True
  isWordBreak '\x2014' = Bool
True
  isWordBreak c :: 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 c :: Char
c d :: 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)