[automated table of contents generation. added other filters section to routing filters
Jeremy Shaw <jeremy@seereason.com>**20100527204818
 Ignore-this: b20f19348661c58453a5aecd47b510a3
] hunk ./Dir.lhs 7
-<h2>Using <code>dir</code> to match on static path components</h2>
+<h3><a name="dir">Using <code>dir</code> to match on static path components</a></h3>
hunk ./Dir2.lhs 7
-<h2>Using <code>dir</code> to match on multiple components</h2>
+<h3><a name="dir2">Using <code>dir</code> to match on multiple components</a></h3>
hunk ./Dirs.lhs 7
-<h2>Using <code>dirs</code> as shorthand to match on multiple components</h2>
+<h3><a name="dirs">Using <code>dirs</code> as shorthand to match on multiple components</a></h3>
hunk ./Main.lhs 17
-<h1>Happstack Crashcourse</h1>
+<h1><a name="happstack_crashcourse">Happstack Crashcourse</a></h1>
hunk ./Main.lhs 36
-<ol>
- <li><a href="HelloWorld.html">Hello World!</a></li>
- <li><a href="RouteFilters.html">Routing URLS</a>
-  <ol>
-   <li><a href="RouteFilters.html#variable_path_segments">Variable Path Segments</a>
-    <ol>
-     <li><a href="RouteFilters.html#path"><code>path</code></a></li>
-     <li><a href="RouteFilters.html#FromReqURI"><code>FromReqURI</code>: extending <code>path</code></a></li>
-    </ol>
-   </li>
-  </ol>
- </li>
-</ol>
+#include "toc.html"
hunk ./Makefile 18
+toc.html: $(DEPS) gen-toc.hs
+	runhaskell gen-toc.hs  > toc.html
+
hunk ./Makefile 41
-Main.html : $(SRC) $(EXTRA_DEPS)
+Main.html : $(SRC) $(EXTRA_DEPS) toc.html
hunk ./MonadPlus.lhs 7
-<h2>Choosing between multiple <code>ServerPartTs</code></h2>
+<h2><a name="monadplus">Choosing between multiple <code>ServerPartTs</code></a></h2>
hunk ./RouteFilters.lhs 16
-<h1>Route Filters</h1>
+<h1><a name="route_filters">Route Filters</a></h1>
hunk ./RouteFilters.lhs 30
+<h2><a name="other_filters">Other Routing Filters</a></h2>
+
+<p>SimpleHTTP includes a number of other useful routing filters, such as:</p>
+<dl>
+ <dt><code>nullDir :: (ServerMonad m, MonadPlus m) => m ()</code></dt>
+  <dd>check that there are no unmatched path segments remaining</dd>
+
+ <dt><code>host :: (ServerMonad m, MonadPlus m) => String -> m a -> m a</code></dt>
+  <dd>match on a specific host name in the Request</dd>
+
+ <dt><code>withHost :: (ServerMonad m, MonadPlus m) => (String -> m a) -> m a</code></dt>
+  <dd>Lookup the host header and pass it to the handler.</dd>
+
+ <dt><code>uriRest :: (ServerMonad m) => (String -> m a) -> m a</code></dt>
+  <dd>Grab the rest of the URL (dirs + query) and passes it to your handler</dd>
+
+ <dt><code>anyPath :: (ServerMonad m, MonadPlus m) => m r -> m r</code></dt>
+  <dd>Pop any path element and ignore when choosing a 'ServerPartT' to handle the request.</dd>
+
+ <dt><code>trailingSlash :: (ServerMonad m, MonadPlus m) => m ()</code></dt>
+   <dd>Guard which checks that the Request URI ends in <code>/</code>.  Useful for distinguishing between <code>foo</code> and <code>foo/</code></dd>
+</dl>
addfile ./gen-toc.hs
hunk ./gen-toc.hs 1
+module Main where
+
+import Data.List (groupBy)
+import Data.Function (on)
+-- import Data.Tree
+import Text.HTML.TagSoup
+import Text.Html
+
+isOpenHeader t =
+    t ~== "<h1>" || t ~== "<h2>" || t ~== "<h3>" || t ~== "<h4>" || t ~== "<h5>"
+
+isCloseHeader t =
+    t ~== "</h1>" || t ~== "</h2>" || t ~== "</h3>" || t ~== "</h4>" || t ~== "</h5>"
+
+data Header = Header { level  :: Int 
+                     , aname :: Maybe String 
+                     , label  :: String
+                     , file   :: FilePath
+                     } deriving (Eq, Ord, Read, Show)
+
+extractHeader :: FilePath -> [Tag String] -> Header
+extractHeader fp (TagOpen hStr _:ts) =
+    let lvl = case hStr of
+                "h1" -> 1
+                "h2" -> 2
+                "h3" -> 3
+                "h4" -> 4
+                "h5" -> 5
+    in extractName lvl ts
+    where
+      extractName lvl (TagOpen "a" attrs: ts) =
+          case lookup "name" attrs of
+            Nothing -> extractLbl lvl Nothing ts
+            (Just n) -> extractLbl lvl (Just n) ts
+      extractName lvl ts = extractLbl lvl Nothing ts
+      extractLbl lvl n ts = Header lvl n (innerText ts) fp
+
+getHeaders :: FilePath -> IO [Header]
+getHeaders fp =
+    do c <- fmap parseTags $ readFile fp
+       let headers = map (extractHeader fp . takeWhile (\t -> not (isCloseHeader t))) $ sections isOpenHeader c
+       return headers
+
+files = 
+    [ "HelloWorld.html"
+    , "RouteFilters.html"
+    ]
+    
+
+main :: IO ()
+main =
+    do hs <- fmap concat $ mapM getHeaders files
+       let htree = map snd $ toTree (map headerToPair hs)
+       print (forestToHtml htree)
+
+forestToHtml :: [Tree Header] -> Html
+forestToHtml [] = noHtml
+forestToHtml trees = olist $ concatHtml (map treeToHtml trees)
+
+treeToHtml :: Tree Header -> Html
+treeToHtml (Tree header children)  = li $ headerToHtml header +++ forestToHtml children
+
+headerToHtml :: Header -> Html
+headerToHtml h = (anchor (toHtml (label h))) ! [href ((file h) ++ (maybe "" ("#"++) (aname h))) ]
+
+headerToPair :: Header -> (Int, Header)
+headerToPair h = (level h, h)
+
+
+data Tree a = Tree a [Tree a] deriving Show
+
+toTree :: Show a => [(Int, a)] -> [(Int, Tree a)]
+toTree pairs =
+    f [] (reverse pairs)
+    where
+      f :: Show a => [(Int, Tree a)] -> [(Int, a)] -> [(Int, Tree a)]
+      f [] ((d', x) : more) = f [(d', Tree x [])] more
+      f stack [] = stack
+      f stack@((d, trees) : _) pairs@((d', x) : more) =
+          case compare d (d' + 1) of
+            -- If the new pair depth is one less than the stack top depth, pair becomes new parent
+            EQ -> let (children, other) = break (\ (d, _) -> d /= d' + 1) stack in f  ((d', Tree x (map snd children)) : other) more
+            -- If the new pair depth is less than or equal to the stack top depth, push it
+            LT -> f ((d', Tree x []) : stack) more
+            -- If the new pair depth is greater than the stack top depth, it is an error.
+            GT -> error $ "Invalid traversal: stack=" ++ show stack ++ ", pairs=" ++ show pairs
+    
+{-
+toForest :: Int -> [Header] -> Forest Header
+toForest _ [] = []
+toForest currLvl hs@(h@(Header lvl _ _) : rest) | 
+-}
+
+
+
hunk ./theme.css 3
-  font-family: san-serif;
+  font-family: sans-serif;