{-# LANGUAGE RecordWildCards, PatternGuards, ScopedTypeVariables #-}

module Text.HTML.TagSoup.Implementation where

import Text.HTML.TagSoup.Type
import Text.HTML.TagSoup.Options
import Text.StringLike as Str
import Numeric (readHex)
import Data.Char (chr, ord)
import Data.Ix
import Control.Exception(assert)
import Control.Arrow

---------------------------------------------------------------------
-- BOTTOM LAYER

data Out
    = Char Char
    | Tag             -- <
    | TagShut         -- </
    | AttName
    | AttVal
    | TagEnd          -- >
    | TagEndClose     -- />
    | Comment         -- <!--
    | CommentEnd      -- -->
    | EntityName      -- &
    | EntityNum       -- &#
    | EntityHex       -- &#x
    | EntityEnd Bool  -- Attributed followed by ; for True, missing ; for False
    | Warn String
    | Pos Position
      deriving (Int -> Out -> ShowS
[Out] -> ShowS
Out -> String
(Int -> Out -> ShowS)
-> (Out -> String) -> ([Out] -> ShowS) -> Show Out
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Out] -> ShowS
$cshowList :: [Out] -> ShowS
show :: Out -> String
$cshow :: Out -> String
showsPrec :: Int -> Out -> ShowS
$cshowsPrec :: Int -> Out -> ShowS
Show,Out -> Out -> Bool
(Out -> Out -> Bool) -> (Out -> Out -> Bool) -> Eq Out
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Out -> Out -> Bool
$c/= :: Out -> Out -> Bool
== :: Out -> Out -> Bool
$c== :: Out -> Out -> Bool
Eq)

errSeen :: a -> Out
errSeen x :: a
x = String -> Out
Warn (String -> Out) -> String -> Out
forall a b. (a -> b) -> a -> b
$ "Unexpected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
errWant :: a -> Out
errWant x :: a
x = String -> Out
Warn (String -> Out) -> String -> Out
forall a b. (a -> b) -> a -> b
$ "Expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x

data S = S
    {S -> S
s :: S
    ,S -> S
tl :: S
    ,S -> Char
hd :: Char
    ,S -> Bool
eof :: Bool
    ,S -> String -> Maybe S
next :: String -> Maybe S
    ,S -> [Out] -> [Out]
pos :: [Out] -> [Out]
    }


expand :: Position -> String -> S
expand :: Position -> String -> S
expand p :: Position
p text :: String
text = Position
p Position -> S -> S
forall a b. a -> b -> b
`seq` S
res
    where res :: S
res = S :: S
-> S
-> Char
-> Bool
-> (String -> Maybe S)
-> ([Out] -> [Out])
-> S
S{s :: S
s = S
res
                 ,tl :: S
tl = Position -> String -> S
expand (Position -> Char -> Position
positionChar Position
p (String -> Char
forall a. [a] -> a
head String
text)) (ShowS
forall a. [a] -> [a]
tail String
text)
                 ,hd :: Char
hd = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
text then '\0' else String -> Char
forall a. [a] -> a
head String
text
                 ,eof :: Bool
eof = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
text
                 ,next :: String -> Maybe S
next = Position -> String -> String -> Maybe S
next Position
p String
text
                 ,pos :: [Out] -> [Out]
pos = (Position -> Out
Pos Position
pOut -> [Out] -> [Out]
forall a. a -> [a] -> [a]
:)
                 }

          next :: Position -> String -> String -> Maybe S
next p :: Position
p (t :: Char
t:ext :: String
ext) (s :: Char
s:tr :: String
tr) | Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
s = Position -> String -> String -> Maybe S
next (Position -> Char -> Position
positionChar Position
p Char
t) String
ext String
tr
          next p :: Position
p text :: String
text [] = S -> Maybe S
forall a. a -> Maybe a
Just (S -> Maybe S) -> S -> Maybe S
forall a b. (a -> b) -> a -> b
$ Position -> String -> S
expand Position
p String
text
          next _ _ _ = Maybe S
forall a. Maybe a
Nothing


infixr &

class Outable a where (&) :: a -> [Out] -> [Out]
instance Outable Char where & :: Char -> [Out] -> [Out]
(&) = Char -> [Out] -> [Out]
ampChar
instance Outable Out where & :: Out -> [Out] -> [Out]
(&) = Out -> [Out] -> [Out]
forall a. a -> [a] -> [a]
ampOut
ampChar :: Char -> [Out] -> [Out]
ampChar x :: Char
x y :: [Out]
y = Char -> Out
Char Char
x Out -> [Out] -> [Out]
forall a. a -> [a] -> [a]
: [Out]
y
ampOut :: a -> [a] -> [a]
ampOut x :: a
x y :: [a]
y = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
y


