{-# LANGUAGE StrictData #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveTraversable #-}
-- | CSL JSON is the structured text format defined in
-- <https://citeproc-js.readthedocs.io/en/latest/csl-json/markup.html>.
-- It is used to represent formatted text inside CSL JSON bibliographies.
-- For the most part it is a subset of HTML, with some special
-- features like smart quote parsing.  This module defines a parser
-- and a renderer for this format, as well as 'CiteprocOutput' and
-- other typeclass instances.
module Citeproc.CslJson
  ( CslJson(..)
  , cslJsonToJson
  , renderCslJson
  , parseCslJson
  )
where

--  represent and parse CSL JSON pseudo-html
--  https://citeproc-js.readthedocs.io/en/latest/csl-json/markup.html
--  Supported:
--  <i>italics</i>  -- will flip-flop
--  <b>bold</b>     -- will flip-flop
--  <span style="font-variant:small-caps;">...</span> -- ill flip-flop
--  <sup>..</sup>
--  <sub>..</sub>
--  <span class="nocase">..</span>  -- suppress case transformations


import Citeproc.Types
import Citeproc.Locale (lookupQuotes)
import Citeproc.CaseTransform
import Data.Ord ()
import Data.Char (isAlphaNum, isSpace, isAscii, isPunctuation)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Foldable (fold)
import Data.Functor.Identity
import Data.Attoparsec.Text as P
import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), object)
import Control.Monad.Trans.State
import Control.Monad (guard, when)
import Control.Applicative ((<|>))
import Data.Generics.Uniplate.Direct

data CslJson a =
     CslText a
   | CslEmpty
   | CslConcat (CslJson a) (CslJson a)
   | CslQuoted (CslJson a)
   | CslItalic (CslJson a)
   | CslNormal (CslJson a)
   | CslBold   (CslJson a)
   | CslUnderline (CslJson a)
   | CslNoDecoration (CslJson a)
   | CslSmallCaps (CslJson a)
   | CslBaseline  (CslJson a)
   | CslSup       (CslJson a)
   | CslSub       (CslJson a)
   | CslNoCase    (CslJson a)
   | CslDiv Text  (CslJson a)
   | CslLink Text (CslJson a)
  deriving (Int -> CslJson a -> ShowS
forall a. Show a => Int -> CslJson a -> ShowS
forall a. Show a => [CslJson a] -> ShowS
forall a. Show a => CslJson a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CslJson a] -> ShowS
$cshowList :: forall a. Show a => [CslJson a] -> ShowS
show :: CslJson a -> String
$cshow :: forall a. Show a => CslJson a -> String
showsPrec :: Int -> CslJson a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CslJson a -> ShowS
Show, CslJson a -> CslJson a -> Bool
forall a. Eq a => CslJson a -> CslJson a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CslJson a -> CslJson a -> Bool
$c/= :: forall a. Eq a => CslJson a -> CslJson a -> Bool
== :: CslJson a -> CslJson a -> Bool
$c== :: forall a. Eq a => CslJson a -> CslJson a -> Bool
Eq, CslJson a -> CslJson a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (CslJson a)
forall a. Ord a => CslJson a -> CslJson a -> Bool
forall a. Ord a => CslJson a -> CslJson a -> Ordering
forall a. Ord a => CslJson a -> CslJson a -> CslJson a
min :: CslJson a -> CslJson a -> CslJson a
$cmin :: forall a. Ord a => CslJson a -> CslJson a -> CslJson a
max :: CslJson a -> CslJson a -> CslJson a
$cmax :: forall a. Ord a => CslJson a -> CslJson a -> CslJson a
>= :: CslJson a -> CslJson a -> Bool
$c>= :: forall a. Ord a => CslJson a -> CslJson a -> Bool
> :: CslJson a -> CslJson a -> Bool
$c> :: forall a. Ord a => CslJson a -> CslJson a -> Bool
<= :: CslJson a -> CslJson a -> Bool
$c<= :: forall a. Ord a => CslJson a -> CslJson a -> Bool
< :: CslJson a -> CslJson a -> Bool
$c< :: forall a. Ord a => CslJson a -> CslJson a -> Bool
compare :: CslJson a -> CslJson a -> Ordering
$ccompare :: forall a. Ord a => CslJson a -> CslJson a -> Ordering
Ord, forall a b. a -> CslJson b -> CslJson a
forall a b. (a -> b) -> CslJson a -> CslJson b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CslJson b -> CslJson a
$c<$ :: forall a b. a -> CslJson b -> CslJson a
fmap :: forall a b. (a -> b) -> CslJson a -> CslJson b
$cfmap :: forall a b. (a -> b) -> CslJson a -> CslJson b
Functor, forall a. Eq a => a -> CslJson a -> Bool
forall a. Num a => CslJson a -> a
forall a. Ord a => CslJson a -> a
forall m. Monoid m => CslJson m -> m
forall a. CslJson a -> Bool
forall a. CslJson a -> Int
forall a. CslJson a -> [a]
forall a. (a -> a -> a) -> CslJson a -> a
forall m a. Monoid m => (a -> m) -> CslJson a -> m
forall b a. (b -> a -> b) -> b -> CslJson a -> b
forall a b. (a -> b -> b) -> b -> CslJson a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => CslJson a -> a
$cproduct :: forall a. Num a => CslJson a -> a
sum :: forall a. Num a => CslJson a -> a
$csum :: forall a. Num a => CslJson a -> a
minimum :: forall a. Ord a => CslJson a -> a
$cminimum :: forall a. Ord a => CslJson a -> a
maximum :: forall a. Ord a => CslJson a -> a
$cmaximum :: forall a. Ord a => CslJson a -> a
elem :: forall a. Eq a => a -> CslJson a -> Bool
$celem :: forall a. Eq a => a -> CslJson a -> Bool
length :: forall a. CslJson a -> Int
$clength :: forall a. CslJson a -> Int
null :: forall a. CslJson a -> Bool
$cnull :: forall a. CslJson a -> Bool
toList :: forall a. CslJson a -> [a]
$ctoList :: forall a. CslJson a -> [a]
foldl1 :: forall a. (a -> a -> a) -> CslJson a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CslJson a -> a
foldr1 :: forall a. (a -> a -> a) -> CslJson a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CslJson a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> CslJson a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CslJson a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CslJson a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CslJson a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CslJson a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CslJson a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CslJson a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CslJson a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> CslJson a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CslJson a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CslJson a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CslJson a -> m
fold :: forall m. Monoid m => CslJson m -> m
$cfold :: forall m. Monoid m => CslJson m -> m
Foldable, Functor CslJson
Foldable CslJson
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => CslJson (m a) -> m (CslJson a)
forall (f :: * -> *) a.
Applicative f =>
CslJson (f a) -> f (CslJson a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CslJson a -> m (CslJson b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CslJson a -> f (CslJson b)
sequence :: forall (m :: * -> *) a. Monad m => CslJson (m a) -> m (CslJson a)
$csequence :: forall (m :: * -> *) a. Monad m => CslJson (m a) -> m (CslJson a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CslJson a -> m (CslJson b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CslJson a -> m (CslJson b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CslJson (f a) -> f (CslJson a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CslJson (f a) -> f (CslJson a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CslJson a -> f (CslJson b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CslJson a -> f (CslJson b)
Traversable)

instance Semigroup (CslJson a) where
  (CslConcat CslJson a
x CslJson a
y) <> :: CslJson a -> CslJson a -> CslJson a
<> CslJson a
z = CslJson a
x forall a. Semigroup a => a -> a -> a
<> (CslJson a
y forall a. Semigroup a => a -> a -> a
<> CslJson a
z)
  CslJson a
CslEmpty <> CslJson a
x = CslJson a
x
  CslJson a
x <> CslJson a
CslEmpty = CslJson a
x
  CslJson a
x <> CslJson a
y = forall a. CslJson a -> CslJson a -> CslJson a
CslConcat CslJson a
x CslJson a
y

instance Monoid (CslJson a) where
  mempty :: CslJson a
mempty = forall a. CslJson a
CslEmpty
  mappend :: CslJson a -> CslJson a -> CslJson a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance FromJSON (CslJson Text) where
  parseJSON :: Value -> Parser (CslJson Text)
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Locale -> Text -> CslJson Text
parseCslJson forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON (CslJson Text) where
  toJSON :: CslJson Text -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Locale -> CslJson Text -> Text
renderCslJson Bool
False forall a. Monoid a => a
mempty

instance Uniplate (CslJson a) where
  uniplate :: CslJson a -> (Str (CslJson a), Str (CslJson a) -> CslJson a)
uniplate (CslText a
x)         = forall from to. from -> Type from to
plate forall a. a -> CslJson a
CslText forall item from to. Type (item -> from) to -> item -> Type from to
|- a
x
  uniplate (CslJson a
CslEmpty)          = forall from to. from -> Type from to
plate forall a. CslJson a
CslEmpty
  uniplate (CslConcat CslJson a
x CslJson a
y)     = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a -> CslJson a
CslConcat forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
y
  uniplate (CslQuoted CslJson a
x)       = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslQuoted forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslItalic CslJson a
x)       = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslItalic forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslNormal CslJson a
x)       = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslNormal forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslBold CslJson a
x)         = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslBold forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslUnderline CslJson a
x)    = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslUnderline forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslNoDecoration CslJson a
x) = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslNoDecoration forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslSmallCaps CslJson a
x)    = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslSmallCaps forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslBaseline CslJson a
x)     = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslBaseline forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslSup CslJson a
x)          = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslSup forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslSub CslJson a
x)          = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslSub forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslNoCase CslJson a
x)       = forall from to. from -> Type from to
plate forall a. CslJson a -> CslJson a
CslNoCase forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslDiv Text
t CslJson a
x)        = forall from to. from -> Type from to
plate forall a. Text -> CslJson a -> CslJson a
CslDiv forall item from to. Type (item -> from) to -> item -> Type from to
|- Text
t forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x
  uniplate (CslLink Text
t CslJson a
x)        = forall from to. from -> Type from to
plate forall a. Text -> CslJson a -> CslJson a
CslLink forall item from to. Type (item -> from) to -> item -> Type from to
|- Text
t forall to from. Type (to -> from) to -> to -> Type from to
|* CslJson a
x

