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 e3e4ca0ee082b5f3dd82f4634067dc47a21af267 (commit)
from 7e8c42be19f0c6b5f19fc70b748e4ab436cceb48 (commit)
Summary of changes:
project_template/hint/foo.cabal | 37 ++++++++++++
project_template/hint/resources/static/favicon.ico | Bin 32038 -> 0 bytes
.../hint/resources/templates/index.tpl | 14 +++++
project_template/hint/src/Config.hs | 15 +++++
project_template/hint/src/Main.hs | 29 +++++++++
project_template/hint/src/Site.hs | 33 +++++++++++
snap.cabal | 61 +++++++++++++++++++-
src/Snap/Loader/Static.hs | 6 +-
src/Snap/Starter.hs | 20 ++++--
src/Snap/StarterTH.hs | 10 ++--
10 files changed, 207 insertions(+), 18 deletions(-)
delete mode 100644 project_template/hint/resources/static/favicon.ico
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 e3e4ca0ee082b5f3dd82f4634067dc47a21af267
Author: Carl Howells <[email protected]>
Date: Mon Jun 21 09:30:38 2010 -0700
Make things work (not production-ready)
diff --git a/project_template/hint/foo.cabal b/project_template/hint/foo.cabal
index e69de29..edac802 100644
--- a/project_template/hint/foo.cabal
+++ b/project_template/hint/foo.cabal
@@ -0,0 +1,37 @@
+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
+
+Flag production
+ Description: Whether to build the server in production (static loading) mode
+ Default: False
+
+Executable projname
+ hs-source-dirs: src
+ main-is: Main.hs
+
+ if flag(production)
+ cpp-options: -DPRODUCTION
+
+ Build-depends:
+ base >= 4 && < 5,
+ bytestring >= 0.9.1 && < 0.10,
+ directory >= 1.0.0.0 && < 1.1,
+ filepath >= 1.0 && < 1.2,
+ monads-fd >= 0.1 && < 0.2,
+ snap >= 0.3 && < 0.4,
+ snap-core >= 0.3 && < 0.4,
+ snap-server >= 0.3 && < 0.4,
+ heist >= 0.2.1 && < 0.3,
+ hint >= 0.3.2 && < 0.4,
+ template-haskell >= 2.3 && < 2.5
+
+ ghc-options: -O2 -Wall -fwarn-tabs -threaded
diff --git a/project_template/hint/resources/static/favicon.ico
b/project_template/hint/resources/static/favicon.ico
deleted file mode 100644
index af01ed3..0000000
Binary files a/project_template/hint/resources/static/favicon.ico and /dev/null
differ
diff --git a/project_template/hint/resources/templates/index.tpl
b/project_template/hint/resources/templates/index.tpl
index e69de29..7cdbf1c 100644
--- a/project_template/hint/resources/templates/index.tpl
+++ b/project_template/hint/resources/templates/index.tpl
@@ -0,0 +1,14 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd";>
+<html xmlns="http://www.w3.org/1999/xhtml";>
+ <head>
+ <title>Snap web server</title>
+ <link rel="stylesheet" type="text/css" href="screen.css"/>
+ </head>
+ <body>
+ <h1>It works!</h1>
+ <p>
+ This is a simple demo page served using Heist and the Snap
+ framework.
+ </p>
+ </body>
+</html>
diff --git a/project_template/hint/src/Config.hs
b/project_template/hint/src/Config.hs
index e69de29..3790195 100644
--- a/project_template/hint/src/Config.hs
+++ b/project_template/hint/src/Config.hs
@@ -0,0 +1,15 @@
+module Config where
+
+import Control.Applicative ((<$>))
+import Snap.Types
+import Text.Templating.Heist
+
+data Config = Config {
+ templateState :: TemplateState Snap
+ }
+
+
+getConfig :: IO Config
+getConfig = do
+ let ets = loadTemplates "resources/templates" emptyTemplateState
+ either error Config <$> ets
diff --git a/project_template/hint/src/Main.hs
b/project_template/hint/src/Main.hs
index e69de29..48f1680 100644
--- a/project_template/hint/src/Main.hs
+++ b/project_template/hint/src/Main.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings, CPP, TemplateHaskell #-}
+module Main where
+
+import Config (getConfig)
+import Site (site)
+
+import Snap.Http.Server (httpServe)
+
+#ifdef PRODUCTION
+import Snap.Loader.Static (loadSnapTH)
+#else
+import Snap.Loader.Hint (loadSnapTH)
+#endif
+
+import System.Environment (getArgs)
+
+
+main :: IO ()
+main = do
+ args <- getArgs
+ let port = case args of
+ [] -> 8000
+ p:_ -> read p
+ aLog = Just "log/access.log"
+ eLog = Just "log/error.log"
+
+ snap <- $(loadSnapTH 'getConfig 'site)
+
+ httpServe "*" port "localhost" aLog eLog snap
diff --git a/project_template/hint/src/Site.hs
b/project_template/hint/src/Site.hs
index e69de29..64598e0 100644
--- a/project_template/hint/src/Site.hs
+++ b/project_template/hint/src/Site.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Site where
+
+import Config
+
+import Control.Monad (msum)
+
+import qualified Data.ByteString.Char8 as S
+
+import Snap.Util.FileServe (fileServe)
+import Snap.Types
+
+import Text.Templating.Heist
+
+
+frontPage :: TemplateState Snap -> Snap ()
+frontPage ts = ifTop $ do
+ modifyResponse $ setContentType "text/html; charset=utf-8"
+
+ Just rendered <- renderTemplate ts "index"
+ writeBS rendered
+ let len = fromIntegral . S.length $ rendered
+ modifyResponse . setContentLength $ len
+
+
+staticResources :: Snap ()
+staticResources = fileServe "resources/static"
+
+
+site :: Config -> Snap ()
+site ts = msum [ frontPage $ templateState ts
+ , staticResources
+ ]
diff --git a/snap.cabal b/snap.cabal
index d8b2dfe..00410d7 100644
--- a/snap.cabal
+++ b/snap.cabal
@@ -22,7 +22,22 @@ extra-source-files:
CONTRIBUTORS,
LICENSE,
README.md,
- README.SNAP.md
+ README.SNAP.md,
+ project_template/barebones/foo.cabal,
+ project_template/barebones/src/Main.hs,
+ project_template/barebones/src/Server.hs,
+ project_template/default/foo.cabal,
+ project_template/default/src/Glue.hs,
+ project_template/default/src/Main.hs,
+ project_template/default/src/Server.hs,
+ project_template/hint/foo.cabal,
+ project_template/hint/log/access.log,
+ project_template/hint/log/error.log,
+ project_template/hint/resources/static/screen.css,
+ project_template/hint/resources/templates/index.tpl,
+ project_template/hint/src/Config.hs,
+ project_template/hint/src/Main.hs,
+ project_template/hint/src/Site.hs
Library
hs-source-dirs: src
@@ -37,7 +52,7 @@ Library
directory >= 1.0.0.0 && < 1.1,
filepath >= 1.0 && < 1.2,
monads-fd >= 0.1 && < 0.2,
- snap-core >= 0.2.7 && < 0.3,
+ snap-core == 0.3,
heist >= 0.2.1 && < 0.3,
hint >= 0.3.2 && < 0.4,
template-haskell >= 2.3 && < 2.5,
@@ -49,3 +64,45 @@ 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,
+ snap-core == 0.3,
+ snap-server == 0.3,
+ 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.git
diff --git a/src/Snap/Loader/Static.hs b/src/Snap/Loader/Static.hs
index b3ac8b1..5d58171 100644
--- a/src/Snap/Loader/Static.hs
+++ b/src/Snap/Loader/Static.hs
@@ -5,13 +5,11 @@ module Snap.Loader.Static where
------------------------------------------------------------------------------
import Language.Haskell.TH.Syntax
-
------------------------------------------------------------------------------
-- | XXX
-
loadSnapTH :: Name -> Name -> Q Exp
-loadSnapTH init action = do
- let initE = VarE init
+loadSnapTH initialize action = do
+ let initE = VarE initialize
actE = VarE action
fmapE = VarE 'fmap
simpleLoad = foldl AppE fmapE [actE, initE]
diff --git a/src/Snap/Starter.hs b/src/Snap/Starter.hs
index bddb339..4ee1b2b 100644
--- a/src/Snap/Starter.hs
+++ b/src/Snap/Starter.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
-module Snap.Starter where
+module Main where
------------------------------------------------------------------------------
import Data.List
@@ -14,7 +14,7 @@ import Snap.StarterTH
------------------------------------------------------------------------------
--- Creates a value tDir :: ([String], [(String, String)])
+-- Creates a value tDir :: ([String], [(String, ByteString)])
$(buildData "tDirDefault" "default")
$(buildData "tDirBareBones" "barebones")
$(buildData "tDirHint" "hint")
@@ -34,6 +34,7 @@ usage = unlines
------------------------------------------------------------------------------
data InitFlag = InitBareBones
| InitHelp
+ | InitHint
deriving (Show, Eq)
@@ -44,7 +45,7 @@ setup projName tDir = do
where
write (f,c) =
if isSuffixOf "foo.cabal" f
- then writeFile (projName++".cabal") (insertProjName $ T.pack c)
+ then writeFile (projName ++ ".cabal") (insertProjName $ T.pack c)
else writeFile f c
insertProjName c = T.unpack $ T.replace
(T.pack "projname")
@@ -57,7 +58,7 @@ initProject args = do
(flags, _, [])
| InitHelp `elem` flags -> do putStrLn initUsage
exitFailure
- | otherwise -> init' (InitBareBones `elem` flags)
+ | otherwise -> init' flags
(_, _, errs) -> do putStrLn $ concat errs
putStrLn initUsage
@@ -77,13 +78,19 @@ initProject args = do
"Depend only on -core and -server"
, Option ['h'] ["help"] (NoArg InitHelp)
"Print this message"
+ , Option ['i'] ["hint"] (NoArg InitHint)
+ "Depend on hint"
]
- init' isBareBones = do
+ init' flags = do
cur <- getCurrentDirectory
let dirs = splitDirectories cur
projName = last dirs
- setup projName (if isBareBones then tDirBareBones else tDirDefault)
+ setup' = setup projName
+ case flags of
+ (_:_) | InitHint `elem` flags -> setup' tDirHint
+ | InitBareBones `elem` flags -> setup' tDirBareBones
+ _ -> setup' tDirDefault
------------------------------------------------------------------------------
@@ -94,4 +101,3 @@ main = do
("init":args') -> initProject args'
_ -> do putStrLn usage
exitFailure
-
diff --git a/src/Snap/StarterTH.hs b/src/Snap/StarterTH.hs
index 17f8cce..469850b 100644
--- a/src/Snap/StarterTH.hs
+++ b/src/Snap/StarterTH.hs
@@ -28,18 +28,19 @@ getDirs _ (Failed _ _) = []
-- encountered and a list of filenames and content strings.
readTree :: FilePath -> IO ([DirData], [FileData])
readTree dir = do
- d <- readDirectory $ dir++"/."
+ d <- readDirectory $ dir ++ "/."
let ps = zipPaths $ "" :/ (free d)
fd = F.foldr (:) [] ps
- dirs = tail $ getDirs [] $ free d
- return $ (dirs, fd)
+ 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
+ d <- runIO . readTree $ "project_template/"++tplDir
runQ [| d |]
@@ -52,4 +53,3 @@ buildData dirName tplDir = do
(normalB $ dirQ tplDir)
[]
return [v]
-
-----------------------------------------------------------------------
hooks/post-receive
--
snap
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
