From 128f0e5df689c0ebe7ac043002a3fc410969b277 Mon Sep 17 00:00:00 2001 From: Ilya Portnov Date: Mon, 19 Apr 2010 23:30:12 +0600 Subject: [PATCH] add a test. --- Blog/Blog.hs | 19 ++++++++++++++++++- 1 files changed, 18 insertions(+), 1 deletions(-) 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 -- 1.7.2.3