[Snap Framework] snap-core branch, 0.3, updated. 75d82f80c2900aea2c0c7e831258a03c5f75e4bd

noreply at snapframework.com noreply at snapframework.com
Sun Jun 20 13:12:06 CDT 2010


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 <chowells at others.local>
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:          maintainer at example.com
-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:          maintainer at example.com
-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


More information about the Snap mailing list