WebCont 0.0.0 → 0.0.1

raw patch · 2 files changed

+22/−6 lines, 2 filesdep ~concatenative

Dependency ranges changed: concatenative

Files

• WebCont.cabal +2/−2
• WebCont.hs +20/−4

@@ -3,7 +3,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.0.0+Version:             0.0.1  -- A short (one-line) description of the package. Synopsis:            Continuation based web programming for Happstack@@ -50,7 +50,7 @@   Exposed-modules:     WebCont      -- Packages needed in order to build this package.-  Build-depends:       happstack-server >= 0.5, happstack-state >= 0.5, happstack-util >= 0.5, mtl, concatenative >= 1, formlets < 1,+  Build-depends:       happstack-server >= 0.5, happstack-state >= 0.5, happstack-util >= 0.5, mtl, concatenative >= 1.0.1, formlets < 1,                        utf8-string, containers, xhtml, applicative-extras, base >= 3 && < 5      -- Modules not exported by this package.

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-| WebConts allow simple continuation based behavior in Happstack applications through the use of cookies     and an IntMap on the server mapping cookie names to continuations.      It is based on the paste <http://gist.github.com/260052>. For the arc challenge:@@ -23,7 +23,8 @@  -} module WebCont (-    doform, doform', runWithState, runStateless, frm, display, samelink,+    doform, doform', runWithState, runStateless,+    frm, display, samelink, button, link,     WebCont(..), Result(..), ContForm, DefaultForm, nullConf, ) where import Happstack.Server.SimpleHTTP hiding (method)@@ -40,7 +41,7 @@ import Control.Applicative.Error (Failing (..)) import Text.Formlets import Text.XHtml.Strict.Formlets hiding (label)-import Text.XHtml.Strict hiding (input, checkbox)+import Text.XHtml.Strict hiding (input, checkbox, button) import qualified Data.IntMap as Map import Data.IntMap (IntMap) import Data.Monoid@@ -68,11 +69,18 @@         Done a -> runWeb (f a) e         Via r w' -> Via r (w' >>= f) +instance (Monoid a) => Monoid (WebCont a a) where+    (WebCont f) `mappend` (WebCont g) = WebCont $ f &&. g >>@ c where+        (Done h1) `c` (Via h2 a) = Via (h1 `mappend` h2) a+        (Via h1 a) `c` (Done h2) = Via (h1 `mappend` h2) a+        (Via v a) `c` (Via t b) = Via (v `mappend` t) (a `mappend` b)+    mempty = WebCont . const . Done $ mempty+ instance (Monoid r, Monoid a) => Monoid (WebCont r a) where     (WebCont f) `mappend` (WebCont g) = WebCont $ f &&. g >>@ c where         (Done _) `c` x@(Via _ _) = x         x@(Via _ _) `c` (Done _) = x-        (Via v a) `c` (Via t b) = Via (v `mappend` t) (a `mappend` b) -- this instance seems flawed+        (Via v a) `c` (Via t b) = Via (v `mappend` t) (a `mappend` b)     mempty = WebCont . const . Done $ mempty  -- | Lift a form into the WebCont monad using a function@@ -97,6 +105,14 @@ -- | Display a page, ignoring the value display :: HTML a => a -> WebCont Html () display h = WebCont $ const $ Via (toHtml h) (return ())++-- | Button with an associated value+button :: String -> a -> WebCont Html a+button s a = display (form ! [method "POST"] << (submit "submit" s)) >> return a++-- | Link with an associated value+link :: HTML l => l -> a -> WebCont Html a+link l a = display (samelink l) >> return a  -- | Links to the same page, leading to the next step in a continuation samelink :: HTML a => a -> HotLink