instance Biplate (CslJson a) (CslJson a) where
  biplate :: CslJson a -> (Str (CslJson a), Str (CslJson a) -> CslJson a)
biplate = forall to. to -> Type to to
plateSelf

instance CiteprocOutput (CslJson Text) where
  toText :: CslJson Text -> Text
toText                = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
  fromText :: Text -> CslJson Text
fromText              = Locale -> Text -> CslJson Text
parseCslJson forall a. Monoid a => a
mempty
  dropTextWhile :: (Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhile         = (Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhile'
  dropTextWhileEnd :: (Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd      = (Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd'
  addFontVariant :: FontVariant -> CslJson Text -> CslJson Text
addFontVariant FontVariant
x      =
    case FontVariant
x of
      FontVariant
NormalVariant    -> forall a. a -> a
id
      FontVariant
SmallCapsVariant -> forall a. CslJson a -> CslJson a
CslSmallCaps
  addFontStyle :: FontStyle -> CslJson Text -> CslJson Text
addFontStyle FontStyle
x        =
    case FontStyle
x of
      FontStyle
NormalFont       -> forall a. CslJson a -> CslJson a
CslNormal
      FontStyle
ItalicFont       -> forall a. CslJson a -> CslJson a
CslItalic
      FontStyle
ObliqueFont      -> forall a. CslJson a -> CslJson a
CslItalic
  addFontWeight :: FontWeight -> CslJson Text -> CslJson Text
addFontWeight FontWeight
x       =
    case FontWeight
x of
      FontWeight
NormalWeight     -> forall a. a -> a
id
      FontWeight
LightWeight      -> forall a. a -> a
id
      FontWeight
BoldWeight       -> forall a. CslJson a -> CslJson a
CslBold
  addTextDecoration :: TextDecoration -> CslJson Text -> CslJson Text
addTextDecoration TextDecoration
x   =
    case TextDecoration
x of
      TextDecoration
NoDecoration        -> forall a. CslJson a -> CslJson a
CslNoDecoration
      TextDecoration
UnderlineDecoration -> forall a. CslJson a -> CslJson a
CslUnderline
  addVerticalAlign :: VerticalAlign -> CslJson Text -> CslJson Text
addVerticalAlign VerticalAlign
x    =
    case VerticalAlign
x of
      VerticalAlign
BaselineAlign    -> forall a. CslJson a -> CslJson a
CslBaseline
      VerticalAlign
SubAlign         -> forall a. CslJson a -> CslJson a
CslSub
      VerticalAlign
SupAlign         -> forall a. CslJson a -> CslJson a
CslSup
  addTextCase :: Maybe Lang -> TextCase -> CslJson Text -> CslJson Text
addTextCase Maybe Lang
mblang TextCase
x =
    case TextCase
x of
      TextCase
Lowercase        -> Maybe Lang -> CaseTransformer -> CslJson Text -> CslJson Text
caseTransform Maybe Lang
mblang CaseTransformer
withLowercaseAll
      TextCase
Uppercase        -> Maybe Lang -> CaseTransformer -> CslJson Text -> CslJson Text
caseTransform Maybe Lang
mblang CaseTransformer
withUppercaseAll
      TextCase
CapitalizeFirst  -> Maybe Lang -> CaseTransformer -> CslJson Text -> CslJson Text
caseTransform Maybe Lang
mblang CaseTransformer
withCapitalizeFirst
      TextCase
CapitalizeAll    -> Maybe Lang -> CaseTransformer -> CslJson Text -> CslJson Text
caseTransform Maybe Lang
mblang CaseTransformer
withCapitalizeWords
      TextCase
SentenceCase     -> Maybe Lang -> CaseTransformer -> CslJson Text -> CslJson Text
caseTransform Maybe Lang
mblang CaseTransformer
withSentenceCase
      TextCase
TitleCase        -> Maybe Lang -> CaseTransformer -> CslJson Text -> CslJson Text
caseTransform Maybe Lang
mblang CaseTransformer
withTitleCase
  addDisplay :: DisplayStyle -> CslJson Text -> CslJson Text
addDisplay DisplayStyle
x          =
    case DisplayStyle
x of
      DisplayStyle
DisplayBlock       -> forall a. Text -> CslJson a -> CslJson a
CslDiv Text
"block"
      DisplayStyle
DisplayLeftMargin  -> forall a. Text -> CslJson a -> CslJson a
CslDiv Text
"left-margin"
      DisplayStyle
DisplayRightInline -> forall a. Text -> CslJson a -> CslJson a
CslDiv Text
"right-inline"
      DisplayStyle
DisplayIndent      -> forall a. Text -> CslJson a -> CslJson a
CslDiv Text
"indent"
  addQuotes :: CslJson Text -> CslJson Text
addQuotes             = forall a. CslJson a -> CslJson a
CslQuoted
  inNote :: CslJson Text -> CslJson Text
inNote                = forall a. a -> a
id -- no-op
  movePunctuationInsideQuotes :: CslJson Text -> CslJson Text
movePunctuationInsideQuotes
                        = CslJson Text -> CslJson Text
punctuationInsideQuotes
  mapText :: (Text -> Text) -> CslJson Text -> CslJson Text
mapText Text -> Text
f             = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f)
  addHyperlink :: Text -> CslJson Text -> CslJson Text
addHyperlink Text
url CslJson Text
x    = forall a. Text -> CslJson a -> CslJson a
CslLink Text
url CslJson Text
x
  localizeQuotes :: Locale -> CslJson Text -> CslJson Text
localizeQuotes        = Locale -> CslJson Text -> CslJson Text
convertQuotes

dropTextWhile' :: (Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhile' :: (Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhile' Char -> Bool
f CslJson Text
x = forall s a. State s a -> s -> a
evalState (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}. Monad m => Text -> StateT Bool m Text
g CslJson Text
x) Bool
False
  where
   g :: Text -> StateT Bool m Text
g Text
t = do
     Bool
pastFirst <- forall (m :: * -> *) s. Monad m => StateT s m s
get
     if Bool
pastFirst
        then forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
        else do
          forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Bool
True
          forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
f Text
t)

dropTextWhileEnd' :: (Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' :: (Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
el =
  case CslJson Text
el of
     CslJson Text
CslEmpty -> forall a. CslJson a
CslEmpty
     CslText Text
t -> forall a. a -> CslJson a
CslText ((Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
f Text
t)
     CslConcat CslJson Text
x CslJson Text
y -> forall a. CslJson a -> CslJson a -> CslJson a
CslConcat CslJson Text
x ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
y)
     CslQuoted CslJson Text
x -> forall a. CslJson a -> CslJson a
CslQuoted ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslItalic CslJson Text
x -> forall a. CslJson a -> CslJson a
CslItalic ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslNormal CslJson Text
x -> forall a. CslJson a -> CslJson a
CslNormal ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslBold CslJson Text
x -> forall a. CslJson a -> CslJson a
CslBold ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslUnderline CslJson Text
x -> forall a. CslJson a -> CslJson a
CslUnderline ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslNoDecoration CslJson Text
x -> forall a. CslJson a -> CslJson a
CslNoDecoration ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslSmallCaps CslJson Text
x -> forall a. CslJson a -> CslJson a
CslSmallCaps ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslBaseline CslJson Text
x -> forall a. CslJson a -> CslJson a
CslBaseline ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslSub CslJson Text
x -> forall a. CslJson a -> CslJson a
CslSub ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslSup CslJson Text
x -> forall a. CslJson a -> CslJson a
CslSup ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslNoCase CslJson Text
x -> forall a. CslJson a -> CslJson a
CslNoCase ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslDiv Text
t CslJson Text
x -> forall a. Text -> CslJson a -> CslJson a
CslDiv Text
t ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)
     CslLink Text
t CslJson Text
x -> forall a. Text -> CslJson a -> CslJson a
CslLink Text
t ((Char -> Bool) -> CslJson Text -> CslJson Text
dropTextWhileEnd' Char -> Bool
f CslJson Text
x)

parseCslJson :: Locale -> Text -> CslJson Text
parseCslJson :: Locale -> Text -> CslJson Text
parseCslJson Locale
locale Text
t =
  case forall a. Parser a -> Text -> Either String a
P.parseOnly
         (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Locale -> Parser (CslJson Text)
pCslJson Locale
locale) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
P.endOfInput) Text
t of
    Left String
_   -> forall a. a -> CslJson a
CslText Text
t
    Right [CslJson Text]
xs -> forall a. Monoid a => [a] -> a
mconcat [CslJson Text]
xs

pCslJson :: Locale -> P.Parser (CslJson Text)
pCslJson :: Locale -> Parser (CslJson Text)
pCslJson Locale
locale = forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice
  [ Parser (CslJson Text)
pCslText
  , Parser (CslJson Text)
pCslQuoted
  , Parser (CslJson Text)
pCslItalic
  , Parser (CslJson Text)
pCslBold
  , Parser (CslJson Text)
pCslUnderline
  , Parser (CslJson Text)
pCslNoDecoration
  , Parser (CslJson Text)
pCslSmallCaps
  , Parser (CslJson Text)
pCslSup
  , Parser (CslJson Text)
pCslSub
  , Parser (CslJson Text)
pCslBaseline
  , Parser (CslJson Text)
pCslNoCase
  , Parser (CslJson Text)
pCslSymbol
  ]
 where
  ((Text
outerOpenQuote, Text
outerCloseQuote), (Text
innerOpenQuote, Text
innerCloseQuote)) =
     Locale -> ((Text, Text), (Text, Text))
lookupQuotes Locale
locale
  isSpecialChar :: Char -> Bool
isSpecialChar 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
'"' Bool -> Bool -> Bool
||
       Char
c forall a. Eq a => a -> a -> Bool
== Char
'’' Bool -> Bool -> Bool
|| (Bool -> Bool
not (Char -> Bool
isAscii Char
c) Bool -> Bool -> Bool
&& (Char -> Bool
isSuperscriptChar Char
c Bool -> Bool -> Bool
|| Char -> Bool
isQuoteChar Char
c))
  isQuoteChar :: Char -> Bool
isQuoteChar = String -> Char -> Bool
P.inClass
       (Text -> String
T.unpack (Text
outerOpenQuote forall a. Semigroup a => a -> a -> a
<> Text
outerCloseQuote forall a. Semigroup a => a -> a -> a
<>
                 Text
innerOpenQuote forall a. Semigroup a => a -> a -> a
<> Text
innerCloseQuote))
  isSuperscriptChar :: Char -> Bool
isSuperscriptChar = String -> Char -> Bool
P.inClass String
superscriptChars
  isApostrophe :: Char -> Bool
isApostrophe Char
'\'' = Bool
True
  isApostrophe Char
'’'  = Bool
True
  isApostrophe Char
_    = Bool
False
  pCsl :: Parser (CslJson Text)
pCsl = Locale -> Parser (CslJson Text)
pCslJson Locale
locale
  notFollowedBySpace :: Parser Text ()
notFollowedBySpace =
    Parser Char
P.peekChar' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpaceChar
  isSpaceChar :: Char -> Bool
isSpaceChar = String -> Char -> Bool
P.inClass [Char
' ',Char
'\t',Char
'\n',Char
'\r']
  pOpenQuote :: Parser Text Text
pOpenQuote = ((Text
"\"" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
P.char Char
'"')
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text
"'" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
P.char Char
'\'')
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text
outerCloseQuote forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
P.string Text
outerOpenQuote)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text
innerCloseQuote forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
P.string Text
innerOpenQuote))
                 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
