tentative beginning at a DOM interface

src/Text/Taggy.hs

@@ -11,11 +11,13 @@ module Text.Taggy
   ( linksIn
   , module Text.Taggy.Types
   , module Text.Taggy.Parser
+  , module Text.Taggy.DOM
   ) where 
 
 import Data.Text (Text)
 import Text.Taggy.Types
 import Text.Taggy.Parser
+import Text.Taggy.DOM
 
 linksIn :: [Tag] -> [Text]
 linksIn = map attrValue

src/Text/Taggy/DOM.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.Taggy.DOM where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.Taggy.Types
+
+data Tree = Branch !Text [Attribute] [Tree]
+          | Leaf !Tag
+  deriving (Eq, Show)
+
+domify :: [Tag] -> [Tree]
+domify [] = []
+domify xs = go xs
+
+
+  where go [] = []
+        go ts = a ++ map Leaf (take 1 b) ++ go (drop 1 b)
+          where (a, b) = f ts
+
+        f (TagScript tago scr tagc : rest) = 
+          f $ [tago, TagText scr, tagc] ++ rest
+
+        f (TagStyle tago sty tagc : rest) = 
+          f $ [tago, TagText sty, tagc] ++ rest
+
+
+        f (TagOpen name attrs autocl : rest) =
+          case f rest of 
+            (inner, []) -> ( Leaf (TagOpen name attrs autocl) : inner
+                           , []
+                           )
+            (inner, TagClose x : ts)
+              | x == name -> 
+                let (a, b) = f ts in 
+                  (Branch name attrs inner : a, b)
+              | otherwise -> 
+                ( Leaf (TagOpen name attrs autocl) : inner
+                , TagClose x : ts
+                )
+            _ -> error "Text.Taggy.DOM.domify: shouldn't happen"
+
+        f (TagClose x:xs) = ([], TagClose x : xs)
+        f (x:xs) = (Leaf x : a, b)
+          where (a,b) = f xs
+        f [] = ([], [])

taggy.cabal

@@ -15,6 +15,7 @@ cabal-version:       >=1.10
 
 library
   exposed-modules:     Text.Taggy,
+                       Text.Taggy.DOM
                        Text.Taggy.Parser,
                        Text.Taggy.Types
   other-modules: