This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap".
The branch, master has been updated
via a6eaba8c8077ad2cd6c390baab7d91ddca8a5c86 (commit)
from 06d60c6e76309e5aa940e6209e4e2ee53ad9a6e2 (commit)
Summary of changes:
project_template/barebones/src/Main.hs | 5 +-
project_template/barebones/src/Server.hs | 111 ------------------------------
2 files changed, 2 insertions(+), 114 deletions(-)
delete mode 100644 project_template/barebones/src/Server.hs
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a6eaba8c8077ad2cd6c390baab7d91ddca8a5c86
Author: Shane <[email protected]>
Date: Thu Jul 15 19:53:16 2010 +0100
Stopped the barebones project template from bitrotting.
diff --git a/project_template/barebones/src/Main.hs
b/project_template/barebones/src/Main.hs
index 1c72738..e1c566b 100644
--- a/project_template/barebones/src/Main.hs
+++ b/project_template/barebones/src/Main.hs
@@ -4,11 +4,10 @@ module Main where
import Control.Applicative
import Snap.Types
import Snap.Util.FileServe
-
-import Server
+import Snap.Http.Server
main :: IO ()
-main = quickServer $
+main = quickHttpServe $
ifTop (writeBS "hello world") <|>
route [ ("foo", writeBS "bar")
, ("echo/:echoparam", echoHandler)
diff --git a/project_template/barebones/src/Server.hs
b/project_template/barebones/src/Server.hs
deleted file mode 100644
index 2dd625b..0000000
--- a/project_template/barebones/src/Server.hs
+++ /dev/null
@@ -1,111 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Server
- ( ServerConfig(..)
- , emptyServerConfig
- , commandLineConfig
- , server
- , quickServer
- ) where
-import qualified Data.ByteString.Char8 as B
-import Data.ByteString.Char8 (ByteString)
-import Data.Char
-import Control.Concurrent
-import Control.Exception (SomeException)
-import Control.Monad.CatchIO
-import qualified Data.Text as T
-import Prelude hiding (catch)
-import Snap.Http.Server
-import Snap.Types
-import Snap.Util.GZip
-import System hiding (getEnv)
-import System.Posix.Env
-import qualified Text.XHtmlCombinators.Escape as XH
-
-
-data ServerConfig = ServerConfig
- { locale :: String
- , interface :: ByteString
- , port :: Int
- , hostname :: ByteString
- , accessLog :: Maybe FilePath
- , errorLog :: Maybe FilePath
- , compression :: Bool
- , error500Handler :: SomeException -> Snap ()
- }
-
-
-emptyServerConfig :: ServerConfig
-emptyServerConfig = ServerConfig
- { locale = "en_US"
- , interface = "0.0.0.0"
- , port = 8000
- , hostname = "myserver"
- , accessLog = Just "access.log"
- , errorLog = Just "error.log"
- , compression = True
- , error500Handler = \e -> do
- let t = T.pack $ show e
- r = setContentType "text/html; charset=utf-8" $
- setResponseStatus 500 "Internal Server Error" emptyResponse
- putResponse r
- writeBS "<html><head><title>Internal Server Error</title></head>"
- writeBS "<body><h1>Internal Server Error</h1>"
- writeBS "<p>A web handler threw an exception. Details:</p>"
- writeBS "<pre>\n"
- writeText $ XH.escape t
- writeBS "\n</pre></body></html>"
- }
-
-
-commandLineConfig :: IO ServerConfig
-commandLineConfig = do
- args <- getArgs
- let conf = case args of
- [] -> emptyServerConfig
- (port':_) -> emptyServerConfig { port = read port' }
- locale' <- getEnv "LANG"
- return $ case locale' of
- Nothing -> conf
- Just l -> conf {locale = takeWhile (\c -> isAlpha c || c == '_') l}
-
-server :: ServerConfig -> Snap () -> IO ()
-server config handler = do
- putStrLn $ "Listening on " ++ (B.unpack $ interface config)
- ++ ":" ++ show (port config)
- setUTF8Locale (locale config)
- try $ httpServe
- (interface config)
- (port config)
- (hostname config)
- (accessLog config)
- (errorLog config)
- (catch500 $ compress $ handler)
- :: IO (Either SomeException ())
- threadDelay 1000000
- putStrLn "Shutting down"
- where
- catch500 = (`catch` (error500Handler config))
- compress = if compression config then withCompression else id
-
-
-quickServer :: Snap () -> IO ()
-quickServer = (commandLineConfig >>=) . flip server
-
-
-setUTF8Locale :: String -> IO ()
-setUTF8Locale locale' = do
- mapM_ (\k -> setEnv k (locale' ++ ".UTF-8") True)
- [ "LANG"
- , "LC_CTYPE"
- , "LC_NUMERIC"
- , "LC_TIME"
- , "LC_COLLATE"
- , "LC_MONETARY"
- , "LC_MESSAGES"
- , "LC_PAPER"
- , "LC_NAME"
- , "LC_ADDRESS"
- , "LC_TELEPHONE"
- , "LC_MEASUREMENT"
- , "LC_IDENTIFICATION"
- , "LC_ALL" ]
-----------------------------------------------------------------------
hooks/post-receive
--
snap
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