notFollowedBySpace
  pSpace :: Parser Text ()
pSpace = (Char -> Bool) -> Parser Text ()
P.skipWhile Char -> Bool
isSpaceChar
  pCslText :: Parser (CslJson Text)
pCslText = forall a. a -> CslJson a
CslText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addNarrowSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (  do Text
t <- (Char -> Bool) -> Parser Text Text
P.takeWhile1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpecialChar Char
c))
          -- apostrophe
          forall (f :: * -> *) a. Alternative f => a -> f a -> f a
P.option Text
t forall a b. (a -> b) -> a -> b
$ do Char
_ <- (Char -> Bool) -> Parser Char
P.satisfy Char -> Bool
isApostrophe
                          Text
t' <- (Char -> Bool) -> Parser Text Text
P.takeWhile1 Char -> Bool
isAlphaNum
                          forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t forall a. Semigroup a => a -> a -> a
<> Text
"’" forall a. Semigroup a => a -> a -> a
<> Text
t')
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ((Char -> Bool) -> Parser Text Text
P.takeWhile1 (\Char
c -> Bool -> Bool
not (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpecialChar Char
c))) )
  pCslQuoted :: Parser (CslJson Text)
pCslQuoted = forall a. CslJson a -> CslJson a
CslQuoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    do Text
cl <- Parser Text Text
pOpenQuote
       Maybe Char
mbc <- Parser (Maybe Char)
peekChar
       case Maybe Char
mbc of
         Just Char
c  | Char -> Text
T.singleton Char
c forall a. Eq a => a -> a -> Bool
== Text
cl -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected close quote"
         Maybe Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
cl)
  pCslSymbol :: Parser (CslJson Text)
pCslSymbol = do
    Char
c <- (Char -> Bool) -> Parser Char
P.satisfy Char -> Bool
isSpecialChar
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
       if Char -> Bool
isApostrophe Char
c
          then forall a. a -> CslJson a
CslText Text
"’"
          else Char -> CslJson Text
charToSup Char
c
  pCslItalic :: Parser (CslJson Text)
pCslItalic = forall a. CslJson a -> CslJson a
CslItalic 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
<$>
    (Text -> Parser Text Text
P.string Text
"<i>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</i>"))
  pCslBold :: Parser (CslJson Text)
pCslBold = forall a. CslJson a -> CslJson a
CslBold 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
<$>
    (Text -> Parser Text Text
P.string Text
"<b>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</b>"))
  pCslUnderline :: Parser (CslJson Text)
pCslUnderline = forall a. CslJson a -> CslJson a
CslUnderline 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
<$>
    (Text -> Parser Text Text
P.string Text
"<u>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</u>"))
  pCslNoDecoration :: Parser (CslJson Text)
pCslNoDecoration = forall a. CslJson a -> CslJson a
CslNoDecoration 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
<$>
    (Text -> Parser Text Text
P.string Text
"<span" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
pSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
     Text -> Parser Text Text
P.string Text
"class=\"nodecor\"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
pSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
P.char Char
'>' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
     forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</span>"))
  pCslSup :: Parser (CslJson Text)
pCslSup = forall a. CslJson a -> CslJson a
CslSup 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
<$>
    (Text -> Parser Text Text
P.string Text
"<sup>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</sup>"))
  pCslSub :: Parser (CslJson Text)
pCslSub = forall a. CslJson a -> CslJson a
CslSub 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
<$>
    (Text -> Parser Text Text
P.string Text
"<sub>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</sub>"))
  pCslBaseline :: Parser (CslJson Text)
pCslBaseline = forall a. CslJson a -> CslJson a
CslBaseline 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
<$>
    (Text -> Parser Text Text
P.string Text
"<span" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
pSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
P.string Text
"style=\"baseline\">" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</span>"))
  pCslSmallCaps :: Parser (CslJson Text)
pCslSmallCaps = forall a. CslJson a -> CslJson a
CslSmallCaps 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
<$>
    ((Text -> Parser Text Text
P.string Text
"<span" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
pSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      Text -> Parser Text Text
P.string Text
"style=\"font-variant:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
pSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      Text -> Parser Text Text
P.string Text
"small-caps;" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
pSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
P.char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      Parser Text ()
pSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
P.char Char
'>' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</span>"))
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     (Text -> Parser Text Text
P.string Text
"<sc>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</sc>")))
  pCslNoCase :: Parser (CslJson Text)
pCslNoCase = forall a. CslJson a -> CslJson a
CslNoCase 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
<$>
    (Text -> Parser Text Text
P.string Text
"<span" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
pSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
     Text -> Parser Text Text
P.string Text
"class=\"nocase\"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
pSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
P.char Char
'>' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
     forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
P.manyTill' Parser (CslJson Text)
pCsl (Text -> Parser Text Text
P.string Text
"</span>"))
  addNarrowSpace :: Text -> Text
addNarrowSpace =
    Text -> Text -> Text -> Text
T.replace Text
" ;" Text
"\x202F;" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> Text -> Text
T.replace Text
" ?" Text
"\x202F?" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> Text -> Text
T.replace Text
" !" Text
"\x202F!" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> Text -> Text
T.replace Text
" »" Text
"\x202F»" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> Text -> Text
T.replace Text
"« " Text
"«\x202F"

data RenderContext =
  RenderContext
  { RenderContext -> Bool
useOuterQuotes  :: Bool
  , RenderContext -> Bool
useItalics      :: Bool
  , RenderContext -> Bool
useBold         :: Bool
  , RenderContext -> Bool
useSmallCaps    :: Bool
  } deriving (Int -> RenderContext -> ShowS
[RenderContext] -> ShowS
RenderContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderContext] -> ShowS
$cshowList :: [RenderContext] -> ShowS
show :: RenderContext -> String
$cshow :: RenderContext -> String
showsPrec :: Int -> RenderContext -> ShowS
$cshowsPrec :: Int -> RenderContext -> ShowS
Show, RenderContext -> RenderContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderContext -> RenderContext -> Bool
$c/= :: RenderContext -> RenderContext -> Bool
== :: RenderContext -> RenderContext -> Bool
$c== :: RenderContext -> RenderContext -> Bool
Eq)

-- | Render 'CslJson' as 'Text'.  Set the first parameter to True
-- when rendering HTML output (so that entities are escaped).
-- Set it to False when rendering for CSL JSON bibliographies.
renderCslJson :: Bool          -- ^ Escape < > & using entities
              -> Locale        -- ^ Locale (used for quote styles)
              -> CslJson Text  -- ^ CslJson to render
              -> Text
renderCslJson :: Bool -> Locale -> CslJson Text -> Text
renderCslJson Bool
useEntities Locale
locale =
  RenderContext -> CslJson Text -> Text
go (Bool -> Bool -> Bool -> Bool -> RenderContext
RenderContext Bool
True Bool
True Bool
True Bool
True)
 where
  ((Text, Text)
outerQuotes, (Text, Text)
innerQuotes) = Locale -> ((Text, Text), (Text, Text))
lookupQuotes Locale
locale
  go :: RenderContext -> CslJson Text -> Text
  go :: RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
el =
    case CslJson Text
el of
      CslText Text
t -> Text -> Text
escape Text
t
      CslJson Text
CslEmpty -> forall a. Monoid a => a
mempty
      CslConcat CslJson Text
x CslJson Text
y -> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
y
      CslQuoted CslJson Text
x
        | RenderContext -> Bool
useOuterQuotes RenderContext
ctx
          -> forall a b. (a, b) -> a
fst (Text, Text)
outerQuotes forall a. Semigroup a => a -> a -> a
<>
             RenderContext -> CslJson Text -> Text
go RenderContext
ctx{ useOuterQuotes :: Bool
useOuterQuotes = Bool
False } CslJson Text
x forall a. Semigroup a => a -> a -> a
<>
             forall a b. (a, b) -> b
