{-# 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
$cshowsPrec :: Int -> Out -> ShowS
showsPrec :: Int -> Out -> ShowS
$cshow :: Out -> String
show :: Out -> String
$cshowList :: [Out] -> ShowS
showList :: [Out] -> ShowS
Show,Out -> Out -> Bool
(Out -> Out -> Bool) -> (Out -> Out -> Bool) -> Eq Out
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Out -> Out -> Bool
== :: Out -> Out -> Bool
$c/= :: Out -> Out -> Bool
/= :: Out -> Out -> Bool
Eq)

errSeen :: a -> Out
errSeen a
x = String -> Out
Warn (String -> Out) -> String -> Out
forall a b. (a -> b) -> a -> b
$ String
"Unexpected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
errWant :: a -> Out
errWant a
x = String -> Out
Warn (String -> Out) -> String -> Out
forall a b. (a -> b) -> a -> b
$ String
"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 Position
p String
text = Position
p Position -> S -> S
forall a b. a -> b -> b
`seq` S
res
    where res :: S
res = S{s :: S
s = S
res
                 ,tl :: S
tl = Position -> String -> S
expand (Position -> Char -> Position
positionChar Position
p (String -> Char
forall a. HasCallStack => [a] -> a
head String
text)) (ShowS
forall a. HasCallStack => [a] -> [a]
tail String
text)
                 ,hd :: Char
hd = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
text then Char
'\0' else String -> Char
forall a. HasCallStack => [a] -> a
head String
text
                 ,eof :: Bool
eof = String -> Bool
forall a. [a] -> 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 Position
p (Char
t:String
ext) (Char
s: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 Position
p 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 Position
_ String
_ String
_ = 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 Char
x [Out]
y = Char -> Out
Char Char
x Out -> [Out] -> [Out]
forall a. a -> [a] -> [a]
: [Out]
y
ampOut :: a -> [a] -> [a]
ampOut a
x [a]
y = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
y


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

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


output :: forall str . StringLike str => ParseOptions str -> [Out] -> [Tag str]
output :: forall str.
StringLike str =>
ParseOptions str -> [Out] -> [Tag str]
output ParseOptions{Bool
(str, Bool) -> [Tag str]
(str, Bool) -> (str, [Tag str])
optTagPosition :: Bool
optTagWarning :: Bool
optEntityData :: (str, Bool) -> [Tag str]
optEntityAttrib :: (str, Bool) -> (str, [Tag str])
optTagTextMerge :: Bool
optEntityAttrib :: forall str. ParseOptions str -> (str, Bool) -> (str, [Tag str])
optEntityData :: forall str. ParseOptions str -> (str, Bool) -> [Tag str]
optTagPosition :: forall str. ParseOptions str -> Bool
optTagTextMerge :: forall str. ParseOptions str -> Bool
optTagWarning :: forall str. ParseOptions str -> Bool
..} [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 ((Position
p,[Tag str]
ws),[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 ((Position
p,[Tag str]
ws),[Out]
xs) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Tag str] -> Bool
forall a. [a] -> 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 ((Position
p,[Tag str]
ws),Pos Position
p2:[Out]
xs) = ((Position, [Tag str]), [Out]) -> [Tag str]
go ((Position
p2,[Tag str]
ws),[Out]
xs)

        go ((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 (((Position, [Tag str]), [Out])
y,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 ((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 (((Position, [Tag str]), [Out])
y,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
                  (((Position, [Tag str]), [Out])
z,[Attribute str]
b) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), [Attribute str])
atts ((Position, [Tag str]), [Out])
y
        go ((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 a. [a] -> 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 String
"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 String
"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 (((Position, [Tag str]), [Out])
y,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
                  (((Position, [Tag str]), [Out])
z,[Attribute str]
b) = ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), [Attribute str])
atts ((Position, [Tag str]), [Out])
y
        go ((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 (((Position, [Tag str]), [Out])
y,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 ((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 (((Position, [Tag str]), [Out])
y,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 ((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 (((Position, [Tag str]), [Out])
y,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 ((Position, [Tag str]), [Out])
x | Just 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 ((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 ((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 b c d. (b -> c) -> (d, b) -> (d, c)
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 (((Position, [Tag str]), [Out])
y,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)
                  (((Position, [Tag str]), [Out])
z,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 ((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 b c d. (b -> c) -> (d, b) -> (d, c)
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 (((Position, [Tag str]), [Out])
y,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 ((Position, [Tag str]), [Out])
x = (((Position, [Tag str]), [Out])
x, [])

        -- chars
        chars :: ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
chars ((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 ((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 b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, 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 ((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 b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, 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 Bool
t ((Position, [Tag str]), [Out])
x | Just 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 (((Position, [Tag str]), [Out])
y,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 Bool
t ((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 b c d. (b -> c) -> (d, b) -> (d, c)
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 (((Position, [Tag str]), [Out])
y,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
                  (str
n,[Tag str]
m) = (str, Bool) -> (str, [Tag str])
optEntityAttrib (str
a,Bool
b)
        charss Bool
t ((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 b c d. (b -> c) -> (d, b) -> (d, c)
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 (((Position, [Tag str]), [Out])
y,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 Bool
t ((Position
_,[Tag str]
w),Pos Position
p:[Out]
xs) = Bool
-> ((Position, [Tag str]), [Out])
-> (((Position, [Tag str]), [Out]), String)
charss Bool
t ((Position
p,[Tag str]
w),[Out]
xs)
        charss Bool
t ((Position, [Tag str]), [Out])
x | Just 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 Bool
t ((Position, [Tag str]), [Out])
x = (((Position, [Tag str]), [Out])
x, [])

        -- utility functions
        next :: (d, [a]) -> (d, [a])
next (d, [a])
x = ([a] -> [a]) -> (d, [a]) -> (d, [a])
forall b c d. (b -> c) -> (d, b) -> (d, c)
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 Int
1) (d, [a])
x
        skip :: ((d, [a]) -> Bool) -> (d, [a]) -> (d, [a])
skip (d, [a]) -> Bool
f (d, [a])
x = Bool -> (d, [a]) -> (d, [a])
forall a. HasCallStack => 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 t (Tag str)
ws x :: ((Position, [Tag str]), b)
x@((Position
p,[Tag str]
w),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 ((Position
p,b
_),b
_) [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 ((Position, b), b)
x String
s [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 ((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 (\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 (a, [Out])
x 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. HasCallStack => [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_ 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 = Char
'?'


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

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

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


-- Merge all adjacent TagText bits
tagTextMerge :: StringLike str => [Tag str] -> [Tag str]
tagTextMerge :: forall str. StringLike str => [Tag str] -> [Tag str]
tagTextMerge (TagText str
x:[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
        ([str]
a,[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 a
x:[Tag a]
xs) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a,[Tag a]
b)
            where ([a]
a,[Tag a]
b) = [Tag a] -> ([a], [Tag a])
f [Tag a]
xs
        f (TagPosition{}:(x :: Tag a
x@TagText{}:[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 [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 [Tag a]
o [Tag a] -> [Tag a]
op (p :: Tag a
p@TagPosition{}:(w :: Tag a
w@TagWarning{}:[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 [Tag a]
o [Tag a] -> [Tag a]
op (w :: Tag a
w@TagWarning{}:[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 [Tag a]
o [Tag a] -> [Tag a]
op (p :: Tag a
p@TagPosition{}:(x :: Tag a
x@TagText{}:[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 [Tag a]
o [Tag a] -> [Tag a]
op (x :: Tag a
x@TagText{}:[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 [Tag a]
o [Tag a] -> [Tag a]
op [Tag a]
_ = ([], [Tag a]
o)

tagTextMerge (Tag str
x:[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 [] = []