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-website".
The branch, master has been updated
via 15673ed89e78081b18043e9a663e4beea873fa24 (commit)
from 1051b1fc03202691620a00e9eb0538246306234a (commit)
Summary of changes:
blogdata/config | 12 +
.../content/2010/05/22/announce-snap-framework.md | 41 ++++
.../content/2010/05/30/snap-framework-update.md | 51 +++++
blogdata/content/i/feed.png | Bin 0 -> 1737 bytes
blogdata/templates/index.tpl | 25 ++
blogdata/templates/post.tpl | 17 ++
snap-website.cabal | 3 +-
src/Main.hs | 231 ++++++++++++--------
static/media/css/main.css | 91 ++++++++-
templates/nav.tpl | 3 +
10 files changed, 382 insertions(+), 92 deletions(-)
create mode 100644 blogdata/config
create mode 100644 blogdata/content/2010/05/22/announce-snap-framework.md
create mode 100644 blogdata/content/2010/05/30/snap-framework-update.md
create mode 100755 blogdata/content/i/feed.png
create mode 100644 blogdata/content/index.md
create mode 100644 blogdata/templates/index.tpl
create mode 100644 blogdata/templates/post.tpl
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 15673ed89e78081b18043e9a663e4beea873fa24
Author: Gregory Collins <[email protected]>
Date: Sat Jun 19 01:51:21 2010 -0400
Add blog to snap-website
diff --git a/blogdata/config b/blogdata/config
new file mode 100644
index 0000000..9f2fdc7
--- /dev/null
+++ b/blogdata/config
@@ -0,0 +1,12 @@
+[default]
+siteurl = http://snapframework.com
+
+# posts are mapped to this URL
+baseurl = /blog
+
+
+[feed]
+title = Snap Framework Blog
+authors = Snap Framework <[email protected]>
+#icon = /static/icon.png
+skipurls =
diff --git a/blogdata/content/2010/05/22/announce-snap-framework.md
b/blogdata/content/2010/05/22/announce-snap-framework.md
new file mode 100644
index 0000000..539bcb4
--- /dev/null
+++ b/blogdata/content/2010/05/22/announce-snap-framework.md
@@ -0,0 +1,41 @@
+| title: Announcing: Snap Framework v0.1
+| author: Gregory Collins <[email protected]>
+| published: 2010-05-22T01:25:00-0400
+| updated: 2010-05-22T01:25:00-0400
+| summary: The first public release of the Snap Framework is now available.
Snap is a simple and fast web development framework for unix systems, written
in the Haskell programming language.
+
+To coincide with [Hac Phi 2010](http://www.haskell.org/haskellwiki/Hac_%CF%86),
+the Snap team is happy to announce the first public release of the Snap
+Framework, a simple and fast Haskell web programming server and library for
+unix systems. For installation instructions, documentation, and more
+information, see our website at [snapframework.com](http://snapframework.com/).
+
+Snap is well-documented and has a test suite with a high level of code
+coverage, but it is early-stage software with still-evolving interfaces. Snap
+is therefore most likely to be of interest to early adopters and potential
+contributors.
+
+Snap is BSD-licensed and currently only runs on Unix platforms; it has been
+developed and tested on Linux and Mac OSX Snow Leopard.
+
+Snap Features:
+
+ * A simple and clean monad for web programming, similar to happstack's but
+ simpler.
+
+ * A *fast* HTTP server library with an optional high-concurrency backend
+ (using libev).
+
+ * An XML-based templating system for generating xhtml that allows you to bind
+ Haskell functionality to XML tags in your templates.
+
+ * Some useful utilities for web handlers, including gzip compression and
+ fileServe.
+
+ * Iteratee-based I/O, allowing composable streaming in O(1) space without any
+ of the unpredictable consequences of lazy I/O.
+
+If you have questions or comments, please contact us on our [mailing
+list](http://mailman-mail5.webfaction.com/listinfo/snap) or in the
+[#snapframework](http://webchat.freenode.net/?channels=snapframework&uio=d4)
+channel on the freenode IRC network.
diff --git a/blogdata/content/2010/05/30/snap-framework-update.md
b/blogdata/content/2010/05/30/snap-framework-update.md
new file mode 100644
index 0000000..27bf378
--- /dev/null
+++ b/blogdata/content/2010/05/30/snap-framework-update.md
@@ -0,0 +1,51 @@
+| title: Snap Framework: What's new this week?
+| author: Gregory Collins <[email protected]>
+| published: 2010-05-30T02:42:00-0400
+| updated: 2010-05-30T14:00:00-0400
+| summary: Summarizes the changes between snap-core/-server v0.1.1 (released
last week) and snap-core v0.2.5 (released today).
+
+Hi all,
+
+Since we put out [the Snap framework](http://snapframework.com/) last weekend,
+we've been working like busy beavers on squashing correctness and performance
+bugs. Updated haddocks/etc should be up on our website by tomorrow
+afternoon. Here's a short list of the changes in Snap this week:
+
+ - **WINDOWS SUPPORT** thanks to Jacob Stanley (a.k.a. "jystic").
+
+ - A fix for a grave performance bug with `Transfer-encoding: chunked`; we
+ weren't buffering its input, causing lots of tiny http transfer chunks for
+ certain pathological input, ruining performance. (This is the one [Michael
+ Snoyman reported](http://www.snoyman.com/blog/entry/bigtable-benchmarks/)
+ btw.) Switching to buffering its input increased performance on this test by
+ at least an order of magnitude.
+
+ - Huge improvements to the `libev` backend for `snap-server`, including fixing
+ a correctness/hang bug and an edge-/level-triggering issue. Performance
+ should be improved to the point where the `libev` backend should be
+ considered the "go-to" setup for production `snap-server` deployments.
+
+ - Improved timeout handling in the "simple"/stock haskell `snap-server`
+ backend. This costs us some performance on the stock backend, but
+ correctness is more important (and users wanting maximum performance should
+ stick with the `libev` backend).
+
+ - Fixed an `attoparsec-iteratee` bug that resulted in spurious "parser did not
+ produce a value" messages cluttering `error.log`.
+
+ - Fixed a localtime/GMT timezone bug which prevented static files from being
+ recognized as "not modified."
+
+ - Fixed an HTTP cookie reading bug in `snap-server`.
+
+ - Killed several space leaks.
+
+ - Fixes to the way Snap handles `accept-encoding` headers in the GZip code --
+ requests from Konqueror and Links are no longer incorrectly rejected.
+
+ - The `snap` command-line tool now has an option to not depend on heist.
+
+ - Exposed error logging to the `Snap` monad.
+
+ - ..and a whole host of smaller additions/improvements....
+
diff --git a/blogdata/content/i/feed.png b/blogdata/content/i/feed.png
new file mode 100755
index 0000000..d64c669
Binary files /dev/null and b/blogdata/content/i/feed.png differ
diff --git a/blogdata/content/index.md b/blogdata/content/index.md
new file mode 100644
index 0000000..e69de29
diff --git a/blogdata/templates/index.tpl b/blogdata/templates/index.tpl
new file mode 100644
index 0000000..6c7adbd
--- /dev/null
+++ b/blogdata/templates/index.tpl
@@ -0,0 +1,25 @@
+<bind tag="subtitle">: Blog</bind>
+<apply template="page">
+
+ <div id="blog-index">
+ <h2>
+ <a href="/blog">Snap Framework Blog</a>
+ <a href="/blog/feed.xml"><img src="/blog/i/feed.png"/></a>
+ </h2>
+ <table>
+ <posts:reverseChronological>
+ <tr class="post">
+ <td class="date"><post:date/></td>
+ <td class="title">
+ <a href="$(post:url)"><post:title/></a>
+ </td>
+ <td class="summary"><post:summary/></td>
+ </tr>
+ </posts:reverseChronological>
+ </table>
+
+ <div class="clear"/>
+ </div>
+
+</apply>
+
diff --git a/blogdata/templates/post.tpl b/blogdata/templates/post.tpl
new file mode 100644
index 0000000..5216a2d
--- /dev/null
+++ b/blogdata/templates/post.tpl
@@ -0,0 +1,17 @@
+<bind tag="subtitle">: Blog: <post:title/></bind>
+<apply template="page">
+
+ <div id="blog-post">
+ <h2><post:title/></h2>
+
+ <div class="post-meta">
+ <div class="post-date"><post:date/></div>
+ <div class="post-summary"><post:summary/></div>
+ </div>
+
+ <div class="post-content">
+ <post:content/>
+ </div>
+ </div>
+
+</apply>
diff --git a/snap-website.cabal b/snap-website.cabal
index 6a72a27..01f8b99 100644
--- a/snap-website.cabal
+++ b/snap-website.cabal
@@ -1,5 +1,5 @@
Name: snap-website
-Version: 0.2
+Version: 0.3
Synopsis: The Snap Framework Website
Homepage: http://snapframework.com
License: BSD3
@@ -29,6 +29,7 @@ Executable snap-website
process,
snap-core >= 0.2.1 && <0.3,
snap-server >= 0.2.1 && <0.3,
+ snap-static-pages >= 0.0.1 && <0.1,
text,
transformers,
unix,
diff --git a/src/Main.hs b/src/Main.hs
index a39776e..342bf0b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,49 +1,86 @@
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-import qualified Data.Map as Map
-import Data.Maybe
-import qualified Data.Text as T
-import Control.Applicative
-import Control.Concurrent
-import Control.Exception (SomeException)
-import Control.Monad
-import Control.Monad.CatchIO
-import Control.Monad.Trans
-import Prelude hiding (catch)
-import Snap.Http.Server
-import Snap.Types
-import Snap.Util.FileServe
-import Snap.Util.GZip
-import System
-import System.Posix.Env
-import Text.Templating.Heist
-import Text.Templating.Heist.Splices.Static
-import qualified Text.XHtmlCombinators.Escape as XH
-import Text.XML.Expat.Tree hiding (Node)
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.Map as Map
+import Data.Maybe
+import qualified Data.Text as T
+import Data.Typeable
+import Control.Applicative
+import Control.Concurrent
+import Control.Exception (SomeException)
+import Control.Monad
+import Control.Monad.CatchIO
+import "monads-fd" Control.Monad.Trans
+import "monads-fd" Control.Monad.Reader
+import Prelude hiding (catch)
+import Snap.Http.Server
+import Snap.StaticPages
+import Snap.Types
+import Snap.Util.FileServe
+import Snap.Util.GZip
+import System
+import System.Posix.Env
+import Text.Templating.Heist
+import Text.Templating.Heist.Splices.Static
+import qualified Text.XHtmlCombinators.Escape as XH
+import Text.XML.Expat.Tree hiding (Node)
-setLocaleToUTF8 :: IO ()
-setLocaleToUTF8 = do
- mapM_ (\k -> setEnv k "en_US.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" ]
+
+------------------------------------------------------------------------------
+-- snapframework.com site state
+------------------------------------------------------------------------------
+data SiteState = SiteState {
+ _origTs :: TemplateState Snap
+ , _currentTs :: MVar (TemplateState Snap)
+ , _staticTagCache :: StaticTagState
+ , _blogState :: MVar StaticPagesState
+}
+
+
+type Site a = ReaderT SiteState Snap a
+
+
+initSiteState :: IO SiteState
+initSiteState = do
+ setLocaleToUTF8
+
+ (origTs,staticState) <- bindStaticTag .
+ bindSplice "snap-version" serverVersion
+ $ emptyTemplateState
+
+ ets <- loadTemplates "templates" origTs
+ let ts = either error id ets
+ either (\s -> putStrLn (loadError s) >> exitFailure) (const $ return ())
ets
+ tsMVar <- newMVar $ ts
+
+ bs <- loadStaticPages' ts "blogdata"
+
+ return $ SiteState origTs tsMVar staticState bs
+
+
+data ReloadException = ReloadException String
+ deriving (Show, Typeable)
+
+instance Exception ReloadException
+
+
+reloadSiteState :: SiteState -> IO ()
+reloadSiteState ss = do
+ clearStaticTagCache $ _staticTagCache ss
+ ts <- loadTemplates "templates" $ _origTs ss
+ tt <- either (\msg -> throw $ ReloadException $ loadError msg)
+ (\t -> do
+ modifyMVar_ (_currentTs ss) (const $ return t)
+ return t)
+ ts
+ reloadStaticPages' tt $ _blogState ss
------------------------------------------------------------------------------
@@ -61,48 +98,36 @@ renderTmpl tsMVar n = do
maybe pass writeBS =<< renderTemplate ts n
-templateServe :: TemplateState Snap
- -> MVar (TemplateState Snap)
- -> StaticTagState
+templateServe :: MVar (TemplateState Snap)
-> Snap ()
-templateServe orig tsMVar staticState = do
+templateServe tsMVar = do
p
modifyResponse $ setContentType "text/html"
where
p = ifTop (renderTmpl tsMVar "index") <|>
- path "admin/reload" (reloadTemplates orig tsMVar staticState) <|>
(renderTmpl tsMVar . B.pack =<< getSafePath)
loadError :: String -> String
loadError str = "Error loading templates\n"++str
-reloadTemplates :: TemplateState Snap
- -> MVar (TemplateState Snap)
- -> StaticTagState
- -> Snap ()
-reloadTemplates origTs tsMVar staticState = do
- liftIO $ clearStaticTagCache staticState
- ts <- liftIO $ loadTemplates "templates" origTs
- either bad good ts
- where
- bad msg = do writeBS $ B.pack $ loadError msg ++ "Keeping old templates."
- good ts = do liftIO $ modifyMVar_ tsMVar (const $ return ts)
- writeBS "Templates loaded successfully"
-site :: TemplateState Snap
- -> MVar (TemplateState Snap)
- -> StaticTagState
- -> Snap ()
-site origTs tsMVar staticState =
+------------------------------------------------------------------------------
+-- handlers
+------------------------------------------------------------------------------
+site :: SiteState -> Snap ()
+site ss =
catch500 $ withCompression $
- route [ ("docs/api", apidoc tsMVar) ] <|>
- templateServe origTs tsMVar staticState <|>
+ route [ ("docs/api", runReaderT apidoc ss)
+ , ("admin/reload", runReaderT reload ss)
+ , ("blog/", serveStaticPages (_blogState ss)) ] <|>
+ templateServe (_currentTs ss) <|>
fileServe "static"
+
catch500 :: Snap a -> Snap ()
catch500 m = (m >> return ()) `catch` \(e::SomeException) -> do
let t = T.pack $ show e
@@ -119,21 +144,36 @@ catch500 m = (m >> return ()) `catch` \(e::SomeException)
-> do
r = setContentType "text/html" $
setResponseStatus 500 "Internal Server Error" emptyResponse
+reload :: Site ()
+reload = do
+ e <- try (ask >>= liftIO . reloadSiteState)
+ lift $ do
+ either bad good e
+ modifyResponse $ setContentType "text/plain; charset=utf-8"
-apidoc :: MVar (TemplateState Snap) -> Snap ()
-apidoc mvar = do
- ts <- liftIO $ readMVar mvar
- -- remainder of pathInfo is the doc to lookup
- whichDoc <- liftM rqPathInfo getRequest
+ where
+ bad :: SomeException -> Snap ()
+ bad msg = writeBS $ B.pack $ loadError (show msg) ++ "Keeping old
templates."
+ good _ = writeBS "Templates loaded successfully"
- title <- maybe pass return $ Map.lookup whichDoc titles
- let href = B.concat ["/docs/latest/", whichDoc, "/index.html"]
- let ts' = bindSplice "docframe" (docframe href) $
- bindSplice "subtitle" (return [mkText title]) ts
+apidoc :: Site ()
+apidoc = do
+ ss <- ask
- modifyResponse $ setContentType "text/html"
- maybe pass writeBS =<< renderTemplate ts' "docs/api"
+ lift $ do
+ ts <- liftIO $ readMVar $ _currentTs ss
+ -- remainder of pathInfo is the doc to lookup
+ whichDoc <- liftM rqPathInfo getRequest
+
+ title <- maybe pass return $ Map.lookup whichDoc titles
+ let href = B.concat ["/docs/latest/", whichDoc, "/index.html"]
+
+ let ts' = bindSplice "docframe" (docframe href) $
+ bindSplice "subtitle" (return [mkText title]) ts
+
+ modifyResponse $ setContentType "text/html"
+ maybe pass writeBS =<< renderTemplate ts' "docs/api"
where
titles = Map.fromList [ ("snap-core", ": snap-core APIs")
@@ -144,10 +184,39 @@ apidoc mvar = do
docframe src = return [ mkElement "frame" [ ("id" , "docframe")
, ("src", src ) ] [] ]
+
+
+
+
+------------------------------------------------------------------------------
+-- MISC UTILITIES
+------------------------------------------------------------------------------
serverVersion :: Splice Snap
serverVersion = return $ [Text snapServerVersion]
+setLocaleToUTF8 :: IO ()
+setLocaleToUTF8 = do
+ mapM_ (\k -> setEnv k "en_US.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" ]
+
+
+------------------------------------------------------------------------------
+-- main
+------------------------------------------------------------------------------
main :: IO ()
main = do
args <- getArgs
@@ -155,23 +224,13 @@ main = do
[] -> error "You must specify a port!" >> exitFailure
(port:_) -> return $ read port
- setLocaleToUTF8
-
- (origTs,staticState) <- bindStaticTag .
- bindSplice "snap-version" serverVersion
- $ emptyTemplateState
-
- ets <- loadTemplates "templates" origTs
- let ts = either error id ets
- either (\s -> putStrLn (loadError s) >> exitFailure) (const $ return ())
ets
- tsMVar <- newMVar $ ts
+ ss <- initSiteState
(try $ httpServe "*" port "myserver"
(Just "access.log")
(Just "error.log")
- (site origTs tsMVar staticState)) :: IO (Either SomeException ())
+ (site ss)) :: IO (Either SomeException ())
threadDelay 1000000
putStrLn "exiting"
return ()
-
diff --git a/static/media/css/main.css b/static/media/css/main.css
index 0f01f07..20482a5 100644
--- a/static/media/css/main.css
+++ b/static/media/css/main.css
@@ -66,6 +66,8 @@ li{
list-style-type: none;
}
+li p:first-child { display: inline; }
+
li:before {
content: "» ";
}
@@ -113,6 +115,81 @@ pre.code, pre.sourceCode, pre.shell {
-webkit-border-radius: 10px;
}
+#blog-index table {
+ border-collapse:collapse;
+ border-spacing:0;
+}
+
+#blog-index h2 a {
+ vertical-align: middle;
+}
+
+#blog-post .post-content {
+ margin-bottom: 29px;
+}
+
+#blog-post div.post-meta {
+ width: 226px;
+ padding: 0 22px 0 0;
+ float: left;
+}
+
+#blog-post div.post-date {
+ line-height: 29px;
+ font-size: 70%;
+ margin-bottom: 29px;
+}
+
+#blog-post div.post-summary {
+ line-height: 29px;
+ color: #666;
+}
+
+#blog-post div.post-content {
+ width: 680px;
+ padding-right: 8px;
+ float: left;
+}
+
+#blog-post div.post-content hr {
+ width: 66%;
+ margin: 2.5em auto;
+}
+
+
+
+
+
+
+tr.post {
+ /*font-family: "Gill Sans", "PT Sans", "Arial", sans-serif;*/
+ font-family: "PT Sans", "Arial", sans-serif;
+}
+
+tr.post td { padding-bottom: 1.5em; }
+
+td.date {
+ width:118px;
+ padding-right:12px;
+ font-size:0.8em;
+ text-align:left;
+}
+
+td.summary {
+ color: #222;
+ font-size: 0.8em;
+ font-family: "Droid Serif", "Georgia", "Arial", "Helvetica", sans-serif;
+ width:388px;
+ padding-left: 12px;
+ margin-bottom: 1em;
+}
+
+td.title {
+ font-size: 1.2em;
+ width: 430px;
+}
+
+
table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode,
table.sourceCode pre
{ margin: 0; padding: 0; border: 0; vertical-align: baseline; border: none;
}
td.lineNumbers { text-align: right; background-color: #ccc; color: black;
padding-right: 5px; padding-left: 5px; }
@@ -189,7 +266,7 @@ pre.sourceCode span.InfixOperator { color: #aaa; }
margin: 0;
}
-.newspaper .inner h2, .singlecolumn h2
+.newspaper .inner h2, .singlecolumn h2, #blog-post h2, #blog-index h2
{
margin:0;
border-bottom: 1px solid #c2d1e1;
@@ -249,7 +326,6 @@ pre.sourceCode span.InfixOperator { color: #aaa; }
padding: 0;
width:100%;
min-height: 100%;
- margin-bottom: -40px;
/*background: #FFFFFF;*/
}
@@ -591,9 +667,14 @@ pre.sourceCode span.InfixOperator { color: #aaa; }
}
#footer{
+ position: fixed;
+ bottom: 0;
+ left: 0;
+ width: 100%;
+ clear: both;
border-top: 1px solid #C2D1E1;
color: #a0acba;
- padding: 4px 20px;
+ padding: 4px 0px;
height: 31px;
font-family: "PT Sans", sans-serif;
font-size: 0.75em;
@@ -612,12 +693,12 @@ pre.sourceCode span.InfixOperator { color: #aaa; }
}
#footer p{
+ padding: 0 20px;
margin: 0;
- padding: 0;
}
#footer p.part-1{
float:left;
}
#footer p.part-2{
float:right;
-}
\ No newline at end of file
+}
diff --git a/templates/nav.tpl b/templates/nav.tpl
index 6d15bdb..56b0527 100644
--- a/templates/nav.tpl
+++ b/templates/nav.tpl
@@ -16,6 +16,9 @@
<li class="about">
<a href="/about">About</a>
</li>
+ <li class="blog">
+ <a href="/blog">Blog</a>
+ </li>
<li class="download">
<a href="/download">Download</a>
</li>
-----------------------------------------------------------------------
hooks/post-receive
--
snap-website
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
