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 (Show,Eq,Ord)
nullPosition :: Position
nullPosition = Position 1 1
positionString :: Position -> String -> Position
positionString = foldl' positionChar
positionChar :: Position -> Char -> Position
positionChar (Position r c) x = case x of
'\n' -> Position (r+1) 1
'\t' -> Position r (c + 8 mod (c1) 8)
_ -> Position r (c+1)
tagPosition :: Position -> Tag str
tagPosition (Position r c) = TagPosition r c
data Tag str =
TagOpen str [Attribute str]
| TagClose str
| TagText str
| TagComment str
| TagWarning str
| TagPosition !Row !Column
deriving (Show, Eq, Ord, Data, Typeable)
instance Functor Tag where
fmap f (TagOpen x y) = TagOpen (f x) [(f a, f b) | (a,b) <- y]
fmap f (TagClose x) = TagClose (f x)
fmap f (TagText x) = TagText (f x)
fmap f (TagComment x) = TagComment (f x)
fmap f (TagWarning x) = TagWarning (f x)
fmap f (TagPosition x y) = TagPosition x y
isTagOpen :: Tag str -> Bool
isTagOpen (TagOpen {}) = True; isTagOpen _ = False
isTagClose :: Tag str -> Bool
isTagClose (TagClose {}) = True; isTagClose _ = False
isTagText :: Tag str -> Bool
isTagText (TagText {}) = True; isTagText _ = False
maybeTagText :: Tag str -> Maybe str
maybeTagText (TagText x) = Just x
maybeTagText _ = Nothing
fromTagText :: Show str => Tag str -> str
fromTagText (TagText x) = x
fromTagText x = error $ "(" ++ show x ++ ") is not a TagText"
innerText :: StringLike str => [Tag str] -> str
innerText = strConcat . mapMaybe maybeTagText
isTagWarning :: Tag str -> Bool
isTagWarning (TagWarning {}) = True; isTagWarning _ = False
maybeTagWarning :: Tag str -> Maybe str
maybeTagWarning (TagWarning x) = Just x
maybeTagWarning _ = Nothing
isTagPosition :: Tag str -> Bool
isTagPosition TagPosition{} = True; isTagPosition _ = False
fromAttrib :: (Show str, Eq str, StringLike str) => str -> Tag str -> str
fromAttrib att (TagOpen _ atts) = fromMaybe empty $ lookup att atts
fromAttrib _ x = error ("(" ++ show x ++ ") is not a TagOpen")
isTagOpenName :: Eq str => str -> Tag str -> Bool
isTagOpenName name (TagOpen n _) = n == name
isTagOpenName _ _ = False
isTagCloseName :: Eq str => str -> Tag str -> Bool
isTagCloseName name (TagClose n) = n == name
isTagCloseName _ _ = False
isTagComment :: Tag str -> Bool
isTagComment TagComment {} = True; isTagComment _ = False