packages feed

happstack 0.3.2 → 0.4.1

raw patch · 7 files changed

+74/−25 lines, 7 filesdep ~HStringTemplatedep ~happstack-datadep ~happstack-ixsetnew-uploader

Dependency ranges changed: HStringTemplate, happstack-data, happstack-ixset, happstack-server, happstack-state, happstack-util, hsx

Files

CHANGELOG view
@@ -1,3 +1,23 @@+Happstack 0.4+ * happstack-server: Added support for SendFile with an alternate constructor for 'Response'+       data Response  = Response  { rsCode      :: Int,+                                    rsHeaders   :: Headers,+                                    rsFlags     :: RsFlags,+                                    rsBody      :: L.ByteString,+                                    rsValidator :: Maybe (Response -> IO Response)+                                  }+                      | SendFile  { rsCode      :: Int,+                                    rsHeaders   :: Headers,+                                    rsFlags     :: RsFlags,+                                    rsValidator :: Maybe (Response -> IO Response),+                                    sfHandle    :: Handle,  -- file handle to send from+                                    sfOffset    :: Integer, -- offset to start at+                                    sfCount     :: Integer  -- number of bytes to send+                                  }+                      deriving (Show,Typeable) + * happstack-server: fileServe uses SendFile so the memory efficiency & performance should be much better+ * happstack-server: added guards 'host' and 'withHost' to SimpleHTTP+ * happstack-server: nuked Happstack.Server.S3 since other hackage libraries cover this functionality these days Happstack 0.3  * Modularization of the example application using the component system  * All packages now require Cabal >= 1.6
happstack.cabal view
@@ -1,5 +1,5 @@ Name:                happstack-Version:             0.3.2+Version:             0.4.1 Synopsis:            The haskell application server stack + code generation Description:         The haskell application server stack License:             BSD3@@ -48,7 +48,7 @@ source-repository head     type:     darcs     subdir:   happstack-    location: http://patch-tag.com/publicrepos/happstack+    location: http://patch-tag.com/r/mae/happstack/pullrepo  Flag base4     Description: Choose the even newer, even smaller, split-up base package.@@ -59,6 +59,7 @@  Library   exposed-modules:     Happstack.Server.HSP.HTML+                       Happstack.Server.HSX                        Happstack.Server.HStringTemplate                        Happstack.State.ClockTime   if flag(tests)@@ -67,23 +68,24 @@    build-depends:       base >= 3,                        bytestring,-                       happstack-data >= 0.3.2 && < 0.4,-                       happstack-ixset >= 0.3.2 && < 0.4,-                       happstack-server >= 0.3.2 && < 0.4,-                       happstack-state >= 0.3.2 && < 0.4,-                       happstack-util >= 0.3.2 && < 0.4,+                       happstack-data >= 0.4.1 && < 0.5,+                       happstack-ixset >= 0.4.1 && < 0.5,+                       happstack-server >= 0.4.1 && < 0.5,+                       happstack-state >= 0.4.1 && < 0.5,+                       happstack-util >= 0.4.1 && < 0.5,                        hslogger,                        hsp >= 0.4.5 && < 0.5,-                       HStringTemplate >= 0.4.3 && < 0.5,+                       HStringTemplate >= 0.4.3 && < 0.7,                        mtl,                        old-time,                        utf8-string                           if flag(base4)-    Build-Depends:     base >= 4 && < 5, syb+    Build-Depends:     base >= 4 && < 5, syb,+                       hsx >= 0.5.5 && < 0.6   else     build-depends:     haskell-src-exts == 0.3.9,-                       hsx == 0.4.5+                       hsx == 0.4.5, HStringTemplate < 0.6    hs-source-dirs:      src   if flag(tests)
+ src/Happstack/Server/HSX.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}+module Happstack.Server.HSX where++import Happstack.Server.SimpleHTTP (ServerMonad(..), FilterMonad(..), WebMonad(..))+import HSX.XMLGenerator (XMLGenT(..))++instance (ServerMonad m) => ServerMonad (XMLGenT m) where+    askRq = XMLGenT askRq+    localRq f (XMLGenT m) = XMLGenT (localRq f m)++instance (FilterMonad a m) => FilterMonad a (XMLGenT m) where+    setFilter = XMLGenT . setFilter+    composeFilter f = XMLGenT (composeFilter f)+    getFilter (XMLGenT m) = XMLGenT (getFilter m)++instance (WebMonad a m) => WebMonad a (XMLGenT m) where+    finishWith r = XMLGenT $ finishWith r
templates/project/src/App/View.hs view
@@ -75,8 +75,11 @@             </p>            <p>Leave a message for the next visitor here...</p>            <form action="/entries" method="post" enctype="multipart/form-data;charset=UTF-8" accept-charset="UTF-8">-            <p><label for="author">A<span class="accesskey">u</span>thor</label><br /><input type="text" name="author" id="author" tabindex="1" accesskey="U" /></p>+            <p><label for="author">A<span class="accesskey">u</span>thor</label><br /><input type="text" name="author" id="author" tabindex="1" accesskey="U" />+            </p>             <p><label for="message"><span class="accesskey">M</span>essage</label><br /><textarea cols="80" rows="10" name="message" id="message" tabindex="2" accesskey="M"></textarea></p>+            <p><label for="email"><span class="accesskey">E</span>mail</label><br /><input type="text" name="email" id="email" tabindex="3" accesskey="E" />+            </p>             <p><input type="submit" tabindex="3" accesskey="L" value="Leave GuestBook Entry" /></p>            </form>           </div>
templates/project/src/GuestBook.hs view
@@ -1,10 +1,10 @@ module GuestBook      ( module GuestBook.Control-    , module GuestBook.State+    , module GuestBook.State2     , module GuestBook.View     )     where  import GuestBook.Control-import GuestBook.State+import GuestBook.State2 import GuestBook.View
templates/project/src/GuestBook/Control.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} {-# OPTIONS_GHC -F -pgmFtrhsx #-} module GuestBook.Control where @@ -6,13 +6,14 @@ import Control.Monad(msum) import Control.Monad.Trans(liftIO) import Data.ByteString.Lazy.UTF8 (toString)-import GuestBook.State (GuestBookEntry(..),AddGuestBookEntry(..),ReadGuestBook(..))+import GuestBook.State2 (GuestBookEntry(..),AddGuestBookEntry(..),ReadGuestBook(..)) import GuestBook.View import Happstack.Server import Happstack.Data(defaultValue) import Happstack.State(query,update) import HSP import System.Time(getClockTime)+import Control.Monad  guestBookHandler :: ServerPartT IO (HSP XML) guestBookHandler =@@ -20,10 +21,13 @@  postEntry :: ServerPartT IO (HSP XML) postEntry = methodM POST >> do -- only accept a post method-  Just entry <- getData -- get the data-  now <- liftIO getClockTime-  update $ AddGuestBookEntry entry{date=now}-  seeOther "/entries" (seeOtherXML "/entries")+  mbEntry <- getData -- get the data+  case mbEntry of +    Nothing -> error $ "error: postEntry" +    Just entry -> do+      now <- liftIO getClockTime+      update $ AddGuestBookEntry entry{date=now}+      seeOther "/entries" (seeOtherXML "/entries")  -- |show all the entries in the guestbook -- argument is a callback function @@ -36,6 +40,7 @@ -- this tells happstack how to turn post data into a datatype using 'withData' instance FromData GuestBookEntry where   fromData = do-    author  <- look "author"-    message <- look "message"-    return $ GuestBookEntry (if null author then "Anonymous" else author) message defaultValue+    author  <- look "author" `mplus` (error "GuestBookEntry, need author")+    message <- look "message" `mplus` (error "GuesBookEntry, need message")+    email   <- look "email" `mplus` (error "GuestBookEntry: need email")+    return $ GuestBookEntry (if null author then "Anonymous" else author) message defaultValue email
templates/project/src/GuestBook/View.hs view
@@ -2,7 +2,7 @@ {-# OPTIONS_GHC -F -pgmFtrhsx #-} module GuestBook.View where -import GuestBook.State (GuestBook(..),GuestBookEntry(..))+import GuestBook.State2 (GuestBook(..),GuestBookEntry(..)) import HSP import qualified HSX.XMLGenerator as HSX (XML) import System.Locale (defaultTimeLocale)@@ -20,16 +20,18 @@ -- * Main Implementation  instance (XMLGenerator m) => (EmbedAsChild m (GuestBookEntry, Bool)) where-    asChild ((GuestBookEntry author message date), alt) =+    asChild ((GuestBookEntry author message date email), alt) =          <%            <li class=(if alt then "alt" else "")>-            <strong><% author %></strong> said:<br /><br />+            <strong><% author ++ (displayemail email)  %></strong> said:<br /><br />             <% map p (lines message) %>             <br />             <small class="commentmetadata"><% dateStr date %></small>             </li>          %>         where p str = <p><% str %></p>+              displayemail "" = ""+              displayemail x = "<" ++ x ++ ">"  instance (XMLGenerator m) => (EmbedAsChild m GuestBook) where     asChild (GuestBook entries) =