module Text.HTML.Tagchup.Tag (
   T(..), Name(..),
   mapName,

   open,       isOpen,       maybeOpen,
   close,      isClose,      maybeClose,
   text,       isText,       maybeText,   innerText,
   comment,    isComment,    maybeComment,
   special,    isSpecial,    maybeSpecial,
   cdata,      isCData,      maybeCData,
   processing, isProcessing, maybeProcessing,
   warning,    isWarning,    maybeWarning,

   formatOpen, formatClose,

   textFromCData, concatTexts,
   mapText, mapTextA,
   ) where

import qualified Text.HTML.Tagchup.Character as Chr

import qualified Text.XML.Basic.ProcessingInstruction as PI
import qualified Text.XML.Basic.Attribute as Attr
import qualified Text.XML.Basic.Name as Name
import qualified Text.XML.Basic.Format as Fmt
import Text.XML.Basic.Tag (Name(Name), cdataName, )

import Data.Tuple.HT (mapFst, )
import Data.Maybe (mapMaybe, fromMaybe, )
import Data.Monoid (Monoid, mempty, mappend, mconcat, )
import Control.Monad (guard, )

import Data.Foldable (Foldable(foldMap), )
import Data.Traversable (Traversable(sequenceA), traverse, )
import Control.Applicative (Applicative, pure, liftA, )


-- * type definitions

{- |
An HTML element, a document is @[T]@.
There is no requirement for 'Open' and 'Close' to match.

The type parameter @string@ lets you choose between
@[Char]@ for interpreted HTML entity references and
@[HTMLChar.T]@ for uninterpreted HTML entities.
You will most oftenly want plain @Char@,
since @HTMLChar.T@ is only necessary if you want to know,
whether a non-ASCII character was encoded as HTML entity
or as non-ASCII Unicode character.
-}
data T name string =
     Open (Name name) [Attr.T name string]
        -- ^ An open tag with 'Attr.T's in their original order.
   | Close (Name name)
        -- ^ A closing tag
   | Text string
        -- ^ A text node, guaranteed not to be the empty string
   | Comment String
        -- ^ A comment
   | Special (Name name) String
        -- ^ A tag like @\<!DOCTYPE ...\>@
   | Processing (Name name) (PI.T name string)
        -- ^ A tag like @\<?xml ...\>@
   | Warning String
        -- ^ Mark a syntax error in the input file
     deriving (Int -> T name string -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall name string.
(Attribute name, Show name, Show string) =>
Int -> T name string -> ShowS
forall name string.
(Attribute name, Show name, Show string) =>
[T name string] -> ShowS
forall name string.
(Attribute name, Show name, Show string) =>
T name string -> String
showList :: [T name string] -> ShowS
$cshowList :: forall name string.
(Attribute name, Show name, Show string) =>
[T name string] -> ShowS
show :: T name string -> String
$cshow :: forall name string.
(Attribute name, Show name, Show string) =>
T name string -> String
showsPrec :: Int -> T name string -> ShowS
$cshowsPrec :: forall name string.
(Attribute name, Show name, Show string) =>
Int -> T name string -> ShowS
Show, T name string -> T name string -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall name string.
(Eq name, Eq string) =>
T name string -> T name string -> Bool
/= :: T name string -> T name string -> Bool
$c/= :: forall name string.
(Eq name, Eq string) =>
T name string -> T name string -> Bool
== :: T name string -> T name string -> Bool
$c== :: forall name string.
(Eq name, Eq string) =>
T name string -> T name string -> Bool
Eq, T name string -> T name string -> 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 {name} {string}.
(Ord name, Ord string) =>
Eq (T name string)
forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Ordering
forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> T name string
min :: T name string -> T name string -> T name string
$cmin :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> T name string
max :: T name string -> T name string -> T name string
$cmax :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> T name string
>= :: T name string -> T name string -> Bool
$c>= :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
> :: T name string -> T name string -> Bool
$c> :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
<= :: T name string -> T name string -> Bool
$c<= :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
< :: T name string -> T name string -> Bool
$c< :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
compare :: T name string -> T name string -> Ordering
$ccompare :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Ordering
Ord)


instance Functor (T name) where
   fmap :: forall a b. (a -> b) -> T name a -> T name b
