add a test.

Ilya Portnov [2010-04-19 17:30:12]
add a test.
Filename
Blog/Blog.hs
diff --git a/Blog/Blog.hs b/Blog/Blog.hs
index 6e99b5e..cb30e9b 100644
--- a/Blog/Blog.hs
+++ b/Blog/Blog.hs
@@ -1,5 +1,8 @@
-import System.IO
+{- # LANGUAGE ScopedTypeVariables #-}
+
+import System.IO.Error
 import Database.HDBC (toSql)
+import System.Directory

 import Framework.API
 import Framework.Utils
@@ -22,6 +25,7 @@ urlconf = "blog" // ( "new" --> newpost
       <|> "register" --> registration
       <|> "form" --> testform
       <|> "i18n" --> i18ntest
+      <|> "ls"//".*" ~> ls
       <|> RawFunction serveStatic

 login :: HttpAction
@@ -48,6 +52,19 @@ i18ntest = do
     text <- __ "Hello world!"
     renderToResponseM "i18ntest.html" [("text", C text)]

+tryIO :: IO a -> Int -> String -> AController a
+tryIO m code msg = do
+  r <- liftIO $ try m
+  case r of
+    Right x -> return x
+    Left _ -> raiseC code msg
+
+ls path = methodOnly GET $ do
+    let path' = if null path then "." else path
+    files <- tryIO (getDirectoryContents path') 404 (path ++ " not found")
+    renderToResponseM "lsfiles.html" [("files", C files),
+                                      ("dir",   C path)]
+
 allposts2 = methodOnly GET $ do
     (posts,pagerHtml) <- pager (countChildren postModel commentModel) [] postModel
     posts' <- selectRelated posts
ViewGit