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-core".
The branch, 0.3 has been updated
via 75d82f80c2900aea2c0c7e831258a03c5f75e4bd (commit)
from 8a2574c2673818685f31fb6060558186ec95e034 (commit)
Summary of changes:
project_template/barebones/foo.cabal | 35 ---------
project_template/barebones/src/Main.hs | 22 ------
project_template/barebones/src/Server.hs | 111 ------------------------------
project_template/default/foo.cabal | 37 ----------
project_template/default/src/Glue.hs | 46 ------------
project_template/default/src/Main.hs | 30 --------
project_template/default/src/Server.hs | 111 ------------------------------
snap-core.cabal | 43 ------------
src/Snap/Starter.hs | 97 --------------------------
src/Snap/StarterTH.hs | 55 ---------------
10 files changed, 0 insertions(+), 587 deletions(-)
delete mode 100644 project_template/barebones/foo.cabal
delete mode 100644 project_template/barebones/src/Main.hs
delete mode 100644 project_template/barebones/src/Server.hs
delete mode 100644 project_template/default/foo.cabal
delete mode 100644 project_template/default/src/Glue.hs
delete mode 100644 project_template/default/src/Main.hs
delete mode 100644 project_template/default/src/Server.hs
delete mode 100644 src/Snap/Starter.hs
delete mode 100644 src/Snap/StarterTH.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 75d82f80c2900aea2c0c7e831258a03c5f75e4bd
Author: Carl Howells <[email protected]>
Date: Sun Jun 20 11:11:45 2010 -0700
Move snap binary out of this package
diff --git a/project_template/barebones/foo.cabal
b/project_template/barebones/foo.cabal
deleted file mode 100644
index a61c523..0000000
--- a/project_template/barebones/foo.cabal
+++ /dev/null
@@ -1,35 +0,0 @@
-Name: projname
-Version: 0.1
-Synopsis: Project Synopsis Here
-Description: Project Description Here
-License: AllRightsReserved
-Author: Author
-Maintainer: [email protected]
-Stability: Experimental
-Category: Web
-Build-type: Simple
-Cabal-version: >=1.2
-
-Executable projname
- hs-source-dirs: src
- main-is: Main.hs
-
- Build-depends:
- base >= 4,
- haskell98,
- monads-fd >= 0.1 && <0.2,
- bytestring >= 0.9.1 && <0.10,
- snap-core >= 0.2 && <0.3,
- snap-server >= 0.2 && <0.3,
- xhtml-combinators,
- unix,
- text,
- containers,
- MonadCatchIO-transformers,
- filepath >= 1.1 && <1.2
-
- if impl(ghc >= 6.12.0)
- ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
- -fno-warn-unused-do-bind
- else
- ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
diff --git a/project_template/barebones/src/Main.hs
b/project_template/barebones/src/Main.hs
deleted file mode 100644
index 1c72738..0000000
--- a/project_template/barebones/src/Main.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Main where
-
-import Control.Applicative
-import Snap.Types
-import Snap.Util.FileServe
-
-import Server
-
-main :: IO ()
-main = quickServer $
- ifTop (writeBS "hello world") <|>
- route [ ("foo", writeBS "bar")
- , ("echo/:echoparam", echoHandler)
- ] <|>
- dir "static" (fileServe ".")
-
-echoHandler :: Snap ()
-echoHandler = do
- param <- getParam "echoparam"
- maybe (writeBS "must specify echo/param in URL")
- writeBS param
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" ]
diff --git a/project_template/default/foo.cabal
b/project_template/default/foo.cabal
deleted file mode 100644
index d3e3b7b..0000000
--- a/project_template/default/foo.cabal
+++ /dev/null
@@ -1,37 +0,0 @@
-Name: projname
-Version: 0.1
-Synopsis: Project Synopsis Here
-Description: Project Description Here
-License: AllRightsReserved
-Author: Author
-Maintainer: [email protected]
-Stability: Experimental
-Category: Web
-Build-type: Simple
-Cabal-version: >=1.2
-
-Executable projname
- hs-source-dirs: src
- main-is: Main.hs
-
- Build-depends:
- base >= 4,
- haskell98,
- monads-fd >= 0.1 && <0.2,
- bytestring >= 0.9.1 && <0.10,
- snap-core >= 0.2 && <0.3,
- snap-server >= 0.2 && <0.3,
- heist >= 0.2.2 && <0.3,
- hexpat == 0.16,
- xhtml-combinators,
- unix,
- text,
- containers,
- MonadCatchIO-transformers,
- filepath >= 1.1 && <1.2
-
- if impl(ghc >= 6.12.0)
- ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
- -fno-warn-unused-do-bind
- else
- ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
diff --git a/project_template/default/src/Glue.hs
b/project_template/default/src/Glue.hs
deleted file mode 100644
index e6a789c..0000000
--- a/project_template/default/src/Glue.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Glue
- ( templateHandler
- , defaultReloadHandler
- , templateServe
- , render
- ) where
-
-import Control.Applicative
-import Control.Monad
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-import Prelude hiding (catch)
-import Snap.Types hiding (dir)
-import Snap.Util.FileServe
-import Text.Templating.Heist
-import Text.Templating.Heist.TemplateDirectory
-
-
-templateHandler :: TemplateDirectory Snap
- -> (TemplateDirectory Snap -> Snap ())
- -> (TemplateState Snap -> Snap ())
- -> Snap ()
-templateHandler td reload f = reload td <|> (f =<< getDirectoryTS td)
-
-
-defaultReloadHandler :: TemplateDirectory Snap -> Snap ()
-defaultReloadHandler td = path "admin/reload" $ do
- e <- reloadTemplateDirectory td
- modifyResponse $ setContentType "text/plain; charset=utf-8"
- writeBS . B.pack $ either id (const "Templates loaded successfully.") e
-
-
-render :: TemplateState Snap -> ByteString -> Snap ()
-render ts template = do
- bytes <- renderTemplate ts template
- flip (maybe pass) bytes $ \x -> do
- modifyResponse $ setContentType "text/html; charset=utf-8"
- writeBS x
-
-
-templateServe :: TemplateState Snap -> Snap ()
-templateServe ts = ifTop (render ts "index") <|> do
- path' <- getSafePath
- when (head path' == '_') pass
- render ts $ B.pack path'
diff --git a/project_template/default/src/Main.hs
b/project_template/default/src/Main.hs
deleted file mode 100644
index 3254b3b..0000000
--- a/project_template/default/src/Main.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Main where
-
-import Control.Applicative
-import Snap.Types
-import Snap.Util.FileServe
-import Text.Templating.Heist
-import Text.Templating.Heist.TemplateDirectory
-
-import Glue
-import Server
-
-
-main :: IO ()
-main = do
- td <- newTemplateDirectory' "templates" emptyTemplateState
- quickServer $ templateHandler td defaultReloadHandler $ \ts ->
- ifTop (writeBS "hello world") <|>
- route [ ("foo", writeBS "bar")
- , ("echo/:echoparam", echoHandler)
- ] <|>
- templateServe ts <|>
- dir "static" (fileServe ".")
-
-
-echoHandler :: Snap ()
-echoHandler = do
- param <- getParam "echoparam"
- maybe (writeBS "must specify echo/param in URL")
- writeBS param
diff --git a/project_template/default/src/Server.hs
b/project_template/default/src/Server.hs
deleted file mode 100644
index 2dd625b..0000000
--- a/project_template/default/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" ]
diff --git a/snap-core.cabal b/snap-core.cabal
index ff86deb..c935b80 100644
--- a/snap-core.cabal
+++ b/snap-core.cabal
@@ -73,12 +73,6 @@ extra-source-files:
extra/logo.gif,
haddock.sh,
LICENSE,
- project_template/barebones/foo.cabal,
- project_template/barebones/src/Common.hs,
- project_template/barebones/src/Main.hs,
- project_template/default/foo.cabal,
- project_template/default/src/Common.hs,
- project_template/default/src/Main.hs,
README.md,
README.SNAP.md,
Setup.hs,
@@ -171,43 +165,6 @@ Library
else
ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
-Executable snap
- hs-source-dirs: src
- main-is: Snap/Starter.hs
-
- other-modules: Snap.StarterTH
-
- build-depends:
- attoparsec >= 0.8.0.2 && < 0.9,
- base >= 4 && < 5,
- bytestring,
- bytestring-nums,
- cereal >= 0.2 && < 0.3,
- containers,
- directory,
- directory-tree,
- dlist >= 0.5 && < 0.6,
- filepath,
- haskell98,
- iteratee >= 0.3.1 && <0.4,
- monads-fd,
- old-locale,
- old-time,
- template-haskell,
- text >= 0.7.1 && <0.8,
- time,
- transformers,
- unix-compat,
- zlib
-
- ghc-prof-options: -prof -auto-all
-
- if impl(ghc >= 6.12.0)
- ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
- -fno-warn-unused-do-bind
- else
- ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
-
source-repository head
type: git
location: http://git.snapframework.com/snap-core.git
diff --git a/src/Snap/Starter.hs b/src/Snap/Starter.hs
deleted file mode 100644
index 7c8f872..0000000
--- a/src/Snap/Starter.hs
+++ /dev/null
@@ -1,97 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Main where
-
-------------------------------------------------------------------------------
-import Data.List
-import qualified Data.Text as T
-import System
-import System.Directory
-import System.Console.GetOpt
-import System.FilePath
-------------------------------------------------------------------------------
-
-import Snap.StarterTH
-
-
-------------------------------------------------------------------------------
--- Creates a value tDir :: ([String], [(String, String)])
-$(buildData "tDirDefault" "default")
-$(buildData "tDirBareBones" "barebones")
-
-
-------------------------------------------------------------------------------
-usage :: String
-usage = unlines
- ["Usage:"
- ,""
- ," snap <action>"
- ,""
- ," <action> can be one of:"
- ," init - create a new project directory structure in the current
directory"
- ]
-
-
-------------------------------------------------------------------------------
-data InitFlag = InitBareBones
- | InitHelp
- deriving (Show, Eq)
-
-
-setup :: String -> ([FilePath], [(String, String)]) -> IO ()
-setup projName tDir = do
- mapM createDirectory (fst tDir)
- mapM_ write (snd tDir)
- where
- write (f,c) =
- if isSuffixOf "foo.cabal" f
- then writeFile (projName++".cabal") (insertProjName $ T.pack c)
- else writeFile f c
- insertProjName c = T.unpack $ T.replace
- (T.pack "projname")
- (T.pack projName) c
-
-------------------------------------------------------------------------------
-initProject :: [String] -> IO ()
-initProject args = do
- case getOpt Permute options args of
- (flags, _, [])
- | InitHelp `elem` flags -> do putStrLn initUsage
- exitFailure
- | otherwise -> init' (InitBareBones `elem` flags)
-
- (_, _, errs) -> do putStrLn $ concat errs
- putStrLn initUsage
- exitFailure
- where
- initUsage = unlines
- ["Usage:"
- ,""
- ," snap init"
- ,""
- ," -b --barebones Depend only on -core and -server"
- ," -h --help Print this message"
- ]
-
- options =
- [ Option ['b'] ["barebones"] (NoArg InitBareBones)
- "Depend only on -core and -server"
- , Option ['h'] ["help"] (NoArg InitHelp)
- "Print this message"
- ]
-
- init' isBareBones = do
- cur <- getCurrentDirectory
- let dirs = splitDirectories cur
- projName = last dirs
- setup projName (if isBareBones then tDirBareBones else tDirDefault)
-
-
-------------------------------------------------------------------------------
-main :: IO ()
-main = do
- args <- getArgs
- case args of
- ("init":args') -> initProject args'
- _ -> do putStrLn usage
- exitFailure
-
diff --git a/src/Snap/StarterTH.hs b/src/Snap/StarterTH.hs
deleted file mode 100644
index 17f8cce..0000000
--- a/src/Snap/StarterTH.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Snap.StarterTH where
-
-------------------------------------------------------------------------------
-import qualified Data.Foldable as F
-import Data.List
-import Language.Haskell.TH
-import System.Directory.Tree
-------------------------------------------------------------------------------
-
-
-------------------------------------------------------------------------------
--- Convenience types
-type FileData = (String, String)
-type DirData = FilePath
-
-
-------------------------------------------------------------------------------
--- Gets all the directorys in a DirTree
-getDirs :: [FilePath] -> DirTree a -> [FilePath]
-getDirs prefix (Dir n c) = (intercalate "/" (reverse (n:prefix))) : concatMap
(getDirs (n:prefix)) c
-getDirs _ (File _ _) = []
-getDirs _ (Failed _ _) = []
-
-
-------------------------------------------------------------------------------
--- Reads a directory and returns a tuple of the list of all directories
--- encountered and a list of filenames and content strings.
-readTree :: FilePath -> IO ([DirData], [FileData])
-readTree dir = do
- d <- readDirectory $ dir++"/."
- let ps = zipPaths $ "" :/ (free d)
- fd = F.foldr (:) [] ps
- dirs = tail $ getDirs [] $ free d
- return $ (dirs, fd)
-
-
-------------------------------------------------------------------------------
--- Calls readTree and returns it's value in a quasiquote.
-dirQ :: FilePath -> Q Exp
-dirQ tplDir = do
- d <- runIO $ readTree $ "project_template/"++tplDir
- runQ [| d |]
-
-
-------------------------------------------------------------------------------
--- Creates a declaration assigning the specified name the value returned by
--- dirQ.
-buildData :: String -> FilePath -> Q [Dec]
-buildData dirName tplDir = do
- v <- valD (varP (mkName dirName))
- (normalB $ dirQ tplDir)
- []
- return [v]
-
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
