[Snap Framework] snap branch, master, updated. e3e4ca0ee082b5f3dd82f4634067dc47a21af267

noreply at snapframework.com noreply at snapframework.com
Mon Jun 21 11:30:45 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".

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


More information about the Snap mailing list