snd (Text, Text)
outerQuotes
        | Bool
otherwise
          -> forall a b. (a, b) -> a
fst (Text, Text)
innerQuotes forall a. Semigroup a => a -> a -> a
<>
             RenderContext -> CslJson Text -> Text
go RenderContext
ctx{ useOuterQuotes :: Bool
useOuterQuotes = Bool
True } CslJson Text
x forall a. Semigroup a => a -> a -> a
<>
             forall a b. (a, b) -> b
snd (Text, Text)
innerQuotes
      CslNormal CslJson Text
x
        | RenderContext -> Bool
useItalics RenderContext
ctx -> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x
        | Bool
otherwise      -> Text
"<span style=\"font-style:normal;\">" forall a. Semigroup a => a -> a -> a
<>
                              RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</span>"
      CslItalic CslJson Text
x
        | RenderContext -> Bool
useItalics RenderContext
ctx -> Text
"<i>" forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx{ useItalics :: Bool
useItalics = Bool
False } CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</i>"
        | Bool
otherwise -> Text
"<span style=\"font-style:normal;\">" forall a. Semigroup a => a -> a -> a
<>
                          RenderContext -> CslJson Text -> Text
go RenderContext
ctx{ useItalics :: Bool
useItalics = Bool
True } CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</span>"
      CslBold CslJson Text
x
        | RenderContext -> Bool
useBold RenderContext
ctx -> Text
"<b>" forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx{ useBold :: Bool
useBold = Bool
False } CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</b>"
        | Bool
otherwise -> Text
"<span style=\"font-weight:normal;\">" forall a. Semigroup a => a -> a -> a
<>
                          RenderContext -> CslJson Text -> Text
go RenderContext
ctx{ useBold :: Bool
useBold = Bool
True } CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</span>"
      CslUnderline CslJson Text
x -> Text
"<u>" forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</u>"
      CslNoDecoration CslJson Text
x -> Text
"<span style=\"" forall a. Semigroup a => a -> a -> a
<>
                           (if RenderContext -> Bool
useSmallCaps RenderContext
ctx
                               then Text
""
                               else Text
"font-variant:normal;") forall a. Semigroup a => a -> a -> a
<>
                           (if RenderContext -> Bool
useBold RenderContext
ctx
                               then Text
""
                               else Text
"font-weight:normal;") forall a. Semigroup a => a -> a -> a
<>
                           (if RenderContext -> Bool
useItalics RenderContext
ctx
                               then Text
""
                               else Text
"font-style:normal;") forall a. Semigroup a => a -> a -> a
<>
                           Text
"\">" forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</span>"
      CslSmallCaps CslJson Text
x
        | RenderContext -> Bool
useSmallCaps RenderContext
ctx -> Text
"<span style=\"font-variant:small-caps;\">"
                                forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx{ useSmallCaps :: Bool
useSmallCaps = Bool
False } CslJson Text
x forall a. Semigroup a => a -> a -> a
<>
                                Text
"</span>"
        | Bool
otherwise -> Text
"<span style=\"font-variant:normal;\">" forall a. Semigroup a => a -> a -> a
<>
                          RenderContext -> CslJson Text -> Text
go RenderContext
ctx{ useSmallCaps :: Bool
useSmallCaps = Bool
True } CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</span>"
      CslSup CslJson Text
x -> Text
"<sup>" forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</sup>"
      CslSub CslJson Text
x -> Text
"<sub>" forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</sub>"
      CslBaseline CslJson Text
x -> Text
"<span style=\"baseline\">" forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</span>"
      CslDiv Text
t CslJson Text
x -> Text
"<div class=\"csl-" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\">" forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</div>"
      CslLink Text
t CslJson Text
x -> Text
"<a href=\"" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\">" forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</a>"
      CslNoCase CslJson Text
x -> RenderContext -> CslJson Text -> Text
go RenderContext
ctx CslJson Text
x -- nocase is just for internal purposes
  escape :: Text -> Text
escape Text
t
    | Bool
useEntities
      = case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (\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
'&') Text
t of
               Just Int
_ -> Text -> Text -> Text -> Text
T.replace Text
"<" Text
"&#60;" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         Text -> Text -> Text -> Text
T.replace Text
">" Text
"&#62;" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         Text -> Text -> Text -> Text
T.replace Text
"&" Text
"&#38;" forall a b. (a -> b) -> a -> b
$ Text
t
               Maybe Int
Nothing -> Text
t
    | Bool
otherwise = Text
t

-- localized quotes
convertQuotes :: Locale -> CslJson Text -> CslJson Text
convertQuotes :: Locale -> CslJson Text -> CslJson Text
convertQuotes Locale
locale = Bool -> CslJson Text -> CslJson Text
go Bool
True
 where
  ((Text, Text)
outerQuotes, (Text, Text)
innerQuotes) = Locale -> ((Text, Text), (Text, Text))
lookupQuotes Locale
locale

  go :: Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
el =
    case CslJson Text
el of
      CslConcat CslJson Text
x CslJson Text
y -> Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x forall a. Semigroup a => a -> a -> a
<> Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
y
      CslQuoted CslJson Text
x
        | Bool
useOuter
          -> forall a. a -> CslJson a
CslText (forall a b. (a, b) -> a
fst (Text, Text)
outerQuotes) forall a. Semigroup a => a -> a -> a
<>
             Bool -> CslJson Text -> CslJson Text
go (Bool -> Bool
not Bool
useOuter) CslJson Text
x forall a. Semigroup a => a -> a -> a
<>
             forall a. a -> CslJson a
CslText (forall a b. (a, b) -> b
snd (Text, Text)
outerQuotes)
        | Bool
otherwise
          -> forall a. a -> CslJson a
CslText (forall a b. (a, b) -> a
fst (Text, Text)
innerQuotes) forall a. Semigroup a => a -> a -> a
<>
             Bool -> CslJson Text -> CslJson Text
go (Bool -> Bool
not Bool
useOuter) CslJson Text
x forall a. Semigroup a => a -> a -> a
<>
             forall a. a -> CslJson a
CslText (forall a b. (a, b) -> b
snd (Text, Text)
innerQuotes)
      CslNormal CslJson Text
x -> forall a. CslJson a -> CslJson a
CslNormal forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslItalic CslJson Text
x -> forall a. CslJson a -> CslJson a
CslItalic forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslBold CslJson Text
x -> forall a. CslJson a -> CslJson a
CslBold forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslUnderline CslJson Text
x -> forall a. CslJson a -> CslJson a
CslUnderline forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslNoDecoration CslJson Text
x -> forall a. CslJson a -> CslJson a
CslNoDecoration forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslSmallCaps CslJson Text
x -> forall a. CslJson a -> CslJson a
CslSmallCaps forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslSup CslJson Text
x -> forall a. CslJson a -> CslJson a
CslSup forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslSub CslJson Text
x -> forall a. CslJson a -> CslJson a
CslSub forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslBaseline CslJson Text
x -> forall a. CslJson a -> CslJson a
CslBaseline forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslDiv Text
t CslJson Text
x -> forall a. Text -> CslJson a -> CslJson a
CslDiv Text
t forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslNoCase CslJson Text
x -> forall a. CslJson a -> CslJson a
CslNoCase forall a b. (a -> b) -> a -> b
$ Bool -> CslJson Text -> CslJson Text
go Bool
useOuter CslJson Text
x
      CslJson Text