fmap a -> b
f T name a
tag =
      case T name a
tag of
         Open Name name
name [T name a]
attrs      -> forall name string. Name name -> [T name string] -> T name string
Open Name name
name forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [T name a]
attrs
         Close Name name
name           -> forall name string. Name name -> T name string
Close Name name
name
         Text a
string          -> forall name string. string -> T name string
Text forall a b. (a -> b) -> a -> b
$ a -> b
f a
string
         Comment String
string       -> forall name string. String -> T name string
Comment String
string
         Special Name name
name String
content -> forall name string. Name name -> String -> T name string
Special Name name
name String
content
         Processing Name name
name T name a
proc -> forall name string. Name name -> T name string -> T name string
Processing Name name
name forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f T name a
proc
         Warning String
string       -> forall name string. String -> T name string
Warning String
string


instance Foldable (T name) where
   foldMap :: forall m a. Monoid m => (a -> m) -> T name a -> m
foldMap a -> m
f T name a
tag =
      case T name a
tag of
         Open Name name
_name [T name a]
attrs       -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [T name a]
attrs
         Close Name name
_name            -> forall a. Monoid a => a
mempty
         Text a
string            -> a -> m
f a
string
         Comment String
_text          -> forall a. Monoid a => a
mempty
         Special Name name
_name String
_content -> forall a. Monoid a => a
mempty
         Processing Name name
_name T name a
proc  -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f T name a
proc
         Warning String
_text          -> forall a. Monoid a => a
mempty


instance Traversable (T name) where
   sequenceA :: forall (f :: * -> *) a.
Applicative f =>
T name (f a) -> f (T name a)
sequenceA T name (f a)
tag =
      case T name (f a)
tag of
         Open Name name
name [T name (f a)]
attrs      -> forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (forall name string. Name name -> [T name string] -> T name string
Open Name name
name) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [T name (f a)]
attrs
         Close Name name
name           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall name string. Name name -> T name string
Close Name name
name
         Text f a
string          -> forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA forall name string. string -> T name string
Text forall a b. (a -> b) -> a -> b
$ f a
string
         Comment String
string       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall name string. String -> T name string
Comment String
string
         Special Name name
name String
content -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall name string. Name name -> String -> T name string
Special Name name
name String
content
         Processing Name name
name T name (f a)
proc -> forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (forall name string. Name name -> T name string -> T name string
Processing Name name
name) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA T name (f a)
proc
         Warning String
string       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall name string. String -> T name string
Warning String
string


mapName ::
   (Name name0 -> Name name1) ->
   (Attr.Name name0 -> Attr.Name name1) ->
   T name0 string -> T name1 string
mapName :: forall name0 name1 string.
(Name name0 -> Name name1)
-> (Name name0 -> Name name1) -> T name0 string -> T name1 string
mapName Name name0 -> Name name1
f Name name0 -> Name name1
g T name0 string
tag =
   case T name0 string
tag of
      Open Name name0
name [T name0 string]
attrs -> forall name string. Name name -> [T name string] -> T name string
Open (Name name0 -> Name name1
f Name name0
name) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall name0 name1 string.
(Name name0 -> Name name1) -> T name0 string -> T name1 string
Attr.mapName Name name0 -> Name name1
g) [T name0 string]
attrs
      Close Name name0
name      -> forall name string. Name name -> T name string
Close (Name name0 -> Name name1
f Name name0
name)
      Text string
string     -> forall name string. string -> T name string
Text string
string
      Comment String
string  -> forall name string. String -> T name string
Comment String
string
      Special Name name0
name String
content -> forall name string. Name name -> String -> T name string
Special (Name name0 -> Name name1
f Name name0
name) String
content
      Processing Name name0
name T name0 string
proc -> forall name string. Name name -> T name string -> T name string
Processing (Name name0 -> Name name1
f Name name0
name) forall a b. (a -> b) -> a -> b
$ forall name0 name1 string.
(Name name0 -> Name name1) -> T name0 string -> T name1 string
PI.mapName Name name0 -> Name name1
g T name0 string
proc
      Warning String
string       -> forall name string. String -> T name string
Warning String
string





