Changeset 1158 for lang/haskell

Timestamp:

11/05/07 22:06:28 (13 months ago)

Author:

jknaoya

Message:

lang/haskell/blosxkel/blosxkel.hs:

blosxom の感じにあわせました。path は data とか拡張子とかふくまないように

Files:

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

lang/haskell/blosxkel/blosxkel.hs

@@ -4 +4 @@
 module Main where
 
+import System.FilePath
 import System.Directory
 import System.Time
@@ -11 +12 @@
 import Data.Maybe
 import Data.Char
+import Data.Eq
 
 import Network.CGI
@@ -31 +33 @@
 
 data Entry = Entry {
-    path  :: FilePath,
+    file  :: FilePath,
+    path  :: String,
     title :: String,
     time  :: ClockTime,
@@ -38 +41 @@
 
 
-getFileEntry :: FilePath -> IO Entry
-getFileEntry f = do
-    { mtime <- getModificationTime f
+getFileEntry :: String -> FilePath -> IO Entry
+getFileEntry d f = do
+    {
+    ; mtime <- getModificationTime f
     ; cs    <- readFile f
     ; case lines cs of
-        h:tl -> return $ Entry { path  = f
+        h:tl -> return $ Entry { file  = f
+                               , path  = dropExtension $ drop (length d) f
                                , title = h
                                , time  = mtime
@@ -53 +58 @@
 getRecursiveContents :: FilePath -> IO [FilePath]
 getRecursiveContents fp = getDirectoryContents fp >>= mapM (fx fp) >>= return . concat
- 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]
+    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]
 
 
@@ -67 +72 @@
 getTextFileEntries d = do
     {
-    ; cdir <- getCurrentDirectory
-    ; setCurrentDirectory d
-    ; fs <- getRecursiveContents "."
-    ; es <- mapM getFileEntry $ filter (isSuffixOf ".txt") fs
-    ; setCurrentDirectory cdir
+    ; fs <- getRecursiveContents d
+    ; es <- mapM (getFileEntry d) $ filter (isSuffixOf ".txt") fs
     ; return es
     }
@@ -99 +101 @@
     {
     ; home <- scriptName
-    ; result <- liftIO $ getResult [("home", home)]
+    ; pathinfo <- pathInfo
+    ; result <- liftIO $ getResult [("home", home), ("pathinfo", pathinfo)]
     ; setHeader "Content-Type" $ fst result
     ; output $ snd result