x -> CslJson Text
x


cslJsonToJson :: CslJson Text -> [Value]
cslJsonToJson :: CslJson Text -> [Value]
cslJsonToJson = RenderContext -> CslJson Text -> [Value]
go (Bool -> Bool -> Bool -> Bool -> RenderContext
RenderContext Bool
True Bool
True Bool
True Bool
True)
 where
  isString :: Value -> Bool
isString (String Text
_) = Bool
True
  isString Value
_ = Bool
False
  consolidateStrings :: [Value] -> [Value]
  consolidateStrings :: [Value] -> [Value]
consolidateStrings [] = []
  consolidateStrings (String Text
t : [Value]
rest) =
    let ([Value]
xs,[Value]
ys) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Value -> Bool
isString [Value]
rest
     in Text -> Value
String (Text
t forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [Text
t' |  String Text
t' <- [Value]
xs]) forall a. a -> [a] -> [a]
:
        [Value] -> [Value]
consolidateStrings [Value]
ys
  consolidateStrings (Value
x : [Value]
rest) =
    Value
x forall a. a -> [a] -> [a]
: [Value] -> [Value]
consolidateStrings [Value]
rest
  go :: RenderContext -> CslJson Text -> [Value]
  go :: RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
el = [Value] -> [Value]
consolidateStrings forall a b. (a -> b) -> a -> b
$
    case CslJson Text
el of
      CslText Text
t -> [Text -> Value
String Text
t]
      CslJson Text
CslEmpty -> []
      CslConcat CslJson Text
x CslJson Text
CslEmpty -> RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x
      CslConcat (CslConcat CslJson Text
x CslJson Text
y) CslJson Text
z -> RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx (forall a. CslJson a -> CslJson a -> CslJson a
CslConcat CslJson Text
x (forall a. CslJson a -> CslJson a -> CslJson a
CslConcat CslJson Text
y CslJson Text
z))
      CslConcat CslJson Text
x CslJson Text
y -> RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x forall a. Semigroup a => a -> a -> a
<> RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
y
      CslQuoted CslJson Text
x -> RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x  -- should be localized already
      CslNormal CslJson Text
x
        | RenderContext -> Bool
useItalics RenderContext
ctx -> RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x
        | Bool
otherwise      -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"no-italics")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x)
                               ]
                            ]
      CslItalic CslJson Text
x
        | RenderContext -> Bool
useItalics RenderContext
ctx -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"italics")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$
                                    RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx{ useItalics :: Bool
useItalics = Bool
False } CslJson Text
x)
                               ]
                            ]
        | Bool
otherwise      -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"no-italics")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$
                                    RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx{ useItalics :: Bool
useItalics = Bool
False } CslJson Text
x)
                               ]
                            ]
      CslBold CslJson Text
x
        | RenderContext -> Bool
useItalics RenderContext
ctx -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"bold")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$
                                    RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx{ useBold :: Bool
useBold = Bool
False } CslJson Text
x)
                               ]
                            ]
        | Bool
otherwise      -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"no-bold")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$
                                    RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx{ useBold :: Bool
useBold = Bool
False } CslJson Text
x)
                               ]
                            ]
      CslUnderline CslJson Text
x     -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"underline")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x)
                               ]
                            ]
      CslNoDecoration CslJson Text
x -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"no-decoration")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x)
                               ]
                           ]
      CslSmallCaps CslJson Text
x
        | RenderContext -> Bool
useSmallCaps RenderContext
ctx -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"small-caps")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$
                                    RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx{ useSmallCaps :: Bool
useSmallCaps = Bool
False } CslJson Text
x)
                               ]
                            ]
        | Bool
otherwise      -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"no-small-caps")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$
                                    RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx{ useSmallCaps :: Bool
useSmallCaps = Bool
False } CslJson Text
x)
                               ]
                            ]
      CslSup CslJson Text
x           -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"superscript")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x)
                               ]
                            ]
      CslSub CslJson Text
x           -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"subscript")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x)
                               ]
                            ]
      CslBaseline CslJson Text
x      -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"baseline")
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x)
                               ]
                            ]
      CslDiv Text
t CslJson Text
x         -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"div")
                               , (Key
"class", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ Text
"csl-" forall a. Semigroup a => a -> a -> a
<> Text
t)
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x)
                               ]
                            ]
      CslLink Text
t CslJson Text
x        -> [ [Pair] -> Value
object
                               [ (Key
"format", Value
"link")
                               , (Key
"target", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ Text
t)
                               , (Key
"contents", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x)
                               ]
                            ]
      CslNoCase CslJson Text
x -> RenderContext -> CslJson Text -> [Value]
go RenderContext
ctx CslJson Text
x -- nocase is just for internal purposes


-- custom traversal which does not descend into
-- CslSmallCaps, Baseline, SUp, Sub, or NoCase (implicit nocase)
caseTransform' :: (CaseTransformState -> Text -> Text)
               -> Int -- level in hierarchy
               -> CslJson Text
               -> State CaseTransformState (CslJson Text)
caseTransform' :: (CaseTransformState -> Text -> Text)
-> Int -> CslJson Text -> State CaseTransformState (CslJson Text)
caseTransform' CaseTransformState -> Text -> Text
f Int
lev CslJson Text
el =
  case CslJson Text
el of
     CslText Text
x         -> forall a. a -> CslJson a
CslText 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
x)
     CslConcat CslJson Text
x CslJson Text
y     -> do
       CslJson Text
x' <- (CaseTransformState -> Text -> Text)
-> Int -> CslJson Text -> State CaseTransformState (CslJson Text)
caseTransform' CaseTransformState -> Text -> Text
f Int
lev CslJson Text
x
       let lastWord :: Bool
lastWord = Int
lev forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (CslJson Text -> Bool
hasWordBreak CslJson Text
y)
       CaseTransformState
st <- forall (m :: * -> *) s. Monad m => StateT s m s
get
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
lastWord Bool -> Bool -> Bool
&&
             (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
       CslJson Text
y' <- (CaseTransformState -> Text -> Text)
-> Int -> CslJson Text -> State CaseTransformState (CslJson Text)
caseTransform' CaseTransformState -> Text -> Text
f Int
lev CslJson Text
y
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CslJson a -> CslJson a -> CslJson a
CslConcat CslJson Text
x' CslJson Text
y'
     CslQuoted CslJson Text
x       -> forall a. CslJson a -> CslJson a
CslQuoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CaseTransformState -> Text -> Text)
-> Int -> CslJson Text -> State CaseTransformState (CslJson Text)
caseTransform' CaseTransformState -> Text -> Text
f (Int
lev forall a. Num a => a -> a -> a
+ Int
1) CslJson Text
x
     CslItalic CslJson Text
x       -> forall a. CslJson a -> CslJson a
CslItalic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CaseTransformState -> Text -> Text)
-> Int -> CslJson Text -> State CaseTransformState (CslJson Text)
caseTransform' CaseTransformState -> Text -> Text
f (Int
lev forall a. Num a => a -> a -> a
+ Int
1) CslJson Text
x
     CslNormal CslJson Text
x       -> forall a. CslJson a -> CslJson a
CslNormal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CaseTransformState -> Text -> Text)
-> Int -> CslJson Text -> State CaseTransformState (CslJson Text)
caseTransform' CaseTransformState -> Text -> Text
f (Int
lev forall a. Num a => a -> a -> a
+ Int
1) CslJson Text
x
     CslBold   CslJson Text