instance (Name.Tag name, Name.Attribute name, Fmt.C string) =>
      Fmt.C (T name string) where
   run :: T name string -> ShowS
run T name string
t =
      case T name string
t of
         Open Name name
name [T name string]
attrs -> forall name string.
(Tag name, Attribute name, C string) =>
Bool -> Name name -> [T name string] -> ShowS
formatOpen Bool
False Name name
name [T name string]
attrs
         Close Name name
name -> forall name. Tag name => Name name -> ShowS
formatClose Name name
name
         Text string
str -> forall object. C object => object -> ShowS
Fmt.run string
str
         Comment String
c ->
            String -> ShowS
showString String
"<!--" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"-->"
         Warning String
e ->
            String -> ShowS
showString String
"<!-- Warning: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" -->"
         Special Name name
name String
str ->
            ShowS -> ShowS
Fmt.angle forall a b. (a -> b) -> a -> b
$
            ShowS
Fmt.exclam forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall name. C name => name -> ShowS
Fmt.name Name name
name forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            if forall name. Tag name => Name name
cdataName forall a. Eq a => a -> a -> Bool
== Name name
name
              then String -> ShowS
showString String
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]]"
              else ShowS
Fmt.blank forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
str
         Processing Name name
name T name string
p ->
            ShowS -> ShowS
Fmt.angle forall a b. (a -> b) -> a -> b
$
            ShowS
Fmt.quest forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall name. C name => name -> ShowS
Fmt.name Name name
name forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall object. C object => object -> ShowS
Fmt.run T name string
p forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            ShowS
Fmt.quest


formatOpen :: (Name.Tag name, Name.Attribute name, Fmt.C string) =>
   Bool -> Name name -> [Attr.T name string] -> ShowS
formatOpen :: forall name string.
(Tag name, Attribute name, C string) =>
Bool -> Name name -> [T name string] -> ShowS
formatOpen Bool
selfClosing Name name
name [T name string]
attrs =
   ShowS -> ShowS
Fmt.angle forall a b. (a -> b) -> a -> b
$
   forall name. C name => name -> ShowS
Fmt.name Name name
name forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall name string.
(Attribute name, C string) =>
[T name string] -> ShowS
Attr.formatListBlankHead [T name string]
attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   if Bool
selfClosing then ShowS
Fmt.slash else forall a. a -> a
id

formatClose :: (Name.Tag name) =>
   Name name -> ShowS
formatClose :: forall name. Tag name => Name name -> ShowS
formatClose Name name
name =
   ShowS -> ShowS
Fmt.angle forall a b. (a -> b) -> a -> b
$
   ShowS
Fmt.slash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name. C name => name -> ShowS
Fmt.name Name name
name


-- * constructors for the tag types

open :: Name name -> [Attr.T name string] -> T name string
open :: forall name string. Name name -> [T name string] -> T name string
open = forall name string. Name name -> [T name string] -> T name string
Open

close :: Name name -> T name string
close :: forall name string. Name name -> T name string
close = forall name string. Name name -> T name string
Close

text :: string -> T name string
text :: forall string name. string -> T name string
text = forall name string. string -> T name string
Text

comment :: String -> T name string
comment :: forall name string. String -> T name string
comment = forall name string. String -> T name string
Comment

special :: Name name -> String -> T name string
special :: forall name string. Name name -> String -> T name string
special = forall name string. Name name -> String -> T name string
Special

cdata :: (Name.Tag name) => String -> T name string
cdata :: forall name string. Tag name => String -> T name string
cdata = forall name string. Name name -> String -> T name string
special forall name. Tag name => Name name
cdataName

processing :: Name name -> PI.T name string -> T name string
processing :: forall name string. Name name -> T name string -> T name string
processing = forall name string. Name name -> T name string -> T name string
Processing

warning :: String -> T name string
warning :: forall name string. String -> T name string
warning = forall name string. String -> T name string
Warning



-- * check for the tag types

-- | Test if a 'T' is a 'Open'
isOpen :: T name string -> Bool
isOpen :: forall name a. T name a -> Bool
isOpen T name string
tag = case T name string
tag of (Open {}) -> Bool
True; T name string
_ -> Bool
False

