{-# LANGUAGE DeriveDataTypeable #-}
module Text.HTML.TagSoup.Type(
StringLike, Tag(..), Attribute, Row, Column,
Position(..), tagPosition, nullPosition, positionChar, positionString,
isTagOpen, isTagClose, isTagText, isTagWarning, isTagPosition,
isTagOpenName, isTagCloseName, isTagComment,
fromTagText, fromAttrib,
maybeTagText, maybeTagWarning,
innerText,
) where
import Data.List (foldl')
import Data.Maybe (fromMaybe, mapMaybe)
import Text.StringLike
import Data.Data(Data, Typeable)
type Attribute str = (str,str)
type Row = Int
type Column = Int
data Position = Position !Row !Column deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show,Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq,Eq Position
Eq Position =>
(Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
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
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord)
nullPosition :: Position
nullPosition :: Position
nullPosition = Int -> Int -> Position
Position 1 1
positionString :: Position -> String -> Position
positionString :: Position -> String -> Position
positionString = (Position -> Char -> Position) -> Position -> String -> Position
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Position -> Char -> Position
positionChar
positionChar :: Position -> Char -> Position
positionChar :: Position -> Char -> Position
positionChar (Position r :: Int
r c :: Int
c) x :: Char
x = case Char
x of
'\n' -> Int -> Int -> Position
Position (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) 1
'\t' -> Int -> Int -> Position
Position Int
r (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) 8)
_ -> Int -> Int -> Position
Position Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
tagPosition :: Position -> Tag str
tagPosition :: Position -> Tag str
tagPosition (Position r :: Int
r c :: Int
c) = Int -> Int -> Tag str
forall str. Int -> Int -> Tag str
TagPosition Int
r Int
c
data Tag str =
TagOpen str [Attribute str]
| TagClose str
| TagText str
| str
| TagWarning str
| TagPosition !Row !Column
deriving (Int -> Tag str -> ShowS
[Tag str] -> ShowS
Tag str -> String
(Int -> Tag str -> ShowS)
-> (Tag str -> String) -> ([Tag str] -> ShowS) -> Show (Tag str)
forall str. Show str => Int -> Tag str -> ShowS
forall str. Show str => [Tag str] -> ShowS
forall str. Show str => Tag str -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag str] -> ShowS
$cshowList :: forall str. Show str => [Tag str] -> ShowS
show :: Tag str -> String
$cshow :: forall str. Show str => Tag str -> String
showsPrec :: Int -> Tag str -> ShowS
$cshowsPrec :: forall str. Show str => Int -> Tag str -> ShowS
Show, Tag str -> Tag str -> Bool
(Tag str -> Tag str -> Bool)
-> (Tag str -> Tag str -> Bool) -> Eq (Tag str)
forall str. Eq str => Tag str -> Tag str -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag str -> Tag str -> Bool
$c/= :: forall str. Eq str => Tag str -> Tag str -> Bool
== :: Tag str -> Tag str -> Bool
$c== :: forall str. Eq str => Tag str -> Tag str -> Bool
Eq, Eq (Tag str)
Eq (Tag str) =>
(Tag str -> Tag str -> Ordering)
-> (Tag str -> Tag str -> Bool)
-> (Tag str -> Tag str -> Bool)
-> (Tag str -> Tag str -> Bool)
-> (Tag str -> Tag str -> Bool)
-> (Tag str -> Tag str -> Tag str)
-> (Tag str -> Tag str -> Tag str)
-> Ord (Tag str)
Tag str -> Tag str -> Bool
Tag str -> Tag str -> Ordering
Tag str -> Tag str -> Tag str
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 str. Ord str => Eq (Tag str)
forall str. Ord str => Tag str -> Tag str -> Bool
forall str. Ord str => Tag str -> Tag str -> Ordering
forall str. Ord str => Tag str -> Tag str -> Tag str
min :: Tag str -> Tag str -> Tag str
$cmin :: forall str. Ord str => Tag str -> Tag str -> Tag str
max :: Tag str -> Tag str -> Tag str
$cmax :: forall str. Ord str => Tag str -> Tag str -> Tag str
>= :: Tag str -> Tag str -> Bool
$c>= :: forall str. Ord str => Tag str -> Tag str -> Bool
> :: Tag str -> Tag str -> Bool
$c> :: forall str. Ord str => Tag str -> Tag str -> Bool
<= :: Tag str -> Tag str -> Bool
$c<= :: forall str. Ord str => Tag str -> Tag str -> Bool
< :: Tag str -> Tag str -> Bool
$c< :: forall str. Ord str => Tag str -> Tag str -> Bool
compare :: Tag str -> Tag str -> Ordering
$ccompare :: forall str. Ord str => Tag str -> Tag str -> Ordering
$cp1Ord :: forall str. Ord str => Eq (Tag str)
Ord, , Typeable)
instance Functor Tag where
fmap :: (a -> b) -> Tag a -> Tag b
fmap f :: a -> b
f (TagOpen x :: a
x y :: [Attribute a]
y) = b -> [Attribute b] -> Tag b
forall str. str -> [Attribute str] -> Tag str
TagOpen (a -> b
f a
x) [(a -> b
f a
a, a -> b
f a
b) | (a :: a
a,b :: a
b) <- [Attribute a]
y]
fmap f :: a -> b
f (TagClose x :: a
x) = b -> Tag b
forall str. str -> Tag str
TagClose (a -> b
f a
x)
fmap f :: a -> b
f (TagText x :: a
x) = b -> Tag b
forall str. str -> Tag str
TagText (a -> b
f a
x)
fmap f :: a -> b
f (TagComment x :: a
x) = b -> Tag b
forall str. str -> Tag str
TagComment (a -> b
f a
x)
fmap f :: a -> b
f (TagWarning x :: a
x) = b -> Tag b
forall str. str -> Tag str
TagWarning (a -> b
f a
x)
fmap f :: a -> b
f (TagPosition x :: Int
x y :: Int
y) = Int -> Int -> Tag b
forall str. Int -> Int -> Tag str
TagPosition Int
x Int
y
isTagOpen :: Tag str -> Bool
isTagOpen :: Tag str -> Bool
isTagOpen (TagOpen {}) = Bool
True; isTagOpen _ = Bool
False
isTagClose :: Tag str -> Bool
isTagClose :: Tag str -> Bool
isTagClose (TagClose {}) = Bool
True; isTagClose _ = Bool
False
isTagText :: Tag str -> Bool
isTagText :: Tag str -> Bool
isTagText (TagText {}) = Bool
True; isTagText _ = Bool
False
maybeTagText :: Tag str -> Maybe str
maybeTagText :: Tag str -> Maybe str
maybeTagText (TagText x :: str
x) = str -> Maybe str
forall a. a -> Maybe a
Just str
x
maybeTagText _ = Maybe str
forall a. Maybe a
Nothing
fromTagText :: Show str => Tag str -> str
fromTagText :: Tag str -> str
fromTagText (TagText x :: str
x) = str
x
fromTagText x :: Tag str
x = String -> str
forall a. HasCallStack => String -> a
error (String -> str) -> String -> str
forall a b. (a -> b) -> a -> b
$ "(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tag str -> String
forall a. Show a => a -> String
show Tag str
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") is not a TagText"
innerText :: StringLike str => [Tag str] -> str
innerText :: [Tag str] -> str
innerText = [str] -> str
forall a. StringLike a => [a] -> a
strConcat ([str] -> str) -> ([Tag str] -> [str]) -> [Tag str] -> str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag str -> Maybe str) -> [Tag str] -> [str]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tag str -> Maybe str
forall str. Tag str -> Maybe str
maybeTagText
isTagWarning :: Tag str -> Bool
isTagWarning :: Tag str -> Bool
isTagWarning (TagWarning {}) = Bool
True; isTagWarning _ = Bool
False
maybeTagWarning :: Tag str -> Maybe str
maybeTagWarning :: Tag str -> Maybe str
maybeTagWarning (TagWarning x :: str
x) = str -> Maybe str
forall a. a -> Maybe a
Just str
x
maybeTagWarning _ = Maybe str
forall a. Maybe a
Nothing
isTagPosition :: Tag str -> Bool
isTagPosition :: Tag str -> Bool
isTagPosition TagPosition{} = Bool
True; isTagPosition _ = Bool
False
fromAttrib :: (Show str, Eq str, StringLike str) => str -> Tag str -> str
fromAttrib :: str -> Tag str -> str
fromAttrib att :: str
att tag :: Tag str
tag = str -> Maybe str -> str
forall a. a -> Maybe a -> a
fromMaybe str
forall a. StringLike a => a
empty (Maybe str -> str) -> Maybe str -> str
forall a b. (a -> b) -> a -> b
$ str -> Tag str -> Maybe str
forall str. (Show str, Eq str) => str -> Tag str -> Maybe str
maybeAttrib str
att Tag str
tag
maybeAttrib :: (Show str, Eq str) => str -> Tag str -> Maybe str
maybeAttrib :: str -> Tag str -> Maybe str
maybeAttrib att :: str
att (TagOpen _ atts :: [Attribute str]
atts) = str -> [Attribute str] -> Maybe str
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup str
att [Attribute str]
atts
maybeAttrib _ x :: Tag str
x = String -> Maybe str
forall a. HasCallStack => String -> a
error ("(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tag str -> String
forall a. Show a => a -> String
show Tag str
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") is not a TagOpen")
isTagOpenName :: Eq str => str -> Tag str -> Bool
isTagOpenName :: str -> Tag str -> Bool
isTagOpenName name :: str
name (TagOpen n :: str
n _) = str
n str -> str -> Bool
forall a. Eq a => a -> a -> Bool
== str
name
isTagOpenName _ _ = Bool
False
isTagCloseName :: Eq str => str -> Tag str -> Bool
isTagCloseName :: str -> Tag str -> Bool
isTagCloseName name :: str
name (TagClose n :: str
n) = str
n str -> str -> Bool
forall a. Eq a => a -> a -> Bool
== str
name
isTagCloseName _ _ = Bool
False
isTagComment :: Tag str -> Bool
TagComment {} = Bool
True; isTagComment _ = Bool
False