x       -> forall a. CslJson a -> CslJson a
CslBold   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CaseTransformState -> Text -> Text)
-> Int -> CslJson Text -> State CaseTransformState (CslJson Text)
caseTransform' CaseTransformState -> Text -> Text
f (Int
lev forall a. Num a => a -> a -> a
+ Int
1) CslJson Text
x
     CslUnderline CslJson Text
x    -> forall a. CslJson a -> CslJson a
CslUnderline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CaseTransformState -> Text -> Text)
-> Int -> CslJson Text -> State CaseTransformState (CslJson Text)
caseTransform' CaseTransformState -> Text -> Text
f (Int
lev forall a. Num a => a -> a -> a
+ Int
1) CslJson Text
x
     CslNoDecoration CslJson Text
_ -> forall {a}.
CiteprocOutput a =>
a -> StateT CaseTransformState Identity a
return' CslJson Text
el
     CslSmallCaps CslJson Text
_    -> forall {a}.
CiteprocOutput a =>
a -> StateT CaseTransformState Identity a
return' CslJson Text
el
     CslBaseline CslJson Text
_     -> forall {a}.
CiteprocOutput a =>
a -> StateT CaseTransformState Identity a
return' CslJson Text
el
     CslSub CslJson Text
_          -> forall {a}.
CiteprocOutput a =>
a -> StateT CaseTransformState Identity a
return' CslJson Text
el
     CslSup CslJson Text
_          -> forall {a}.
CiteprocOutput a =>
a -> StateT CaseTransformState Identity a
return' CslJson Text
el
     CslNoCase CslJson Text
_       -> forall {a}.
CiteprocOutput a =>
a -> StateT CaseTransformState Identity a
return' CslJson Text
el
     CslDiv Text
_ CslJson Text
_        -> forall {a}.
CiteprocOutput a =>
a -> StateT CaseTransformState Identity a
return' CslJson Text
el
     CslLink Text
_ CslJson Text
_       -> forall {a}.
CiteprocOutput a =>
a -> StateT CaseTransformState Identity a
return' CslJson Text
el
     CslJson Text
CslEmpty          -> forall {a}.
CiteprocOutput a =>
a -> StateT CaseTransformState Identity a
return' CslJson Text
el
 where
  -- we need to apply g to update the state:
  return' :: a -> StateT CaseTransformState Identity a
return' a
x = a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> State CaseTransformState Text
g (forall a. CiteprocOutput a => a -> Text
toText a
x)

  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 :: CslJson Text -> Bool
