{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module : Text.Taggy.Types
-- Copyright : (c) 2014 Alp Mestanogullari
-- License : BSD3
-- Maintainer : alpmestan@gmail.com
-- Stability : experimental
--
-- Core types of /taggy/.
module Text.Taggy.Types
( -- * 'Tag' type
Tag(..)
, tname
, isTagOpen
, isTagClose
, isTagText
, isTagComment
, isTagScript
, isTagStyle
, tagsNamed
, -- * 'Attribute's
Attribute(..)
, attrs
, attrKey
, attrValue
, -- * A small difference list implementation
L
, emptyL
, appL
, insertL
, singletonL
, toListL
) where
import Data.Text (Text, toCaseFold)
-- | An attribute is just an attribute name
-- and an attribute value.
data Attribute = Attribute !Text !Text
deriving (Show, Eq)
-- | Get the attributes of a 'Tag'.
attrs :: Tag -> [Attribute]
attrs (TagOpen _ as _) = as
attrs _ = []
-- | Get the name of an 'Attribute'.
attrKey :: Attribute -> Text
attrKey (Attribute k _) = k
-- | Get the value of an 'Attribute'.
attrValue :: Attribute -> Text
attrValue (Attribute _ v) = v
-- | A 'Tag' can be one of the following types of tags:
--
-- * an opening tag that has a name, a list of attributes, and whether
-- it is a self-closing tag or not
-- * a closing tag with the name of the tag
-- * some raw 'Text'
-- * an HTML comment tag
-- * a @@ tag
-- * a @@ tag
--
-- The latter two are useful to be considered
-- separately in the parser and also lets you
-- collect these bits quite easily.
data Tag = TagOpen !Text [Attribute] !Bool -- is it a self-closing tag?
| TagClose !Text
| TagText !Text
| TagComment !Text
| TagScript !Tag !Text !Tag
| TagStyle !Tag !Text !Tag
deriving (Show, Eq)
-- | Name of a 'Tag'.
--
-- > tname (TagClose "a") == "a"
tname :: Tag -> Text
tname (TagOpen n _ _) = n
tname (TagClose n) = n
tname (TagText _) = ""
tname (TagComment _) = ""
tname (TagScript _ _ _) = "script"
tname (TagStyle _ _ _) = "style"
-- | Is this 'Tag' an opening tag?
isTagOpen :: Tag -> Bool
isTagOpen (TagOpen _ _ _) = True
isTagOpen _ = False
-- | Is this 'Tag' a closing tag?
isTagClose :: Tag -> Bool
isTagClose (TagClose _) = True
isTagClose _ = False
-- | Is this 'Tag' just some flat text?
isTagText :: Tag -> Bool
isTagText (TagText _) = True
isTagText _ = False
-- | Is this 'Tag' an HTML comment tag?
isTagComment :: Tag -> Bool
isTagComment (TagComment _) = True
isTagComment _ = False
-- | Is this 'Tag' a @@ tag?
isTagScript :: Tag -> Bool
isTagScript (TagScript _ _ _) = True
isTagScript _ = False
-- | Is this 'Tag' a @@ tag?
isTagStyle :: Tag -> Bool
isTagStyle (TagStyle _ _ _) = True
isTagStyle _ = False
-- | Get all the (opening) tags with the given name
tagsNamed :: Text -> [Tag] -> [Tag]
tagsNamed nam = filter (named nam)
where named n (TagOpen t _ _) = toCaseFold n == toCaseFold t
named _ _ = False
newtype L a = L { list :: [a] -> [a] }
emptyL :: L a
emptyL = L $ const []
appL :: L a -> L a -> L a
appL (L l1) (L l2) = L $ l1 . l2
singletonL :: a -> L a
singletonL x = L (x:)
toListL :: L a -> [a]
toListL (L f) = f []
insertL :: a -> L a -> L a
insertL x (L f) = L $ (x:) . f