Types.hs

module Text.HTML.TagStream.Types where

import Control.Applicative (pure, (<$>), (<*>))
import Control.Arrow ((***))
import Data.Monoid (mappend, mconcat)
import Data.Foldable (Foldable(foldMap))
import Data.Traversable (Traversable(traverse), sequenceA)

type Attr' s = (s, s)

data Token' s = TagOpen s [Attr' s] Bool
              | TagClose s
              | Text s
              | Comment s
              | Special s s
              | Incomplete s
    deriving (Eq, Show)

data TagType = TagTypeClose
             | TagTypeSpecial
             | TagTypeNormal

instance Functor Token' where
    fmap f t = case t of
        (TagOpen x pairs b) -> TagOpen (f x) (map (f *** f) pairs) b
        (TagClose x)        -> TagClose (f x)
        (Text x)            -> Text (f x)
        (Comment x)         -> Comment (f x)
        (Special x y)       -> Special (f x) (f y)
        (Incomplete x)      -> Incomplete (f x)

instance Foldable Token' where
    foldMap f t = case t of
        (TagOpen x pairs _) -> f x `mappend` mconcat (map (\(a1, a2) -> f a1 `mappend` f a2) pairs)
        (TagClose x)        -> f x
        (Text x)            -> f x
        (Comment x)         -> f x
        (Special x y)       -> f x `mappend` f y
        (Incomplete x)      -> f x

instance Traversable Token' where
    traverse f t = case t of
        (TagOpen x pairs b) -> TagOpen <$> f x
                                       <*> sequenceA (map (\(a1, a2) -> (,) <$> f a1 <*> f a2) pairs)
                                       <*> pure b
        (TagClose x)        -> TagClose <$> f x
        (Text x)            -> Text <$> f x
        (Comment x)         -> Comment <$> f x
        (Special x y)       -> Special <$> f x <*> f y
        (Incomplete x)      -> Incomplete <$> f x