{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Rank2Types #-}
{-|
Module : Text.HTML.Rules
Description : Transform an HTML structure by sets of rules.
Copyright : (c) Kyle Carter, 2014
License : BSD3
Maintainer : kylcarte@gmail.com
Stability : experimental
-}
module Text.HTML.Rules
( module Text.HTML.Rules
, module Text.HTML.Rules.Types
, module Text.HTML.Rules.Apply
, module Text.HTML.Rules.Query
, module Text.HTML.Rules.Transform
, module Text.HTML.Rules.Attributes
) where
import Text.HTML.Rules.Types
import Text.HTML.Rules.Apply
import Text.HTML.Rules.Query
import Text.HTML.Rules.Transform
import Text.HTML.Rules.Attributes
import Control.Applicative hiding (optional)
import Control.Monad (forM_)
import Data.Maybe (fromMaybe)
-- * Example
-- | an example set of rules.
testRules :: (Applicative m, Monad m) => [FragmentRule m]
testRules =
[ ( tag "row" -- <- match tags with the 'row' name.
, one $ do -- <- return a single fragment of HTML.
_Tag *-> "div" -- <- replace the tag name with 'div'.
_Attrs $-> addClass "row" -- <- add 'row' to the list of classes,
-- keeping all existing attributes.
)
------------------------------------------------------------------------------
, ( tag "col" -- <- match 'col' tags.
, one $ do --
_Tag *-> "div" --
_Attrs $-> do --
w <- required $ _Attr "width" -- <- pull out the 'width' attribute,
-- failing if it isn't present.
ms <- optional $ _Attr "size" -- <- pull out the 'size' attribute,
-- if it is present.
addClass $ concat -- <- add a Bootstrap-friendly
-- class, e.g. 'col-md-3'.
[ "col-"
, fromMaybe "xs" ms
, "-"
, w
]
)
------------------------------------------------------------------------------
, ( tags ["ol","ul"] -- <- match tags with either the 'ol'
, one $ do -- or 'ul' name.
_Attrs $-> addClass "list-unstyled" -- <- add 'list-unstyled' to its list
) -- of classes.
------------------------------------------------------------------------------
, ( tag "expand" -- <- match 'expand' tags.
, onEach (_Attrs $-> addClass "bar") -- <- add 'bar' to the list of classes
$ return -- of each of the following:
[ Leaf "expanded" [("class","foo")] -- * a leaf tag, with no descendents,
, Branch "expanded-also" [] -- * a branch tag, with one descendent,
[ Leaf "yet-another" [] --
] --
, Text "some text" -- * a text node.
]
)
]
runTestExamples :: IO ()
runTestExamples = do
putStrLn "Examples:\n"
forM_ examples $ \s -> do
s' <- applyHTMLRules testRules s
putStrLn $ unlines [ s , "===>" , s' ]
examples :: [String]
examples =
[ "some text
"
, "just some text"
, "nesteda bit more text
"
, ""
]