diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2014, ???
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of ??? nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/html-rules.cabal b/html-rules.cabal
new file mode 100644
--- /dev/null
+++ b/html-rules.cabal
@@ -0,0 +1,38 @@
+
+name:                html-rules
+version:             0.1.0.0
+synopsis:            Perform traversals of HTML structures using sets of rules.
+description:         
+license:             BSD3
+license-file:        LICENSE
+author:              Kyle Carter
+maintainer:          Kyle Carter <kcarter@galois.com>
+copyright:           (c) Kyle Carter 2014, All rights reserved
+category:            HTML, Web, Text, Transformation
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Text.HTML.Rules
+                       ----
+                       Text.HTML.Rules.Types
+                       Text.HTML.Rules.Apply
+                       ----
+                       Text.HTML.Rules.Query
+                       ----
+                       Text.HTML.Rules.Transform
+                       Text.HTML.Rules.Attributes
+                       ----
+                       Text.HTML.Rules.Util
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:       base >=2 && < 5,
+                       lens >=4 && < 5,
+                       tagsoup >= 0.13,
+                       transformers >=0.2 && <0.4,
+                       mtl >=2 && <3
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall -fno-warn-unused-do-bind
+
diff --git a/src/Text/HTML/Rules.hs b/src/Text/HTML/Rules.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Rules.hs
@@ -0,0 +1,96 @@
+{-# 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 =
+  [ "<row>some text</row>"
+  , "just some text"
+  , "<row><col width=\"3\">nested</col>a bit more text</row>"
+  , "<expand class=\"these get lost in expansion\">"
+  ]
+
diff --git a/src/Text/HTML/Rules/Apply.hs b/src/Text/HTML/Rules/Apply.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Rules/Apply.hs
@@ -0,0 +1,106 @@
+{-# OPTIONS_HADDOCK show-extensions #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE Rank2Types #-}
+
+{-|
+Module      : Text.HTML.Rules.Apply
+Description : Functions for applying sets of rules.
+Copyright   : (c) Kyle Carter, 2014
+License     : BSD3
+Maintainer  : kylcarte@gmail.com
+Stability   : experimental
+-}
+
+module Text.HTML.Rules.Apply
+  ( _HTML
+  , onHTML
+  , applyHTMLRules
+  , applyHTMLRules'
+  , htmlRules
+  , htmlRules'
+  , joinRules
+  , rule
+  ) where
+
+import Text.HTML.Rules.Transform
+import Text.HTML.Rules.Types
+import Text.HTML.Rules.Util
+
+import Control.Lens
+import Control.Applicative hiding (optional)
+import Control.Monad.State
+
+import Text.HTML.TagSoup hiding (Tag)
+import Text.HTML.TagSoup.Tree
+
+
+-- | a parsing/rendering Isomorphism.
+_HTML :: Iso' String HTML
+_HTML = iso (tagTree . parseTags) (renderTags . flattenTree)
+
+-- | a traversal over HTML under parsing
+onHTML :: Functor m => (HTML -> m HTML) -> String -> m String
+onHTML = traverseOf _HTML
+
+-- | apply all rules, left to right, bottom up.
+applyHTMLRules :: (Applicative m, Monad m) => [FragmentRule m] -> String -> m String
+applyHTMLRules = traverseOf _HTML . htmlRules
+
+-- | appy all rules, left to right, top down.
+applyHTMLRules' :: (Applicative m, Monad m) => [FragmentRule m] -> String -> m String
+applyHTMLRules' = traverseOf _HTML . htmlRules'
+
+{-
+-- | apply all rules, left to right, bottom up.
+applyRules :: (Functor m, Monad m) => Iso s t a b -> [Rule m a b] -> s -> m t
+applyRules l = traverseOf l . rules_XXX
+
+-- | appy all rules, left to right, top down.
+applyRules' :: (Applicative m, Monad m) => Iso s t a b -> [Rule m a b] -> s -> m t
+applyRules' l = traverseOf l . rules_XXX
+
+rules_XXX :: Monad m => [Rule m a b] -> a -> m b
+rules_XXX = undefined
+-}
+
+-- | form a bottom-up traversal from a list of 'Rule's
+htmlRules :: (Applicative m, Monad m) => [FragmentRule m] -> HTML -> m HTML
+htmlRules (joinRules -> go) = (concat <$<) $ mapM $ \t ->
+  case t of
+    TagBranch _ _ ds -> do
+      ds' <- go ds
+      go1 $ t & _Desc .~ ds'
+    TagLeaf _ -> go1 t
+  where
+  go1 = go . one_
+
+-- | form a top-down traversal from a list of 'Rule's
+htmlRules' :: (Applicative m, Monad m) => [FragmentRule m] -> HTML -> m HTML
+htmlRules' (joinRules -> go) = (concat <$<) $ mapM $ \t ->
+  case t of
+    TagBranch {} -> mapM (traverseOf _Desc go) =<< go1 t
+    TagLeaf   {} -> go1 t
+  where
+  go1 = go . one_
+
+-- | join a list of 'Rule's into a traversal, left to right.
+joinRules :: (Applicative m, Monad m) => [FragmentRule m] -> HTML -> m HTML
+joinRules = concatEndo . map rule
+
+-- | make a traversal out of a single 'Rule'.
+-- the 'Trans'formation is applied iff the query predicate holds.
+rule :: (Applicative m, Monad m) => FragmentRule m -> HTML -> m HTML
+rule (q,m) = mapM go >$> concat
+  where
+  go x = do
+    b <- q x
+    if b then evalStateT m x
+         else return [x]
+
+{-
+  | q x  = evalStateT m x
+       | True = return [x]
+-}
+
diff --git a/src/Text/HTML/Rules/Attributes.hs b/src/Text/HTML/Rules/Attributes.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Rules/Attributes.hs
@@ -0,0 +1,58 @@
+{-# OPTIONS_HADDOCK show-extensions #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE Rank2Types #-}
+
+{-|
+Module      : Text.HTML.Rules.Attributes
+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.Attributes where
+
+import Text.HTML.Rules.Types
+import Text.HTML.Rules.Transform
+
+-- | add a single attribute key-value pair to a tag's attributes.
+addAttr :: Monad m => (AttrKey,AttrVal) -> Trans' m Attrs
+addAttr = with (:)
+
+-- | add multiple attributes at once.
+addAttrs :: Monad m => Attrs -> Trans' m Attrs
+addAttrs = with (++)
+
+-- | add an additional class value if the 'class' attribute is already
+-- present, or just the given value if it is absent.
+addClass :: Monad m => AttrVal -> Trans' m Attrs
+addClass c' = insertAttr "class" $ maybe c' (++ " " ++ c')
+
+-- | operate on an attribute's presence or absence.
+alterAttr :: Monad m => AttrKey -> (Maybe AttrVal -> Maybe AttrVal) -> Trans' m Attrs
+alterAttr k = alterOf (_Attr k) . mkAttr k
+
+-- | add an attribute that may or may not already be present.
+insertAttr :: Monad m => AttrKey -> (Maybe AttrVal -> AttrVal) -> Trans' m Attrs
+insertAttr k = insertOf (_Attr k) . mkAttr' k
+
+-- | update the value of an attribute, if it is present.
+-- does nothing if the attribute is absent.
+updateAttr :: Monad m => AttrKey -> (AttrVal -> AttrVal) -> Trans' m Attrs
+updateAttr k = updateOf (_Attr k) . mkAttr' k
+
+-- | either modify or remove an attribute, if it is present.
+-- does nothing if otherwise.
+adjustAttr :: Monad m => AttrKey -> (AttrVal -> Maybe AttrVal) -> Trans' m Attrs
+adjustAttr k = adjustOf (_Attr k) . mkAttr k
+
+mkAttr :: Functor f => AttrKey -> (a -> f AttrVal) -> a -> f (AttrKey, AttrVal)
+mkAttr k = (.) $ fmap ((,) k)
+
+mkAttr' :: AttrKey -> (a -> AttrVal) -> a -> (AttrKey, AttrVal)
+mkAttr' k = ((,) k .)
+
diff --git a/src/Text/HTML/Rules/Query.hs b/src/Text/HTML/Rules/Query.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Rules/Query.hs
@@ -0,0 +1,88 @@
+{-# OPTIONS_HADDOCK show-extensions #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE Rank2Types #-}
+
+{-|
+Module      : Text.HTML.Rules.Query
+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.Query where
+
+import Text.HTML.Rules.Types
+import Text.HTML.Rules.Util
+
+import Control.Applicative hiding (optional)
+import Data.List
+import Data.Maybe
+
+-- * Attribute-Specific Queries
+
+-- | match any of the given 'Name's.
+tags :: Applicative m => [Name] -> FragmentQuery m
+tags = or_ . map tag
+{-# INLINE tags #-}
+
+-- | match a 'Name'.
+tag :: Applicative m => Name -> FragmentQuery m
+tag t = pure . \case
+  Branch tg _ _ -> t == tg
+  Leaf   tg _   -> t == tg
+  _             -> False
+
+-- | match a 'Text' node.
+isText :: Applicative m => FragmentQuery m
+isText = pure . \case
+  Text _ -> True
+  _      -> False
+
+-- | match all nodes with a particular Attribute.
+hasAttr :: Applicative m => AttrKey -> FragmentQuery m
+hasAttr a = pure . \case
+  Branch _ (yes -> r) _ -> isJust r
+  Leaf   _ (yes -> r)   -> isJust r
+  _                     -> False
+  where
+  yes = find ((== a) . fst)
+
+-- * General Combinators
+
+true, false :: Applicative m => Query m a
+-- | always matches.
+true  = pure2 True
+-- | always fails.
+false = pure2 False
+
+-- ** Lifted Operations
+
+-- | logical disjunction of 'Query's.
+(.||.) :: Applicative m => Query m a -> Query m a -> Query m a
+(.||.) = liftAA2 (||)
+infixr 2 .||.
+
+-- | logical disjunction of a list of 'Query's.
+or_ :: Applicative m => [Query m a] -> Query m a
+or_ = foldr (.||.) false
+{-# INLINE or_ #-}
+
+-- | logical conjunction of 'Query's.
+(.&&.) :: Applicative m => Query m a -> Query m a -> Query m a
+(.&&.) = liftAA2 (&&)
+infixr 3 .&&.
+
+-- | logical conjunction of a list of 'Query's.
+and_ :: Applicative m => [Query m a] -> Query m a
+and_ = foldr (.&&.) true
+{-# INLINE and_ #-}
+
+-- | negate the result of a 'Query'.
+not_ :: Applicative m => Query m a -> Query m a
+not_ = liftAA not
+
diff --git a/src/Text/HTML/Rules/Transform.hs b/src/Text/HTML/Rules/Transform.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Rules/Transform.hs
@@ -0,0 +1,224 @@
+{-# OPTIONS_HADDOCK show-extensions #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE Rank2Types #-}
+
+{-|
+Module      : Text.HTML.Rules.Transform
+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.Transform where
+
+import Text.HTML.Rules.Types
+import Text.HTML.Rules.Util
+
+import Control.Lens
+import Control.Lens.Internal.Context
+import Control.Arrow (first)
+import Control.Monad.Trans.Class
+import Control.Monad.State
+import Data.List
+import Data.Maybe
+
+
+-- * Transformations
+-- {{{
+
+-- ** Prisms and Traversals
+-- {{{
+
+-- | A pattern match onto an opening @Tag@.
+_Open :: Prism' Fragment (Name,Attrs,Maybe Desc)
+_Open = prism'
+  (\(tg,as,mds) -> maybe (Leaf tg as) (Branch tg as) mds)
+  (\case
+    Branch tg as ds -> Just (tg,as,Just ds)
+    Leaf   tg as    -> Just (tg,as,Nothing)
+    _               -> Nothing)
+
+-- | A pattern match onto a text @Tag@.
+_Text :: Prism' Fragment String
+_Text = prism' Text $
+  \case
+    Text s -> Just s
+    _      -> Nothing
+
+-- | A traversal to a @Tag@'s name.
+_Tag :: Traversal' Fragment Name
+_Tag = _Open . _1
+
+-- | A traversal to a @Tag@'s Attributes.
+_Attrs :: Traversal' Fragment Attrs
+_Attrs = _Open . _2
+
+-- | A traversal to a @Tag@'s descendents.
+_Desc :: Traversal' Fragment Desc
+_Desc = _Open . _3 . _Just
+
+-- | A refining traversal to a particular attribute
+-- in a list of attributes.
+--
+-- A refining traversal is one that additionally gives the
+-- unmatched values. Used with 'on', this gives a stateful
+-- filtering, so that matched Attributes are removed by default
+-- from the attribute list.
+_Attr :: AttrKey -> Lens Attrs Attrs (Maybe AttrVal,Attrs) Attrs
+_Attr k = lens to_ from_
+  where
+  from_  = (++)
+  to_ as = case ys of
+    [(_,v)] -> (Just v  , ns)
+    _       -> (Nothing , as)
+    where
+    (ys,ns) = partition ((== k) . fst) as
+
+-- | give the first attribute satisfying some predicate. All other matching attributes
+-- are dropped from the list.
+_AttrWhere :: ((AttrKey,AttrVal) -> Bool) -> Traversal Attrs Attrs (Maybe (AttrKey,AttrVal),Attrs) Attrs
+_AttrWhere pr = _Partition pr . travPre (first listToMaybe)
+
+-- | give all attributes satisfying some predicate. The attribute list is refined
+-- to only the non-matching attributes.
+_AttrsWhere :: ((AttrKey,AttrVal) -> Bool) -> Traversal Attrs Attrs (Attrs,Attrs) Attrs
+_AttrsWhere = _Partition
+
+-- | give the first item from a list that satisfies a predicate. All other matches are
+-- kept in the list, along with the non-matching items.
+_First :: (a -> Bool) -> Traversal [a] b (Maybe a,[a]) b
+_First pr = travPre $ \as ->
+  let (ys,ns) = partition pr as
+  in case ys of
+    y : ys' -> (Just y  , ys' ++ ns)
+    _       -> (Nothing , as)
+
+-- | partition a list by a predicate. The satisfying items are given, and the others
+-- are kept in the list.
+_Partition :: (a -> Bool) -> Traversal [a] b ([a],[a]) b
+_Partition = travPre . partition
+
+-- }}}
+
+-- ** Traversal Construction
+-- {{{
+
+-- | build a traversal from an 'in' and an 'out' function. Analogous to "Data.Profunctor"'s @dimap@
+trav :: (s -> a) -> (b -> t) -> Traversal s t a b
+trav in_ out_ = (. in_) . (fmap out_ .)
+{-# INLINE trav #-}
+
+-- | build a traversal that only operates going in. Analogous to "Data.Profunctor"'s @lmap@.
+travPre  :: (s -> a) -> Traversal s t a t
+travPre = flip trav id
+{-# INLINE travPre #-}
+
+-- | build a traversal that only operates going out. Analogous to "Data.Profunctor"'s @rmap@.
+travPost :: (b -> t) -> Traversal s t s b
+travPost = trav id
+{-# INLINE travPost #-}
+
+-- | alter a 'Trans'formation to forget the refined state that it was
+-- carrying around.
+forget :: ATraversal s t (a,u) b -> Traversal s t a b
+forget f = cloneTraversal $ \g s -> runBazaar (f sell s) $ g . fst
+
+-- | pass the initial @s@ as the refined state.
+remember :: ATraversal s t a b -> Traversal s t (a,s) b
+remember = modifyBy id
+
+-- | refine the state by a given function.
+modifyBy :: (s -> u) -> ATraversal s t a b -> Traversal s t (a,u) b
+modifyBy f l = cloneTraversal $ \g s -> runBazaar (l sell s) $ g . flip (,) (f s)
+
+-- }}}
+
+-- ** Combinators
+-- {{{
+
+-- | lift an operation on one thing to an operation resulting in a list containing
+-- only the one thing.
+one :: Monad m => Trans m a b -> Trans m a [b]
+one = (>>$ one_)
+
+-- | perform a sub-'Trans'formation over each item resulting from
+-- a higher 'Trans'formation. Essentially composition, with a resulting
+-- list.
+onEach :: Monad m => Trans m b c -> Trans m a [b] -> Trans m a [c]
+onEach bc = (>>= mapM (lift . evalStateT bc))
+
+-- | embed a sub-'Trans'formation into a larger context using a traversal.
+-- viewing the state @s@ with the traversal provides the initial state
+-- of the sub-'Trans'formation, and the resulting value is used to alter the
+-- higher state, using 'set'.
+on :: Monad m => Traversal s s a b -> Trans m a b -> Trans' m s
+on l m = do
+  s <- get
+  case s ^? coerced l of
+    Just a -> do
+      b <- lift $ evalStateT m a
+      with (set l) b
+    _ -> return s
+
+-- | fold a value into the state using some given function.
+with :: Monad m => (a -> s -> s) -> a -> Trans' m s
+with f a = state $ \s -> let s' = f a s in (s',s')
+{-# INLINE with #-}
+
+-- | shorthand for 'on'.
+($->) :: Monad m => Traversal s s a b -> Trans m a b -> Trans' m s
+($->) = on
+infixr 0 $->
+
+-- | return a pure value to 'on'.
+(*->) :: Monad m => Traversal s s a b -> b -> Trans' m s
+l *-> b = l $-> return b
+infixr 0 *->
+
+-- | pull out an item from a traversal of the 'Trans'formation's state.
+-- fails if the traversal has no target.
+required :: Monad m => Traversal s t (Maybe a,s) b -> Trans m s a
+required l = optional l >>= \case
+  Just a -> return a
+  _      -> fail "required: No content in traversal"
+
+-- | pull out an item from a traversal of the 'Trans'formation's state.
+-- returns 'Just' the item if the traversal has a target, or
+-- 'Nothing' if not.
+optional :: Monad m => Traversal s t (Maybe a,s) b -> Trans m s (Maybe a)
+optional l = do
+  s <- get
+  case s ^? coerced l of
+    Just (a,s') -> put s' >> return a
+    _           -> return Nothing
+
+-- }}}
+
+-- }}}
+
+-- * Combinators
+-- {{{
+
+alterOf :: (Cons s s c c, Monad m) => Traversal s t (Maybe a,s) b -> (Maybe a -> Maybe c) -> Trans' m s
+alterOf l f = do
+  mv <- optional l
+  case f mv of
+    Just v -> with (<|) v
+    _      -> get
+
+insertOf :: (Cons s s r r, Monad m) => Traversal s t (Maybe a,s) b -> (Maybe a -> r) -> Trans' m s
+insertOf l = alterOf l . (return .)
+
+updateOf :: (Cons s s r r, Monad m) => Traversal s t (Maybe a,s) b -> (a -> r) -> Trans' m s
+updateOf l = alterOf l . fmap
+
+adjustOf :: (Cons s s r r, Monad m) => Traversal s t (Maybe a,s) b -> (a -> Maybe r) -> Trans' m s
+adjustOf l = alterOf l . (=<<)
+
+-- }}}
+
diff --git a/src/Text/HTML/Rules/Types.hs b/src/Text/HTML/Rules/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Rules/Types.hs
@@ -0,0 +1,69 @@
+{-# OPTIONS_HADDOCK show-extensions #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE Rank2Types #-}
+
+{-|
+Module      : Text.HTML.Rules.Types
+Description : Ubiquitous types for html-rules.
+Copyright   : (c) Kyle Carter, 2014
+License     : BSD3
+Maintainer  : kylcarte@gmail.com
+Stability   : experimental
+-}
+
+module Text.HTML.Rules.Types where
+
+import Control.Monad.State
+
+import Text.HTML.TagSoup hiding (Tag)
+import Text.HTML.TagSoup.Tree
+
+
+-- | a single HTML Tree
+type Fragment = TagTree String
+-- | an HTML Forest
+type HTML     = [Fragment]
+-- | Tag name
+type Name     = String
+-- | Attribute name
+type AttrKey  = String
+-- | Attribute value
+type AttrVal  = String
+type Attrs    = [Attribute String]
+-- | an HTML branch's descendents
+type Desc     = HTML
+
+-- | a 'Query' to decide when to apply a transformation,
+--   paired with the 'Trans'formation.
+--
+--   NB: a Transformation makes
+--   a single 'Fragment' into zero or more 'Fragment's.
+type Rule  m a b = (Query m a, Trans m a b)
+
+-- | a Rule over a 'Fragment' of HTML.
+type FragmentRule m     = Rule m Fragment HTML
+
+-- | a predicate on some type
+type Query m a = a -> m Bool
+-- | a predicate on an HTML Fragment
+type FragmentQuery m = Query m Fragment
+
+-- | a Transformation with a State of @a@
+type Trans  m a b = StateT a m b
+-- | a reflexive Transformation, analogous to @(a -> a)@
+type Trans' m a   = Trans m a a
+
+-- * Pattern Synonyms
+
+-- | @Branch tg as ds = TagBranch tg as ds@
+pattern Branch tg as ds = TagBranch tg as ds
+
+-- | @Leaf tg as = TagLeaf (TagOpen tg as)@
+pattern Leaf tg as = TagLeaf (TagOpen tg as)
+
+-- | @Text t = TagLeaf (TagText t)@
+pattern Text t = TagLeaf (TagText t)
+
diff --git a/src/Text/HTML/Rules/Util.hs b/src/Text/HTML/Rules/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Rules/Util.hs
@@ -0,0 +1,77 @@
+{-# OPTIONS_HADDOCK show-extensions #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE Rank2Types #-}
+
+{-|
+Module      : Text.HTML.Rules.Util
+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.Util where
+
+import Control.Applicative
+import Control.Monad ((>=>))
+
+{-
+-- ** Traversal Functions
+
+alterOf :: (Cons s s c c, Monad m) => Traversal s t (Maybe a,s) b -> (Maybe a -> Maybe c) -> Trans' m s
+alterOf l f = do
+  mv <- optional l
+  case f mv of
+    Just v -> with (<|) v
+    _      -> get
+
+insertOf :: (Cons s s r r, Monad m) => Traversal s t (Maybe a,s) b -> (Maybe a -> r) -> Trans' m s
+insertOf l = alterOf l . (return .)
+
+updateOf :: (Cons s s r r, Monad m) => Traversal s t (Maybe a,s) b -> (a -> r) -> Trans' m s
+updateOf l = alterOf l . fmap
+
+adjustOf :: (Cons s s r r, Monad m) => Traversal s t (Maybe a,s) b -> (a -> Maybe r) -> Trans' m s
+adjustOf l = alterOf l . (=<<)
+-}
+
+
+-- | bind into a pure function.
+(>>$) :: Monad m => m a -> (a -> b) -> m b
+m >>$ f = m >>= return . f
+infixl 1 >>$
+
+-- | compose monadic sequent function with a pure function, left to right.
+(>$>) :: Monad m => (a -> m b) -> (b -> c) -> a -> m c
+f >$> g = f >=> return . g
+infixr 1 >$>
+
+-- | compose monadic sequent function with a pure function, right to left.
+(<$<) :: Monad m => (b -> c) -> (a -> m b) -> a -> m c
+(<$<) = flip (>$>)
+infixr 1 <$<
+
+-- | construct a singleton list.
+one_ :: a -> [a]
+one_ = (:[])
+
+-- | compse a list of sequent endo-functions into a single sequent.
+concatEndo :: Monad m => [a -> m a] -> a -> m a
+concatEndo = foldr (>=>) return
+
+liftAA :: (Applicative f, Applicative g) => (a -> b) -> f (g a) -> f (g b)
+liftAA = fmap . fmap
+
+pure2 :: (Applicative f, Applicative g) => a -> f (g a)
+pure2 = pure . pure
+
+ap2   :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b)
+ap2 f x = (<*>) <$> f <*> x
+
+liftAA2 :: (Applicative f, Applicative g) => (a -> b -> c) -> f (g a) -> f (g b) -> f (g c)
+liftAA2 f x y = pure2 f `ap2` x `ap2` y
+