state :: String -> S
state :: String -> S
state s :: String
s = Position -> String -> S
expand Position
nullPosition String
s

---------------------------------------------------------------------
-- TOP LAYER


output :: forall str . StringLike str => ParseOptions str -> [Out] -> [Tag str]
output :: ParseOptions str -> [Out] -> [Tag str]
output ParseOptions{..} x :: [Out]
x = (if Bool
optTagTextMerge then [Tag str] -> [Tag str]
forall str. StringLike str => [Tag str] -> [Tag str]
tagTextMerge else [Tag str] -> [Tag str]
forall a. a -> a
id) ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> [Tag str]
go ((Position
nullPosition,[]),[Out]
x)
    where
        -- main choice loop
        go :: ((Position,[Tag str]),[Out]) -> [Tag str]
        go :: ((Position, [Tag str]), [Out]) -> [Tag str]
go ((p :: Position
p,ws :: [Tag str]
ws),xs :: [Out]
xs) | Position
p Position -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = [] -- otherwise p is a space leak when optTagPosition == False
        go ((p :: Position
p,ws :: [Tag str]
ws),xs :: [Out]
xs) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Tag str] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tag str]
ws = (if Bool
optTagWarning then ([Tag str] -> [Tag str]
forall a. [a] -> [a]
reverse [Tag str]
ws[Tag str] -> [Tag str] -> [Tag str]
forall a. [a] -> [a] -> [a]
++) else [Tag str] -> [Tag str]
forall a. a -> a
id) ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> [Tag str]
go ((Position
p,[]),[Out]
xs)
        go ((p :: Position
p,ws :: [Tag str]
ws),Pos p2 :: Position
p2:xs :: [Out]
xs) = ((Position, [Tag str]), [Out]) -> [Tag str]
go ((Position
p2,[Tag str]
ws),[Out]
xs)

        go x :: ((Position, [Tag str]), [Out])
x | ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isChar ((Position, [Tag str]), [Out])
x = ((Position, [Tag str]), [Out]) -> [Tag str] -> [Tag str]
forall b b str. ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((Position, [Tag str]), [Out])
x ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ str -> Tag str
forall str. str -> Tag str
TagText str
a Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: ((Position, [Tag str]), [Out]) -> [Tag str]
go ((Position, [Tag str]), [Out])
y
            where (y :: ((Position, [Tag str]), [Out])
y,a :: str
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall c'.
IsString c' =>
((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsStr ((Position, [Tag str]), [Out])
x
        go x :: ((Position, [Tag str]), [Out])
x | ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isTag ((Position, [Tag str]), [Out])
x = ((Position, [Tag str]), [Out]) -> [Tag str] -> [Tag str]
forall b b str. ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((Position, [Tag str]), [Out])
x ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ str -> [Attribute str] -> Tag str
forall str. str -> [Attribute str] -> Tag str
TagOpen str
a [Attribute str]
b Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: (if ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isTagEndClose ((Position, [Tag str]), [Out])
z then ((Position, [Tag str]), [Out]) -> [Tag str] -> [Tag str]
forall b b str. ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((Position, [Tag str]), [Out])
x ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ str -> Tag str
forall str. str -> Tag str
TagClose str
a Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: ((Position, [Tag str]), [Out]) -> [Tag str]
go (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
z) else ((Position, [Tag str]), [Out]) -> [Tag str]
go ((((Position, [Tag str]), [Out]) -> Bool)
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. ((d, [a]) -> Bool) -> (d, [a]) -> (d, [a])
skip ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isTagEnd ((Position, [Tag str]), [Out])
z))
            where (y :: ((Position, [Tag str]), [Out])
y,a :: str
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall c'.
IsString c' =>
((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsStr (((Position, [Tag str]), [Out])
 -> (((Position, [Tag str]), [Out]), str))
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x
                  (z :: ((Position, [Tag str]), [Out])
z,b :: [Attribute str]
b) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), [Attribute str])
atts ((Position, [Tag str]), [Out])
y
        go x :: ((Position, [Tag str]), [Out])
x | ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isTagShut ((Position, [Tag str]), [Out])
x = ((Position, [Tag str]), [Out]) -> [Tag str] -> [Tag str]
forall b b str. ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((Position, [Tag str]), [Out])
x ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ (str -> Tag str
forall str. str -> Tag str
TagClose str
aTag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
:) ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$
                (if Bool -> Bool
not ([Attribute str] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute str]
b) then ((Position, [Tag str]), [Out]) -> String -> [Tag str] -> [Tag str]
forall str b b.
IsString str =>
((Position, b), b) -> String -> [Tag str] -> [Tag str]
warn ((Position, [Tag str]), [Out])
x "Unexpected attributes in close tag" else [Tag str] -> [Tag str]
forall a. a -> a
id) ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$
                if ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isTagEndClose ((Position, [Tag str]), [Out])
z then ((Position, [Tag str]), [Out]) -> String -> [Tag str] -> [Tag str]
forall str b b.
IsString str =>
((Position, b), b) -> String -> [Tag str] -> [Tag str]
warn ((Position, [Tag str]), [Out])
x "Unexpected self-closing in close tag" ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> [Tag str]
go (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
z) else ((Position, [Tag str]), [Out]) -> [Tag str]
go ((((Position, [Tag str]), [Out]) -> Bool)
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. ((d, [a]) -> Bool) -> (d, [a]) -> (d, [a])
skip ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isTagEnd ((Position, [Tag str]), [Out])
z)
            where (y :: ((Position, [Tag str]), [Out])
y,a :: str
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall c'.
IsString c' =>
((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsStr (((Position, [Tag str]), [Out])
 -> (((Position, [Tag str]), [Out]), str))
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x
                  (z :: ((Position, [Tag str]), [Out])
z,b :: [Attribute str]
b) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), [Attribute str])
atts ((Position, [Tag str]), [Out])
y
        go x :: ((Position, [Tag str]), [Out])
x | ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isComment ((Position, [Tag str]), [Out])
x = ((Position, [Tag str]), [Out]) -> [Tag str] -> [Tag str]
forall b b str. ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((Position, [Tag str]), [Out])
x ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ str -> Tag str
forall str. str -> Tag str
TagComment str
a Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: ((Position, [Tag str]), [Out]) -> [Tag str]
go ((((Position, [Tag str]), [Out]) -> Bool)
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. ((d, [a]) -> Bool) -> (d, [a]) -> (d, [a])
skip ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isCommentEnd ((Position, [Tag str]), [Out])
y)
            where (y :: ((Position, [Tag str]), [Out])
y,a :: str
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall c'.
IsString c' =>
((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsStr (((Position, [Tag str]), [Out])
 -> (((Position, [Tag str]), [Out]), str))
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x
        go x :: ((Position, [Tag str]), [Out])
x | ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityName ((Position, [Tag str]), [Out])
x = ((Position, [Tag str]), [Out]) -> [Tag str] -> [Tag str]
forall (t :: * -> *) b b str.
Foldable t =>
((Position, b), b) -> t (Tag str) -> [Tag str]
poss ((Position, [Tag str]), [Out])
x ((if Bool
optTagWarning then [Tag str] -> [Tag str]
forall a. a -> a
id else (Tag str -> Bool) -> [Tag str] -> [Tag str]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Tag str -> Bool) -> Tag str -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag str -> Bool
forall str. Tag str -> Bool
isTagWarning)) ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ (str, Bool) -> [Tag str]
optEntityData (str
a, ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
getEntityEnd ((Position, [Tag str]), [Out])
y)) [Tag str] -> [Tag str] -> [Tag str]
forall a. [a] -> [a] -> [a]
++ ((Position, [Tag str]), [Out]) -> [Tag str]
go ((((Position, [Tag str]), [Out]) -> Bool)
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. ((d, [a]) -> Bool) -> (d, [a]) -> (d, [a])
skip ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityEnd ((Position, [Tag str]), [Out])
y) 
            where (y :: ((Position, [Tag str]), [Out])
y,a :: str
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall c'.
IsString c' =>
((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsStr (((Position, [Tag str]), [Out])
 -> (((Position, [Tag str]), [Out]), str))
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x
        go x :: ((Position, [Tag str]), [Out])
x | ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityNumHex ((Position, [Tag str]), [Out])
x = ((Position, [Tag str]), [Out]) -> [Tag str] -> [Tag str]
forall b b str. ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((Position, [Tag str]), [Out])
x ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ str -> Tag str
forall str. str -> Tag str
TagText (Char -> str
forall a. StringLike a => Char -> a
fromChar (Char -> str) -> Char -> str
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> String -> Char
forall a. (a, [Out]) -> String -> Char
entityChr ((Position, [Tag str]), [Out])
x String
a) Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: ((Position, [Tag str]), [Out]) -> [Tag str]
go ((((Position, [Tag str]), [Out]) -> Bool)
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. ((d, [a]) -> Bool) -> (d, [a]) -> (d, [a])
skip ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityEnd ((Position, [Tag str]), [Out])
y)
            where (y :: ((Position, [Tag str]), [Out])
y,a :: String
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
chars (((Position, [Tag str]), [Out])
 -> (((Position, [Tag str]), [Out]), String))
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x
        go x :: ((Position, [Tag str]), [Out])
x | Just a :: String
a <- ((Position, [Tag str]), [Out]) -> Maybe String
forall a. (a, [Out]) -> Maybe String
fromWarn ((Position, [Tag str]), [Out])
x = if Bool
optTagWarning then ((Position, [Tag str]), [Out]) -> [Tag str] -> [Tag str]
forall b b str. ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((Position, [Tag str]), [Out])
x ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ str -> Tag str
forall str. str -> Tag str
TagWarning (String -> str
forall a. IsString a => String -> a
fromString String
a) Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: ((Position, [Tag str]), [Out]) -> [Tag str]
go (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x) else ((Position, [Tag str]), [Out]) -> [Tag str]
go (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x)
        go x :: ((Position, [Tag str]), [Out])
x | ((Position, [Tag str]), [Out]) -> Bool
forall a a. (a, [a]) -> Bool
isEof ((Position, [Tag str]), [Out])
x = []

        atts :: ((Position,[Tag str]),[Out]) -> ( ((Position,[Tag str]),[Out]) , [(str,str)] )
        atts :: ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), [Attribute str])
atts x :: ((Position, [Tag str]), [Out])
x | ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isAttName ((Position, [Tag str]), [Out])
x = ([Attribute str] -> [Attribute str])
-> (((Position, [Tag str]), [Out]), [Attribute str])
-> (((Position, [Tag str]), [Out]), [Attribute str])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((str
a,str
b)Attribute str -> [Attribute str] -> [Attribute str]
forall a. a -> [a] -> [a]
:) ((((Position, [Tag str]), [Out]), [Attribute str])
 -> (((Position, [Tag str]), [Out]), [Attribute str]))
-> (((Position, [Tag str]), [Out]), [Attribute str])
-> (((Position, [Tag str]), [Out]), [Attribute str])
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), [Attribute str])
atts ((Position, [Tag str]), [Out])
z
            where (y :: ((Position, [Tag str]), [Out])
y,a :: str
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall c'.
IsString c' =>
((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsStr (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x)
                  (z :: ((Position, [Tag str]), [Out])
z,b :: str
b) = if ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isAttVal ((Position, [Tag str]), [Out])
y then ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall c'.
IsString c' =>
((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsEntsStr (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
y) else (((Position, [Tag str]), [Out])
y, str
forall a. StringLike a => a
empty)
        atts x :: ((Position, [Tag str]), [Out])
x | ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isAttVal ((Position, [Tag str]), [Out])
x = ([Attribute str] -> [Attribute str])
-> (((Position, [Tag str]), [Out]), [Attribute str])
-> (((Position, [Tag str]), [Out]), [Attribute str])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((str
forall a. StringLike a => a
empty,str
a)Attribute str -> [Attribute str] -> [Attribute str]
forall a. a -> [a] -> [a]
:) ((((Position, [Tag str]), [Out]), [Attribute str])
 -> (((Position, [Tag str]), [Out]), [Attribute str]))
-> (((Position, [Tag str]), [Out]), [Attribute str])
-> (((Position, [Tag str]), [Out]), [Attribute str])
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), [Attribute str])
atts ((Position, [Tag str]), [Out])
y
            where (y :: ((Position, [Tag str]), [Out])
y,a :: str
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall c'.
IsString c' =>
((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsEntsStr (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x)
        atts x :: ((Position, [Tag str]), [Out])
x = (((Position, [Tag str]), [Out])
x, [])

        -- chars
        chars :: ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
chars x :: ((Position, [Tag str]), [Out])
x = Bool
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
charss Bool
False ((Position, [Tag str]), [Out])
x
        charsStr :: ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsStr x :: ((Position, [Tag str]), [Out])
x = (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall a. a -> a
id (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out]))
-> (String -> c')
-> (((Position, [Tag str]), [Out]), String)
-> (((Position, [Tag str]), [Out]), c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> c'
forall a. IsString a => String -> a
fromString) ((((Position, [Tag str]), [Out]), String)
 -> (((Position, [Tag str]), [Out]), c'))
-> (((Position, [Tag str]), [Out]), String)
-> (((Position, [Tag str]), [Out]), c')
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
chars ((Position, [Tag str]), [Out])
x
        charsEntsStr :: ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsEntsStr x :: ((Position, [Tag str]), [Out])
x = (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall a. a -> a
id (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out]))
-> (String -> c')
-> (((Position, [Tag str]), [Out]), String)
-> (((Position, [Tag str]), [Out]), c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> c'
forall a. IsString a => String -> a
fromString) ((((Position, [Tag str]), [Out]), String)
 -> (((Position, [Tag str]), [Out]), c'))
-> (((Position, [Tag str]), [Out]), String)
-> (((Position, [Tag str]), [Out]), c')
forall a b. (a -> b) -> a -> b
$ Bool
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
charss Bool
True ((Position, [Tag str]), [Out])
x

        -- loop round collecting characters, if the b is set including entity
        charss :: Bool -> ((Position,[Tag str]),[Out]) -> ( ((Position,[Tag str]),[Out]) , String)
        charss :: Bool
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
charss t :: Bool
t x :: ((Position, [Tag str]), [Out])
x | Just a :: Char
a <- ((Position, [Tag str]), [Out]) -> Maybe Char
forall a. (a, [Out]) -> Maybe Char
fromChr ((Position, [Tag str]), [Out])
x = (((Position, [Tag str]), [Out])
y, Char
aChar -> ShowS
forall a. a -> [a] -> [a]
:String
b)
            where (y :: ((Position, [Tag str]), [Out])
y,b :: String
b) = Bool
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
charss Bool
t (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x)
        charss t :: Bool
t x :: ((Position, [Tag str]), [Out])
x | Bool
t, ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityName ((Position, [Tag str]), [Out])
x = ShowS
-> (((Position, [Tag str]), [Out]), String)
-> (((Position, [Tag str]), [Out]), String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (str -> String
forall a. StringLike a => a -> String
toString str
n String -> ShowS
forall a. [a] -> [a] -> [a]
++) ((((Position, [Tag str]), [Out]), String)
 -> (((Position, [Tag str]), [Out]), String))
-> (((Position, [Tag str]), [Out]), String)
-> (((Position, [Tag str]), [Out]), String)
forall a b. (a -> b) -> a -> b
$ Bool
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
charss Bool
t (((Position, [Tag str]), [Out])
 -> (((Position, [Tag str]), [Out]), String))
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
forall a b. (a -> b) -> a -> b
$ [Tag str]
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall (t :: * -> *) str b.
Foldable t =>
t (Tag str)
-> ((Position, [Tag str]), b) -> ((Position, [Tag str]), b)
addWarns [Tag str]
m ((Position, [Tag str]), [Out])
z
            where (y :: ((Position, [Tag str]), [Out])
y,a :: str
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall c'.
IsString c' =>
((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), c')
charsStr (((Position, [Tag str]), [Out])
 -> (((Position, [Tag str]), [Out]), str))
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), str)
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x
                  b :: Bool
b = ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
getEntityEnd ((Position, [Tag str]), [Out])
y
                  z :: ((Position, [Tag str]), [Out])
z = (((Position, [Tag str]), [Out]) -> Bool)
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. ((d, [a]) -> Bool) -> (d, [a]) -> (d, [a])
skip ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityEnd ((Position, [Tag str]), [Out])
y
                  (n :: str
n,m :: [Tag str]
m) = (str, Bool) -> (str, [Tag str])
optEntityAttrib (str
a,Bool
b)
        charss t :: Bool
t x :: ((Position, [Tag str]), [Out])
x | Bool
t, ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityNumHex ((Position, [Tag str]), [Out])
x = ShowS
-> (((Position, [Tag str]), [Out]), String)
-> (((Position, [Tag str]), [Out]), String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((Position, [Tag str]), [Out]) -> String -> Char
forall a. (a, [Out]) -> String -> Char
entityChr ((Position, [Tag str]), [Out])
x String
aChar -> ShowS
forall a. a -> [a] -> [a]
:) ((((Position, [Tag str]), [Out]), String)
 -> (((Position, [Tag str]), [Out]), String))
-> (((Position, [Tag str]), [Out]), String)
-> (((Position, [Tag str]), [Out]), String)
forall a b. (a -> b) -> a -> b
$ Bool
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
charss Bool
t ((Position, [Tag str]), [Out])
z
            where (y :: ((Position, [Tag str]), [Out])
y,a :: String
a) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
chars (((Position, [Tag str]), [Out])
 -> (((Position, [Tag str]), [Out]), String))
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x
                  z :: ((Position, [Tag str]), [Out])
z = (((Position, [Tag str]), [Out]) -> Bool)
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. ((d, [a]) -> Bool) -> (d, [a]) -> (d, [a])
skip ((Position, [Tag str]), [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityEnd ((Position, [Tag str]), [Out])
y
        charss t :: Bool
t ((_,w :: [Tag str]
w),Pos p :: Position
p:xs :: [Out]
xs) = Bool
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
charss Bool
t ((Position
p,[Tag str]
w),[Out]
xs)
        charss t :: Bool
t x :: ((Position, [Tag str]), [Out])
x | Just a :: String
a <- ((Position, [Tag str]), [Out]) -> Maybe String
forall a. (a, [Out]) -> Maybe String
fromWarn ((Position, [Tag str]), [Out])
x = Bool
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
charss Bool
t (((Position, [Tag str]), [Out])
 -> (((Position, [Tag str]), [Out]), String))
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
forall a b. (a -> b) -> a -> b
$ (if Bool
optTagWarning then [Tag str]
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall (t :: * -> *) str b.
Foldable t =>
t (Tag str)
-> ((Position, [Tag str]), b) -> ((Position, [Tag str]), b)
addWarns [str -> Tag str
forall str. str -> Tag str
TagWarning (str -> Tag str) -> str -> Tag str
forall a b. (a -> b) -> a -> b
$ String -> str
forall a. IsString a => String -> a
fromString String
a] else ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall a. a -> a
id) (((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out]))
-> ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]), [Out]) -> ((Position, [Tag str]), [Out])
forall d a. (d, [a]) -> (d, [a])
next ((Position, [Tag str]), [Out])
x
        charss t :: Bool
t x :: ((Position, [Tag str]), [Out])
x = (((Position, [Tag str]), [Out])
x, [])

        -- utility functions
        next :: (d, [a]) -> (d, [a])
next x :: (d, [a])
x = ([a] -> [a]) -> (d, [a]) -> (d, [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop 1) (d, [a])
x
        skip :: ((d, [a]) -> Bool) -> (d, [a]) -> (d, [a])
skip f :: (d, [a]) -> Bool
f x :: (d, [a])
x = Bool -> (d, [a]) -> (d, [a])
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((d, [a]) -> Bool
forall a a. (a, [a]) -> Bool
isEof (d, [a])
x Bool -> Bool -> Bool
|| (d, [a]) -> Bool
f (d, [a])
x) ((d, [a]) -> (d, [a])
forall d a. (d, [a]) -> (d, [a])
next (d, [a])
x)
        addWarns :: t (Tag str)
-> ((Position, [Tag str]), b) -> ((Position, [Tag str]), b)
addWarns ws :: t (Tag str)
ws x :: ((Position, [Tag str]), b)
x@((p :: Position
p,w :: [Tag str]
w),y :: b
y) = ((Position
p, [Tag str] -> [Tag str]
forall a. [a] -> [a]
reverse (((Position, [Tag str]), b) -> t (Tag str) -> [Tag str]
forall (t :: * -> *) b b str.
Foldable t =>
((Position, b), b) -> t (Tag str) -> [Tag str]
poss ((Position, [Tag str]), b)
x t (Tag str)
ws) [Tag str] -> [Tag str] -> [Tag str]
forall a. [a] -> [a] -> [a]
++ [Tag str]
w), b
y)
        pos :: ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((p :: Position
p,_),_) rest :: [Tag str]
rest = if Bool
optTagPosition then Position -> Tag str
forall str. Position -> Tag str
tagPosition Position
p Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: [Tag str]
rest else [Tag str]
rest
        warn :: ((Position, b), b) -> String -> [Tag str] -> [Tag str]
warn x :: ((Position, b), b)
x s :: String
s rest :: [Tag str]
rest = if Bool
optTagWarning then ((Position, b), b) -> [Tag str] -> [Tag str]
forall b b str. ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((Position, b), b)
x ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ str -> Tag str
forall str. str -> Tag str
TagWarning (String -> str
forall a. IsString a => String -> a
fromString String
s) Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: [Tag str]
rest else [Tag str]
rest
        poss :: ((Position, b), b) -> t (Tag str) -> [Tag str]
poss x :: ((Position, b), b)
x = (Tag str -> [Tag str]) -> t (Tag str) -> [Tag str]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\w :: Tag str
w -> ((Position, b), b) -> [Tag str] -> [Tag str]
forall b b str. ((Position, b), b) -> [Tag str] -> [Tag str]
pos ((Position, b), b)
x [Tag str
w]) 


entityChr :: (a, [Out]) -> String -> Char
entityChr x :: (a, [Out])
x s :: String
s | (a, [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityNum (a, [Out])
x = Integer -> Char
chr_ (Integer -> Char) -> Integer -> Char
forall a b. (a -> b) -> a -> b
$ String -> Integer
forall a. Read a => String -> a
read String
s
              | (a, [Out]) -> Bool
forall a. (a, [Out]) -> Bool
isEntityHex (a, [Out])
x = Integer -> Char
chr_ (Integer -> Char) -> Integer -> Char
forall a b. (a -> b) -> a -> b
$ (Integer, String) -> Integer
forall a b. (a, b) -> a
fst ((Integer, String) -> Integer) -> (Integer, String) -> Integer
forall a b. (a -> b) -> a -> b
$ [(Integer, String)] -> (Integer, String)
forall a. [a] -> a
head ([(Integer, String)] -> (Integer, String))
-> [(Integer, String)] -> (Integer, String)
forall a b. (a -> b) -> a -> b
$ ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex String
s
    where chr_ :: Integer -> Char
chr_ x :: Integer
x | (Integer, Integer) -> Integer -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
forall a. Bounded a => a
minBound, Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
forall a. Bounded a => a
maxBound) Integer
x = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
x
                 | Bool
otherwise = '?'


isEof :: (a, [a]) -> Bool
isEof (_,[]) = Bool
True; isEof _ = Bool
False
isChar :: (a, [Out]) -> Bool
isChar (_,Char{}:_) = Bool
True; isChar _ = Bool
False
isTag :: (a, [Out]) -> Bool
isTag (_,Tag{}:_) = Bool
True; isTag _ = Bool
False
isTagShut :: (a, [Out]) -> Bool
isTagShut (_,TagShut{}:_) = Bool
True; isTagShut _ = Bool
False
isAttName :: (a, [Out]) -> Bool
isAttName (_,AttName{}:_) = Bool
True; isAttName _ = Bool
False
isAttVal :: (a, [Out]) -> Bool
isAttVal (_,AttVal{}:_) = Bool
True; isAttVal _ = Bool
False
isTagEnd :: (a, [Out]) -> Bool
isTagEnd (_,TagEnd{}:_) = Bool
True; isTagEnd _ = Bool
False
isTagEndClose :: (a, [Out]) -> Bool
isTagEndClose (_,TagEndClose{}:_) = Bool
True; isTagEndClose _ = Bool
False
isComment :: (a, [Out]) -> Bool
isComment (_,Comment{}:_) = Bool
True; isComment _ = Bool
False
isCommentEnd :: (a, [Out]) -> Bool
isCommentEnd (_,CommentEnd{}:_) = Bool
True; isCommentEnd _ = Bool
False
isEntityName :: (a, [Out]) -> Bool
isEntityName (_,EntityName{}:_) = Bool
True; isEntityName _ = Bool
False
isEntityNumHex :: (a, [Out]) -> Bool
isEntityNumHex (_,EntityNum{}:_) = Bool
True; isEntityNumHex (_,EntityHex{}:_) = Bool
True; isEntityNumHex _ = Bool
False
isEntityNum :: (a, [Out]) -> Bool
isEntityNum (_,EntityNum{}:_) = Bool
True; isEntityNum _ = Bool
False
isEntityHex :: (a, [Out]) -> Bool
isEntityHex (_,EntityHex{}:_) = Bool
True; isEntityHex _ = Bool
False
isEntityEnd :: (a, [Out]) -> Bool
isEntityEnd (_,EntityEnd{}:_) = Bool
True; isEntityEnd _ = Bool
False
isWarn :: (a, [Out]) -> Bool
isWarn (_,Warn{}:_) = Bool
True; isWarn _ = Bool
False

fromChr :: (a, [Out]) -> Maybe Char
fromChr (_,Char x :: Char
x:_) = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x ; fromChr _ = Maybe Char
forall a. Maybe a
Nothing
fromWarn :: (a, [Out]) -> Maybe String
fromWarn (_,Warn x :: String
x:_) = String -> Maybe String
forall a. a -> Maybe a
Just String
x ; fromWarn _ = Maybe String
forall a. Maybe a
Nothing

getEntityEnd :: (a, [Out]) -> Bool
getEntityEnd (_,EntityEnd b :: Bool
b:_) = Bool
b


-- Merge all adjacent TagText bits
tagTextMerge :: StringLike str => [Tag str] -> [Tag str]
tagTextMerge :: [Tag str] -> [Tag str]
tagTextMerge (TagText x :: str
x:xs :: [Tag str]
xs) = str -> Tag str
forall str. str -> Tag str
TagText ([str] -> str
forall a. StringLike a => [a] -> a
strConcat (str
xstr -> [str] -> [str]
forall a. a -> [a] -> [a]
:[str]
a)) Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: [Tag str] -> [Tag str]
forall str. StringLike str => [Tag str] -> [Tag str]
tagTextMerge [Tag str]
b
    where
        (a :: [str]
a,b :: [Tag str]
b) = [Tag str] -> ([str], [Tag str])
forall a. [Tag a] -> ([a], [Tag a])
f [Tag str]
xs

        -- additional brackets on 3 lines to work around HSE 1.3.2 bugs with pattern fixities
        f :: [Tag a] -> ([a], [Tag a])
f (TagText x :: a
x:xs :: [Tag a]
xs) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a,[Tag a]
b)
            where (a :: [a]
a,b :: [Tag a]
b) = [Tag a] -> ([a], [Tag a])
f [Tag a]
xs
        f (TagPosition{}:(x :: Tag a
x@TagText{}:xs :: [Tag a]
xs)) = [Tag a] -> ([a], [Tag a])
f ([Tag a] -> ([a], [Tag a])) -> [Tag a] -> ([a], [Tag a])
forall a b. (a -> b) -> a -> b
$ Tag a
x Tag a -> [Tag a] -> [Tag a]
forall a. a -> [a] -> [a]
: [Tag a]
xs
        f x :: [Tag a]
x = [Tag a] -> ([Tag a] -> [Tag a]) -> [Tag a] -> ([a], [Tag a])
g [Tag a]
x [Tag a] -> [Tag a]
forall a. a -> a
id [Tag a]
x

        g :: [Tag a] -> ([Tag a] -> [Tag a]) -> [Tag a] -> ([a], [Tag a])
g o :: [Tag a]
o op :: [Tag a] -> [Tag a]
op (p :: Tag a
p@TagPosition{}:(w :: Tag a
w@TagWarning{}:xs :: [Tag a]
xs)) = [Tag a] -> ([Tag a] -> [Tag a]) -> [Tag a] -> ([a], [Tag a])
g [Tag a]
o ([Tag a] -> [Tag a]
op ([Tag a] -> [Tag a]) -> ([Tag a] -> [Tag a]) -> [Tag a] -> [Tag a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag a
pTag a -> [Tag a] -> [Tag a]
forall a. a -> [a] -> [a]
:) ([Tag a] -> [Tag a]) -> ([Tag a] -> [Tag a]) -> [Tag a] -> [Tag a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag a
wTag a -> [Tag a] -> [Tag a]
forall a. a -> [a] -> [a]
:)) [Tag a]
xs
        g o :: [Tag a]
o op :: [Tag a] -> [Tag a]
op (w :: Tag a
w@TagWarning{}:xs :: [Tag a]
xs) = [Tag a] -> ([Tag a] -> [Tag a]) -> [Tag a] -> ([a], [Tag a])
g [Tag a]
o ([Tag a] -> [Tag a]
op ([Tag a] -> [Tag a]) -> ([Tag a] -> [Tag a]) -> [Tag a] -> [Tag a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag a
wTag a -> [Tag a] -> [Tag a]
forall a. a -> [a] -> [a]
:)) [Tag a]
xs
        g o :: [Tag a]
o op :: [Tag a] -> [Tag a]
op (p :: Tag a
p@TagPosition{}:(x :: Tag a
x@TagText{}:xs :: [Tag a]
xs)) = [Tag a] -> ([a], [Tag a])
f ([Tag a] -> ([a], [Tag a])) -> [Tag a] -> ([a], [Tag a])
forall a b. (a -> b) -> a -> b
$ Tag a
p Tag a -> [Tag a] -> [Tag a]
forall a. a -> [a] -> [a]
: Tag a
x Tag a -> [Tag a] -> [Tag a]
forall a. a -> [a] -> [a]
: [Tag a] -> [Tag a]
op [Tag a]
xs
        g o :: [Tag a]
o op :: [Tag a] -> [Tag a]
op (x :: Tag a
x@TagText{}:xs :: [Tag a]
xs) = [Tag a] -> ([a], [Tag a])
f ([Tag a] -> ([a], [Tag a])) -> [Tag a] -> ([a], [Tag a])
forall a b. (a -> b) -> a -> b
$ Tag a
x Tag a -> [Tag a] -> [Tag a]
forall a. a -> [a] -> [a]
: [Tag a] -> [Tag a]
op [Tag a]
xs
        g o :: [Tag a]
o op :: [Tag a] -> [Tag a]
op _ = ([], [Tag a]
o)

tagTextMerge (x :: Tag str
x:xs :: [Tag str]
xs) = Tag str
x Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: [Tag str] -> [Tag str]
forall str. StringLike str => [Tag str] -> [Tag str]
tagTextMerge [Tag str]
xs
tagTextMerge [] = []