hasWordBreak = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((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)

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

punctuationInsideQuotes :: CslJson Text -> CslJson Text
punctuationInsideQuotes :: CslJson Text -> CslJson Text
punctuationInsideQuotes = CslJson Text -> CslJson Text
go
 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 :: CslJson Text -> CslJson Text
go CslJson Text
el =
    case CslJson Text
el of
      CslConcat CslJson Text
CslEmpty CslJson Text
x -> CslJson Text -> CslJson Text
go CslJson Text
x
      CslConcat CslJson Text
x CslJson Text
CslEmpty -> CslJson Text -> CslJson Text
go CslJson Text
x
      CslConcat (CslQuoted CslJson Text
x) CslJson Text
y ->
         case CslJson Text -> CslJson Text
go CslJson Text
y of
           (CslText Text
t) | Text -> Bool
startsWithMovable Text
t
             -> forall a. CslJson a -> CslJson a
CslQuoted (CslJson Text -> CslJson Text
go (CslJson Text
x forall a. Semigroup a => a -> a -> a
<> forall a. a -> CslJson a
CslText (Int -> Text -> Text
T.take Int
1 Text
t)))
               forall a. Semigroup a => a -> a -> a
<> forall a. a -> CslJson a
CslText (Int -> Text -> Text
T.drop Int
1 Text
t)
           (CslConcat (CslText Text
t) CslJson Text
z) | Text -> Bool
startsWithMovable Text
t
             -> forall a. CslJson a -> CslJson a
CslQuoted (CslJson Text -> CslJson Text
go (CslJson Text
x forall a. Semigroup a => a -> a -> a
<> forall a. a -> CslJson a
CslText (Int -> Text -> Text
T.take Int
1 Text
t))) forall a. Semigroup a => a -> a -> a
<>
                 forall a. a -> CslJson a
CslText (Int -> Text -> Text
T.drop Int
1 Text
t) forall a. Semigroup a => a -> a -> a
<> CslJson Text
z
           CslJson Text
z                      -> forall a. CslJson a -> CslJson a
CslQuoted CslJson Text
x forall a. Semigroup a => a -> a -> a
<> CslJson Text
z
      CslConcat (CslConcat CslJson Text
x CslJson Text
y) CslJson Text
z -> CslJson Text -> CslJson Text
go (forall a. CslJson a -> CslJson a -> CslJson a
CslConcat CslJson Text
x (forall a. CslJson a -> CslJson a -> CslJson a
CslConcat CslJson Text
y CslJson Text
z))
      CslConcat CslJson Text
x CslJson Text
y               -> CslJson Text -> CslJson Text
go CslJson Text
x forall a. Semigroup a => a -> a -> a
<> CslJson Text -> CslJson Text
go CslJson Text
y
      CslQuoted CslJson Text
x                 -> forall a. CslJson a -> CslJson a
CslQuoted (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslItalic CslJson Text
x                 -> forall a. CslJson a -> CslJson a
CslItalic (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslNormal CslJson Text
x                 -> forall a. CslJson a -> CslJson a
CslNormal (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslBold CslJson Text
x                   -> forall a. CslJson a -> CslJson a
CslBold (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslUnderline CslJson Text
x              -> forall a. CslJson a -> CslJson a
CslUnderline (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslNoDecoration CslJson Text
x           -> forall a. CslJson a -> CslJson a
CslNoDecoration (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslSmallCaps CslJson Text
x              -> forall a. CslJson a -> CslJson a
CslSmallCaps (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslSup CslJson Text
x                    -> forall a. CslJson a -> CslJson a
CslSup (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslSub CslJson Text
x                    -> forall a. CslJson a -> CslJson a
CslSub (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslBaseline CslJson Text
x               -> forall a. CslJson a -> CslJson a
CslBaseline (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslNoCase CslJson Text
x                 -> forall a. CslJson a -> CslJson a
CslNoCase (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslDiv Text
t CslJson Text
x                  -> forall a. Text -> CslJson a -> CslJson a
CslDiv Text
t (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslLink Text
t CslJson Text
x                 -> forall a. Text -> CslJson a -> CslJson a
CslLink Text
t (CslJson Text -> CslJson Text
go CslJson Text
x)
      CslText Text
t                   -> forall a. a -> CslJson a
CslText Text
t
      CslJson Text
CslEmpty                    -> forall a. CslJson a
CslEmpty

superscriptChars :: [Char]
superscriptChars :: String
superscriptChars =
  [ Char
'\x00AA'
  , Char
'\x00B2'
  , Char
'\x00B3'
  , Char
'\x00B9'
  , Char
'\x00BA'
  , Char
'\x02B0'
  , Char
'\x02B1'
  , Char
'\x02B2'
  , Char
'\x02B3'
  , Char
'\x02B4'
  , Char
'\x02B5'
  , Char
'\x02B6'
  , Char
'\x02B7'
  , Char
'\x02B8'
  , Char
'\x02E0'
  , Char
'\x02E1'
  , Char
'\x02E2'
  , Char
'\x02E3'
  , Char
'\x02E4'
  , Char
'\x1D2C'
  , Char
'\x1D2D'
  , Char
'\x1D2E'
  , Char
'\x1D30'
  , Char
'\x1D31'
  , Char
'\x1D32'
  , Char
'\x1D33'
  , Char
'\x1D34'
  , Char
'\x1D35'
  , Char
'\x1D36'
  , Char
'\x1D37'
  , Char
'\x1D38'
  , Char
'\x1D39'
  , Char
'\x1D3A'
  , Char
'\x1D3C'
  , Char
'\x1D3D'
  , Char
'\x1D3E'
  , Char
'\x1D3F'
  , Char
'\x1D40'
  , Char
'\x1D41'
  , Char
'\x1D42'
  , Char
'\x1D43'
  , Char
'\x1D44'
  , Char
'\x1D45'
  , Char
'\x1D46'
  , Char
'\x1D47'
  , Char
'\x1D48'
  , Char
'\x1D49'
  , Char
'\x1D4A'
  , Char
'\x1D4B'
  , Char
'\x1D4C'
  , Char
'\x1D4D'
  , Char
'\x1D4F'
  , Char
'\x1D50'
  , Char
'\x1D51'
  , Char
'\x1D52'
  , Char
'\x1D53'
  , Char
'\x1D54'
  , Char
'\x1D55'
  , Char
'\x1D56'
  , Char
'\x1D57'
  , Char
'\x1D58'
  , Char
'\x1D59'
  , Char
'\x1D5A'
  , Char
'\x1D5B'
  , Char
'\x1D5C'
  , Char
'\x1D5D'
  , Char
'\x1D5E'
  , Char
'\x1D5F'
  , Char
'\x1D60'
  , Char
'\x1D61'
  , Char
'\x2070'
  , Char
'\x2071'
  , Char
'\x2074'
  , Char
'\x2075'
  , Char
'\x2076'
  , Char
'\x2077'
  , Char
'\x2078'
  , Char
'\x2079'
  , Char
'\x207A'
  , Char
'\x207B'
  , Char
'\x207C'
  , Char
'\x207D'
  , Char
'\x207E'
  , Char
'\x207F'
  , Char
'\x2120'
  , Char
'\x2122'
  , Char
'\x3192'
  , Char
'\x3193'
  , Char
'\x3194'
  , Char
'\x3195'
  , Char
'\x3196'
  , Char
'\x3197'
  , Char
'\x3198'
  , Char
'\x3199'
  , Char
'\x319A'
  , Char
'\x319B'
  , Char
'\x319C'
  , Char
'\x319D'
  , Char
'\x319E'
  , Char
'\x319F'
  , Char
'\x02C0'
  , Char
'\x02C1'
  , Char
'\x06E5'
  , Char
'\x06E6'
  ]

charToSup :: Char -> CslJson Text
charToSup :: Char -> CslJson Text
charToSup Char
c =
  case Char
c of
    Char
'\x00AA' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0061")
    Char
'\x00B2' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0032")
    Char
'\x00B3' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0033")
    Char
'\x00B9' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0031")
    Char
'\x00BA' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x006F")
    Char
'\x02B0' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0068")
    Char
'\x02B1' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0266")
    Char
'\x02B2' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x006A")
    Char
'\x02B3' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0072")
    Char
'\x02B4' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0279")
    Char
'\x02B5' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x027B")
    Char
'\x02B6' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0281")
    Char
'\x02B7' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0077")
    Char
'\x02B8' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0079")
    Char
'\x02E0' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0263")
    Char
'\x02E1' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x006C")
    Char
'\x02E2' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0073")
    Char
'\x02E3' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0078")
    Char
'\x02E4' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0295")
    Char
'\x1D2C' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0041")
    Char
'\x1D2D' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x00C6")
    Char
'\x1D2E' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0042")
    Char
'\x1D30' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0044")
    Char
'\x1D31' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0045")
    Char
'\x1D32' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x018E")
    Char
'\x1D33' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0047")
    Char
'\x1D34' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0048")
    Char
'\x1D35' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0049")
    Char
'\x1D36' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x004A")
    Char
'\x1D37' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x004B")
    Char
'\x1D38' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x004C")
    Char
'\x1D39' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x004D")
    Char
'\x1D3A' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x004E")
    Char
'\x1D3C' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x004F")
    Char
'\x1D3D' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0222")
    Char
'\x1D3E' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0050")
    Char
'\x1D3F' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0052")
    Char
'\x1D40' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0054")
    Char
'\x1D41' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0055")
    Char
'\x1D42' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0057")
    Char
'\x1D43' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0061")
    Char
'\x1D44' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0250")
    Char
'\x1D45' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0251")
    Char
'\x1D46' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x1D02")
    Char
'\x1D47' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0062")
    Char
'\x1D48' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0064")
    Char
'\x1D49' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0065")
    Char
'\x1D4A' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0259")
    Char
'\x1D4B' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x025B")
    Char
'\x1D4C' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x025C")
    Char
'\x1D4D' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0067")
    Char
'\x1D4F' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x006B")
    Char
'\x1D50' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x006D")
    Char
'\x1D51' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x014B")
    Char
'\x1D52' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x006F")
    Char
'\x1D53' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0254")
    Char
'\x1D54' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x1D16")
    Char
'\x1D55' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x1D17")
    Char
'\x1D56' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0070")
    Char
'\x1D57' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0074")
    Char
'\x1D58' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0075")
    Char
'\x1D59' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x1D1D")
    Char
'\x1D5A' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x026F")
    Char
'\x1D5B' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0076")
    Char
'\x1D5C' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x1D25")
    Char
'\x1D5D' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x03B2")
    Char
'\x1D5E' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x03B3")
    Char
'\x1D5F' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x03B4")
    Char
'\x1D60' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x03C6")
    Char
'\x1D61' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x03C7")
    Char
'\x2070' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0030")
    Char
'\x2071' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0069")
    Char
'\x2074' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0034")
    Char
'\x2075' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0035")
    Char
'\x2076' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0036")
    Char
'\x2077' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0037")
    Char
'\x2078' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0038")
    Char
'\x2079' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0039")
    Char
'\x207A' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x002B")
    Char
'\x207B' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x2212")
    Char
'\x207C' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x003D")
    Char
'\x207D' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0028")
    Char
'\x207E' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0029")
    Char
'\x207F' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x006E")
    Char
'\x2120' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0053\x004D")
    Char
'\x2122' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0054\x004D")
    Char
'\x3192' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4E00")
    Char
'\x3193' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4E8C")
    Char
'\x3194' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4E09")
    Char
'\x3195' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x56DB")
    Char
'\x3196' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4E0A")
    Char
'\x3197' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4E2D")
    Char
'\x3198' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4E0B")
    Char
'\x3199' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x7532")
    Char
'\x319A' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4E59")
    Char
'\x319B' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4E19")
    Char
'\x319C' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4E01")
    Char
'\x319D' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x5929")
    Char
'\x319E' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x5730")
    Char
'\x319F' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x4EBA")
    Char
'\x02C0' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0294")
    Char
'\x02C1' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0295")
    Char
'\x06E5' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x0648")
    Char
'\x06E6' -> forall a. CslJson a -> CslJson a
CslSup (forall a. a -> CslJson a
CslText Text
"\x064A")
    Char
_        -> forall a. a -> CslJson a
CslText forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c