maybeOpen :: T name string -> Maybe (Name name, [Attr.T name string])
maybeOpen :: forall name string.
T name string -> Maybe (Name name, [T name string])
maybeOpen T name string
tag = case T name string
tag of Open Name name
name [T name string]
attrs -> forall a. a -> Maybe a
Just (Name name
name, [T name string]
attrs); T name string
_ -> forall a. Maybe a
Nothing


-- | Test if a 'T' is a 'Close'
isClose :: T name string -> Bool
isClose :: forall name a. T name a -> Bool
isClose T name string
tag = case T name string
tag of (Close {}) -> Bool
True; T name string
_ -> Bool
False

maybeClose :: T name string -> Maybe (Name name)
maybeClose :: forall name string. T name string -> Maybe (Name name)
maybeClose T name string
tag = case T name string
tag of Close Name name
x -> forall a. a -> Maybe a
Just Name name
x; T name string
_ -> forall a. Maybe a
Nothing


-- | Test if a 'T' is a 'Text'
isText :: T name string -> Bool
isText :: forall name a. T name a -> Bool
isText T name string
tag = case T name string
tag of (Text {}) -> Bool
True; T name string
_ -> Bool
False

-- | Extract the string from within 'Text', otherwise 'Nothing'
maybeText :: T name string -> Maybe string
maybeText :: forall name string. T name string -> Maybe string
maybeText T name string
tag = case T name string
tag of Text string
x -> forall a. a -> Maybe a
Just string
x; T name string
_ -> forall a. Maybe a
Nothing
-- maybeText tag = do Text x <- Just tag; return x

-- | Extract all text content from tags (similar to Verbatim found in HaXml)
innerText :: (Monoid string) => [T name string] -> string
innerText :: forall string name. Monoid string => [T name string] -> string
innerText = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall name string. T name string -> Maybe string
maybeText


isComment :: T name string -> Bool
isComment :: forall name a. T name a -> Bool
isComment T name string
tag = case T name string
tag of (Comment {}) -> Bool
True; T name string
_ -> Bool
False

maybeComment :: T name string -> Maybe String
maybeComment :: forall name string. T name string -> Maybe String
maybeComment T name string
tag = case T name string
tag of Comment String
x -> forall a. a -> Maybe a
Just String
x; T name string
_ -> forall a. Maybe a
Nothing


isSpecial :: T name string -> Bool
isSpecial :: forall name a. T name a -> Bool
isSpecial T name string
tag = case T name string
tag of (Special {}) -> Bool
True; T name string
_ -> Bool
False

maybeSpecial :: T name string -> Maybe (Name name, String)
maybeSpecial :: forall name string. T name string -> Maybe (Name name, String)
maybeSpecial T name string
tag = case T name string
tag of Special Name name
name String
content -> forall a. a -> Maybe a
Just (Name name
name, String
content); T name string
_ -> forall a. Maybe a
Nothing


isCData ::
   (Name.Tag name) =>
   T name string -> Bool
isCData :: forall name string. Tag name => T name string -> Bool
isCData T name string
tag = case T name string
tag of (Special Name name
name String
_) -> forall name. Tag name => Name name
cdataName forall a. Eq a => a -> a -> Bool
== Name name
name; T name string
_ -> Bool
False

maybeCData ::
   (Name.Tag name) =>
   T name string -> Maybe String
maybeCData :: forall name string. Tag name => T name string -> Maybe String
maybeCData T name string
tag =
   do (Name name
name, String
content) <- forall name string. T name string -> Maybe (Name name, String)
maybeSpecial T name string
tag
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall name. Tag name => Name name
cdataName forall a. Eq a => a -> a -> Bool
== Name name
name)
      forall (m :: * -> *) a. Monad m => a -> m a
return String
content


isProcessing :: T name string -> Bool
isProcessing :: forall name a. T name a -> Bool
isProcessing T name string
tag = case T name string
tag of (Processing {}) -> Bool
True; T name string
_ -> Bool
False

maybeProcessing :: T name string -> Maybe (Name name, PI.T name string)
maybeProcessing :: forall name string.
T name string -> Maybe (Name name, T name string)
maybeProcessing T name string
tag = case T name string
tag of Processing Name name
target T name string
instr -> forall a. a -> Maybe a
Just (Name name
target, T name string
instr); T name string
_ -> forall a. Maybe a
Nothing


