Changeset 1165 for lang/haskell

Timestamp:

11/06/07 10:48:50 (13 months ago)

Author:

jknaoya

Message:

lang/haskell/blosxkel/story.xml,
lang/haskell/blosxkel/head.xml,
lang/haskell/blosxkel/config.sample,
lang/haskell/blosxkel/foot.xml,
lang/haskell/blosxkel/content_type.xml,
lang/haskell/blosxkel/blosxkel.hs:

フレーバーをサポートしました。
content_type に余計な改行が入らないようにくふうしました。

Location:

lang/haskell/blosxkel

Files:

• blosxkel.hs (modified) (4 diffs)
• config.sample (modified) (1 diff)
• content_type.xml (added)
• foot.xml (added)
• head.xml (added)
• story.xml (added)

lang/haskell/blosxkel/blosxkel.hs

@@ -18 +18 @@
 -- 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 = return . fill =<< (readFile $ place ++ flavour)
     where
         fill ""   = ""
@@ -104 +104 @@
     | otherwise                = filter (\e -> isPrefixOf (joinPath spath) (path e)) entries
     where
-        spath = splitDirectories pathinfo
+        spath | takeFileName pathi == "index" = splitDirectories $ dropFileName pathi
+              | otherwise                     = splitDirectories pathi
+        pathi = dropExtension pathinfo
 
 getResult :: [(String, String)] -> [(String, String)] -> IO (String, String)
@@ -116 +118 @@
                [("title"  , title e),
                 ("body"   , concat (body e)),
-                ("time"   , strfctime "%Y-%m-%d %H:%M:%S" (time e)),
+                ("time"   , strfctime "%Y-%m-%dT%H:%M:%SZ" (time e)),
                 ("yr"     , strfctime "%Y"  (time e)),
                 ("mo"     , strfctime "%b"  (time e)),
@@ -129 +131 @@
                 ("fn"     , path e),
                 ("path"   , path e)])
-               $ take 7 $ reverse $ sortBy (\a b -> compare (time a) (time b)) $ filterByPathInfo (fromJust $ lookup "pathinfo" cgiparams) entries
+               $ take 7 $ reverse $ sortBy (\a b -> compare (time a) (time b))
+               $ filterByPathInfo (fromJust $ lookup "pathinfo" cgiparams) entries
     ; cf <- fill "foot" []
     ; return $ (ct, concat $ [ch, concat cs, cf])
     } where
-        fill place params = fillFlavour "html" place (params ++ [("title"  , getConfig config "title"),
-                                                                 ("author" , getConfig config "author"),
-                                                                 ("version", "How do I get this version of GHC in program?")] ++ cgiparams)
+        fill place params = fillFlavour (getConfig cgiparams "flavour") place
+                                        (params ++ [("title"  , getConfig config "title"),
+                                        ("author" , getConfig config "author"),
+                                        ("version", "How do I get this version of GHC in program?")] ++ cgiparams)
 
 cgiMain :: CGI CGIResult
 cgiMain =  do
     {
-    ; config  <- liftIO $ loadConfig "config"
-    ; home <- scriptName
-    ; pathinfo <- pathInfo
-    ; (ct, cb)  <- liftIO $ getResult [("home", home), ("pathinfo", pathinfo)] config
-    ; setHeader "Content-Type" $ ct
+    ; config     <- liftIO $ loadConfig "config"
+    ; home       <- scriptName
+    ; pathinfo   <- pathInfo
+    ; servername <- serverName
+    ; flavour    <- return $ takeExtension 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
+    ; setHeader "Content-Type" $ reverse $ dropWhile isSpace $ reverse $ ct
     ; output $ cb
     }

lang/haskell/blosxkel/config.sample

@@ -2 +2 @@
 author: jknaoya
 data-dir: data
+default-flavour: html