Changeset 1187 for lang/haskell

Timestamp:

11/06/07 16:42:46 (13 months ago)

Author:

jknaoya

Message:

lang/haskell/blosxkel/blosxkel.hs:

よみやすいように整形しました。data の宣言はうえのほうにしました

Files:

• lang/haskell/blosxkel/blosxkel.hs (modified) (6 diffs)

lang/haskell/blosxkel/blosxkel.hs

@@ -19 +19 @@
 import Network.CGI
 
+data Entry = Entry {
+    file  :: FilePath,
+    path  :: String,
+    title :: String,
+    time  :: ClockTime,
+    body  :: [String]
+}
+
+
 -- ref. http://i.loveruby.net/ja/stdhaskell/samples/lazylines/Template.hs.html
 fillFlavour :: String -> String -> [(String, String)] -> IO String
-fillFlavour flavour place params = return . fill =<< (readFile $ place ++ flavour)
+fillFlavour flavour place params = do
+    {
+    ; tmpl <- (readFile $ place ++ flavour)
+    ; return $ fill $ tmpl
+    }
     where
         fill ""   = ""
@@ -42 +55 @@
                   | otherwise     = let (k, (':':v)) = (break (== ':') l)
                                     in [(strip k, strip v)]
-        strip     = rstrip . lstrip
+        strip     = rstrip  . lstrip
         rstrip    = reverse . lstrip . reverse
         lstrip    = dropWhile isSpace
@@ -48 +61 @@
 getConfig :: [(String, String)] -> String -> String
 getConfig config key = fromJust $ lookup key config
-
-data Entry = Entry {
-    file  :: FilePath,
-    path  :: String,
-    title :: String,
-    time  :: ClockTime,
-    body  :: [String]
-}
 
 
@@ -74 +79 @@
 -- http://www.tom.sfc.keio.ac.jp/~sakai/2ch/1162902266.html
 getRecursiveContents :: FilePath -> IO [FilePath]
-getRecursiveContents fp = getDirectoryContents fp >>= mapM (fx fp) >>= return . concat
+getRecursiveContents fp = do
+    {
+    ; dc <- getDirectoryContents fp
+    ; re <- mapM (fx fp) dc
+    ; return $ concat $ re
+    }
     where
-       fx :: FilePath -> FilePath -> IO [FilePath]
-       fx bp "."  = return [bp]
-       fx bp ".." = return []
-       fx bp f    = do let np = bp ++ ('/':f)
-                       b <- doesDirectoryExist np
-                       if b then getRecursiveContents np
-                            else return [np]
+        fx :: FilePath -> FilePath -> IO [FilePath]
+        fx bp "."  = return [bp]
+        fx bp ".." = return []
+        fx bp f    = do let np = bp ++ ('/':f)
+                        b <- doesDirectoryExist np
+                        if b then getRecursiveContents np
+                             else return [np]
 
 
@@ -141 +151 @@
     } where
         fill place params = fillFlavour (getConfig cgiparams "flavour") place
-                                        (params ++ [("title"  , getConfig config "title"),
+                                        (params ++ [
+                                        ("title"  , getConfig config "title"),
                                         ("author" , getConfig config "author"),
-                                        ("version", unwords [os, arch, compilerName, showVersion compilerVersion])] ++ cgiparams)
+                                        ("version", unwords [os, arch, compilerName, showVersion compilerVersion])
+                                        ] ++ cgiparams)
 
 cgiMain :: CGI CGIResult
@@ -153 +165 @@
     ; servername <- serverName
     ; flavour    <- return $ takeExtension pathinfo
-    ; (ct, cb)   <- liftIO $ getResult [("home", home),
-                                        ("pathinfo", pathinfo),
+    ; (ct, cb)   <- liftIO $ getResult [("home"      , home),
+                                        ("pathinfo"  , pathinfo),
                                         ("servername", "http://" ++ servername),
-                                        ("flavour", if length flavour == 0
-                                                    then getConfig config "default-flavour"
-                                                    else flavour)] config
+                                        ("flavour"   , if length flavour == 0
+                                                       then getConfig config "default-flavour"
+                                                       else flavour)] config
     ; setHeader "Content-Type" $ reverse $ dropWhile isSpace $ reverse $ ct
     ; output $ cb