isWarning :: T name string -> Bool
isWarning :: forall name a. T name a -> Bool
isWarning T name string
tag = case T name string
tag of (Warning {}) -> Bool
True; T name string
_ -> Bool
False

maybeWarning :: T name string -> Maybe String
maybeWarning :: forall name string. T name string -> Maybe String
maybeWarning T name string
tag = case T name string
tag of Warning String
x -> forall a. a -> Maybe a
Just String
x; T name string
_ -> forall a. Maybe a
Nothing
-- maybeWarning tag = do Warning x <- Just tag; return x



-- * tag processing

{- |
Replace CDATA sections by plain text.
-}
textFromCData ::
   (Name.Tag name, Chr.C char) =>
   T name [char] -> T name [char]
textFromCData :: forall name char.
(Tag name, C char) =>
T name [char] -> T name [char]
textFromCData T name [char]
t =
   forall a. a -> Maybe a -> a
fromMaybe T name [char]
t forall a b. (a -> b) -> a -> b
$
      do (Name name
name, String
content) <- forall name string. T name string -> Maybe (Name name, String)
maybeSpecial T name [char]
t
         forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall name. Tag name => Name name
cdataName forall a. Eq a => a -> a -> Bool
== Name name
name)
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall name string. string -> T name string
Text forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall char. C char => Char -> char
Chr.fromChar String
content

{-
textFromCData ::
   (Name.Tag name) =>
   T name String -> T name String
textFromCData t =
   fromMaybe t $
      do (name, content) <- maybeSpecial t
         guard (cdataName == name)
         return $ Text content
-}

{-
   case t of
      Special name text ->
         if cdataName == name
           then Text text
           else t
      _ -> t
-}

{- |
Merge adjacent Text sections.
-}
concatTexts ::
   Monoid string =>
   [T name string] -> [T name string]
concatTexts :: forall string name.
Monoid string =>
[T name string] -> [T name string]
concatTexts =
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\T name string
t [T name string]
ts ->
         case T name string
t of
            Text string
str0 ->
               forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall a b. (a -> b) -> a -> b
$
               forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall name string. string -> T name string
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend string
str0) forall a b. (a -> b) -> a -> b
$
               case [T name string]
ts of
                  Text string
str1 : [T name string]
rest -> (string
str1,[T name string]
rest)
                  [T name string]
_ -> (forall a. Monoid a => a
mempty,[T name string]
ts)
            T name string
_ -> T name string
tforall a. a -> [a] -> [a]
:[T name string]
ts)
      []


{- |
Modify content of a Text or a CDATA part.
-}
mapText ::
   (Name.Tag name) =>
   (String -> String) ->
   T name String -> T name String
mapText :: forall name. Tag name => ShowS -> T name String -> T name String
mapText ShowS
f T name String
t =
   case T name String
t of
      Text String
s -> forall name string. string -> T name string
Text forall a b. (a -> b) -> a -> b
$ ShowS
f String
s
      Special Name name
name String
s ->
         forall name string. Name name -> String -> T name string
Special Name name
name forall a b. (a -> b) -> a -> b
$
            if forall name. Tag name => Name name
cdataName forall a. Eq a => a -> a -> Bool
== Name name
name
              then ShowS
f String
s
              else String
s
      T name String
_ -> T name String
t

mapTextA ::
   (Name.Tag name, Applicative f) =>
   (String -> f String) ->
   T name String -> f (T name String)
mapTextA :: forall name (f :: * -> *).
(Tag name, Applicative f) =>
(String -> f String) -> T name String -> f (T name String)
mapTextA String -> f String
f T name String
t =
   case T name String
t of
      Text String
s -> forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA forall name string. string -> T name string
Text forall a b. (a -> b) -> a -> b
$ String -> f String
f String
s
      Special Name name
name String
s ->
         forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (forall name string. Name name -> String -> T name string
Special Name name
name) forall a b. (a -> b) -> a -> b
$
            if forall name. Tag name => Name name
cdataName forall a. Eq a => a -> a -> Bool
== Name name
name
              then String -> f String
f String
s
              else forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
      T name String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure T name String
t