From 9583cda38812f59d3200ae61b0313bde546a0468 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Tue, 3 Jun 2014 00:10:17 +0200
Subject: [PATCH] tentative beginning at a DOM interface

---
 src/Text/Taggy.hs     |  2 ++
 src/Text/Taggy/DOM.hs | 47 +++++++++++++++++++++++++++++++++++++++++++
 taggy.cabal           |  1 +
 3 files changed, 50 insertions(+)
 create mode 100644 src/Text/Taggy/DOM.hs

diff --git a/src/Text/Taggy.hs b/src/Text/Taggy.hs
index 6bc35a3..67bca99 100644
--- a/src/Text/Taggy.hs
+++ b/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
diff --git a/src/Text/Taggy/DOM.hs b/src/Text/Taggy/DOM.hs
new file mode 100644
index 0000000..4b33d70
--- /dev/null
+++ b/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 [] = ([], [])
diff --git a/taggy.cabal b/taggy.cabal
index 11fe7a8..5b72c15 100644
--- a/taggy.cabal
+++ b/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: