happstack 6.0.6 → 6.1.7
raw patch · 40 files changed
+4/−1518 lines, 40 filesdep −HStringTemplatedep −directorydep −filepathdep ~base
Dependencies removed: HStringTemplate, directory, filepath, haskell-src-exts, old-time, syb
Dependency ranges changed: base
Files
- CHANGELOG +0/−72
- CREDITS +0/−33
- RELEASE_NOTES +0/−216
- commands/happstack.hs +0/−91
- happstack.cabal +4/−60
- src/Happstack/State/ClockTime.hs +0/−18
- templates/project/COPYING +0/−29
- templates/project/Setup.hs +0/−13
- templates/project/bin/build.bat +0/−1
- templates/project/bin/build.sh +0/−2
- templates/project/bin/run-interactive.bat +0/−1
- templates/project/bin/run-interactive.sh +0/−2
- templates/project/bin/run.bat +0/−1
- templates/project/bin/run.sh +0/−2
- templates/project/guestbook.cabal +0/−60
- templates/project/public/theme/images/blockquote.gif binary
- templates/project/public/theme/images/date.gif binary
- templates/project/public/theme/images/entrymeta.gif binary
- templates/project/public/theme/images/grunge.gif binary
- templates/project/public/theme/images/header_loop.gif binary
- templates/project/public/theme/images/logo.gif binary
- templates/project/public/theme/images/menu_hili.gif binary
- templates/project/public/theme/images/menu_hover.gif binary
- templates/project/public/theme/images/peel.gif binary
- templates/project/public/theme/images/ql_rss.gif binary
- templates/project/public/theme/readme.txt +0/−1
- templates/project/public/theme/style.css +0/−349
- templates/project/src/Logger.hs +0/−66
- templates/project/src/Main.hs +0/−193
- templates/project/src/Pages.hs +0/−9
- templates/project/src/Pages/AppTemplate.hs +0/−95
- templates/project/src/Pages/Common.hs +0/−11
- templates/project/src/Pages/GuestBookEntries.hs +0/−42
- templates/project/src/Pages/PostEntry.hs +0/−23
- templates/project/src/Pages/Readme.hs +0/−14
- templates/project/src/Routes.hs +0/−23
- templates/project/src/State.hs +0/−28
- templates/project/src/State/GuestBook.hs +0/−30
- templates/project/src/Types/GuestBook.hs +0/−27
- templates/project/templates/readme.st +0/−6
− CHANGELOG
@@ -1,72 +0,0 @@-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- * Repository metadata added to cabal description- * Moved Combined Logging from Happstack.Server to Happstack.Server.AccessLog.Combined- * Added Happstack.Util.Mail: a simple email interface which utilizes a smarthost- * SimpleHTTP: look and lookPairs now assume utf-8 from the browser- * Space leak fixed in Happstack.Util.Timeout- * A fix for an issue where alphanumeric Accept-Encoding Requests made the parser fail- * Fixes for some command-line browsers such as links- * Guards now have fall-through semantics- * Various updates & additions to documentation- * Code beautification- * Bugfix to Happstack.Util.Cron to accept intervals up to maxBound- * addition of a strict version of fileServe "fileServeStrict"- * fileServe (lazy) behaves more reliably now and escapes before any filters can be applied--Happstack 0.2- * Module namespace refactoring from HAppS to Happstack- HAppS.Server -> Happstack.Server- HAppS.State -> Happstack.State- HAppS.Util -> Happstack.Util- HAppS.IxSet -> Happstack.IxSet- HAppS.Data -> Happstack.Data- HAppS.Contrib -> Happstack.Contrib- * Creation of additional package 'happstack'- * Code generation tool added for creating "quick start" project folders- * Removed dependency of happstack-server on happstack-state- * Removed dependency of happstack-server on happstack-ixset- * Module Cron module moved from happstack-server to happstack-util- * Moved Atom, HList, HListBase from happstack-data to happstack-contrib- * Monadic machinery for ServerPartT and WebT trimmed / cleaned / optimized (Daniel Rogers)- * New experimental gzip filter in happstack-server (similar to apache mod_deflate)- * Builtin support for HSP, HStringTemplate (see example template / release notes)- * happstack-server once again builds on Windows- * Nearly all the exported functions have been documented!- * Cookie fix from happstack-helpers was integrated into the main code- * Combined Logging via Happstack.Server NOTICE- -Happstack 0.1- * Cabal packaging name change:- HAppS-Server -> happstack-server- HAppS-State -> happstack-state- HAppS-Util -> happstack-util- HAppS-IxSet -> happstack-ixset- HAppS-Data -> happstack-data- * Creation of additional package 'happstack-contrib' (HAppS.Contrib)- * Moved Facebook module from happstack-server to happstack-contrib- * Fixed various warnings- * Removed dead modules and many dead code blocks- * Turned name resolution off for peers in HTTP.Listen (fixes getNameInfo crash)-
− CREDITS
@@ -1,33 +0,0 @@--- This file exists to honor the various contributions by individuals to--- the Happstack Project. Among these there will undoubtedly be ones I have--- missed. Please contact the mailing list at happs@googlegroups.com if updates--- need to be made. Much thanks to all our contributors!--- --- Sincerely,--- Matthew Elder <matt@mattelder.org>--Alex Jacobson- - HAppS founder- - HAppS Evangelist-Andrea Vezzosi- - Worked on original HAppS Project-Creighton Hogg- - Code Cleanup- - Maintainer of HAppS/Happstack Tutorial-Doug Beardsley- - Creator of various HAppS tutorials-Matthew Elder <matt@mattelder.org>- - Happstack Founder- - HAppS/Happstack Evangelist- - Code Generation Tool (Project Template)-Jeremy Shaw- - Creator of many example applications- - Hyena integration- - HSP Integration- - Made Project Template Pretty-Lemmih (replace with real name?)- - Worked on original HAppS Project- - Multimaster Support-Thomas Hartman- - Creator of HAppS Tutorial-
− RELEASE_NOTES
@@ -1,216 +0,0 @@-Happstack 0.2 Release Notes-================================================================================-- Project / Code generation tool- -------------------------------- There is now a code generation tool for Happstack. This is inspired by the- 'rails' command.- - 1. First install happstack (cabal install happstack)- - 2. Make sure the cabal bin dir is in your path- - in linux this is- ~/.cabal/bin- - in windows this is- C:\Documents and Settings\<username>\Application Data\cabal\bin- where <username> is your windows username.- - 3. Run this command:- happstack new project <dir>- where <dir> is the folder you want to create the project in.- - 4. It will create several folders:- - bin (scripts for your project go here)- - dist (where deployment files will go)- - public (static files for the http server)- - src (project source code goes here)- - templates (HStringTemplate files go here)- - 5. There are three scripts to get your project kick-started- - bin/build (build a static compiled binary at dist/app)- - bin/run (run the project dynamically)- - bin/run-interactive (run the project interactively in ghci)- Each script has a .sh version if you are on *nix and a .bat version if- you are on windows.- - 6. By default, your project will bind to port 8000 on every ip address your- machine has.- - 7. There are five source files in the src folder by default- - AppControl.hs (routing and controller code goes here)- - AppState.hs (MACID state objects are defined here)- - AppView.hs (presentation / view code goes here)- - AppLogger.hs (controls logging for the hslogger system)- - Main.hs (entry point to your app, is has the routines needed to- run your application)- - 8. Enjoy!- - The WebT/ServerPartT change- -------------------------------- WebT and ServerPartT have been substantially refactored. They are now built- from simpler monads. ServerPartT is now the only monad you have to deal- with, most of the time. I.e. you almost never have to look at WebT again.- You just have do blocks in ServerPartT. Inside ServerPartT you can get your- request (askRq), modify your request (localRq), exit immediately- (finishWith), exit failure (mzero), and alter your response filters- (composeFilter, setFilter, getFilter) It also lifts ErrorT, ReaderT, WriterT- and StateT, so you can embed one of those as well. As a bonus, nearly all- the functions you expected to take a WebT or to operate only within a WebT- can now work inside a ServerPartT directly. The monad stack handles all the- data threading.- - That being said, here are a list of the non-backwards compatible changes.- ServerPartT, WebT, unServerPartT and unWebT now have different semantics. To- get existing code to compile you can change your methods like so:-- ServerPartT -> withRequest- WebT -> mkWebT- unServerPartT -> runServerPartT- unWebT -> ununWebT or runWebT depending on what you're going for.-- By just making the above changes, your existing code should continue to work- as before. However, at this point, any old code you have can be greatly- simplified. For example, you will never have to use anyRequest or- withRequest to change from ServerPartT to WebT. You never have to interact- with WebT directly. You can do everything in a ServerPartT do block. The- examples provided in the documentation (especially basicAuth') just barely- touch on the power of ServerPartT now. Notice that basicAuth' mixes reading- requests and altering responses all without exposing WebT, constructing a- ServerPartT, or really doing any data threading at all.-- As a quick example:-- This:- uriRest :: Monad m => (String -> ServerPartT m a) -> ServerPartT m a- uriRest handle = withRequest $ \rq ->- unServerPartT (handle (rqURL rq)) rq-- Becomes this:- uriRest :: (ServerMonad m, Monad m) => (String -> m a) -> m a- uriRest handle = askRq >>= handle . rqURL-- Every single function that uses withRequest, anyRequest, unServerPartT,- unWebT or ununWebT can be rewritten to take advantage of these simple monad- behaviors. Additionally, a lot of functions were added to make it easier to- work entirely inside a do block.- - getHeaderM, addHeaderM, getData, getDataFn, escape', finishWith, getFilter,- setFilter, composeFilter, applyFilter, setResponseCode, guardRq, methodM,- methodOnly, nullDir, requireM-- The following were deprecated since they duplicate functionality- - noHandle -> Use mzero- multi -> Use msum- method -> you should be able to use methodSP though you'll need to fix- your typing- modifyResponse -> use composeFilter-- Also, this release sees the return of simpleHTTP', though not as you knew it- before. simpleHTTP must take a ServerPartT IO a. simpleHTTP' lets you use- Any ServerPartT m a, as long as you provide a function for unwrapping your- interior monad into an IO monad. This is particularly important since- ServerPartT has lifting instances for WriterT, StateT, ErrorT, and ReaderT,- thus embedding your favorite monad transformer into ServerPartT is easier- than ever.-- Documentation- -------------------------------- This release also adds substantial documentation for the package- Happstack.Server.SimpleHTTP which convers most of the new structures added,- as well as many of your old favorites. Be sure to check it out.-- Removing list types from SimpleHTTP- -------------------------------- Having most of the methods in SimpleHTTP take array types was cumbersome,- since often you only had one part and had to wrap it up. All methods that- used to take a list of ServerPartTs now only take a single ServerPartT. To- convert your list of ServerPartT into a single ServerPartT, use msum.-- For example:- simpleHTTP nullConf [spart1, spart2]- Becomes:- simpleHTTP nullConf $ msum [spart1, spart2]- - The functions affected by this change are:- simpleHTTP, dir, path, anyPath, withData, withDataFn, require, requireM,- xslt, debugFilter, applyRequest, basicAuth, and errorHandlerSP-- Gzip/Deflate encoding- ------------------------------- There is now a ServerPartT for gzip/deflate encoding, in- Happstack.Server.Parts.compressedResponseFilter-- Guidlines for porting existing HAppS and Happstack <= 0.1 code to 0.2- -------------------------------- The first change you should do is change the following functions- as described above.- ServerPartT -> withRequest- WebT -> mkWebT- unServerPartT -> runServerPartT- unWebT -> ununWebT- - Next, work on prepending $ msum in front of every list of ServerPartTs, or- deleting lists that are no longer necessary.-- After this point, you should be able to get your app compiled and running.- To further clean up your code and take advantage of the new functionality in- ServerPartT, the general procedure is as follows:-- - consider studying the revised examples in happstack-server/Examples. They- all use the new idioms.- - - delete your type signatures that reference WebT or ServerPartT, as after- the first step they will all have changed dramatically-- - delete all uses of withRequest and anyRequest (they aren't needed anymore)-- - change the idiom 'method m $' to 'methodM m >>'-- - change 'withRequest \rq -> do ...' to 'do { rq <- askRq; ... }'-- - change withData \myDat $ \dat -> do ... to- do dat <- getData >>= maybe mzero return- ... - - - change withDataFn fn \myDat $ \dat -> do ... to- do dat <- getDataFn fn >>= maybe mzero return- ...-- - change all references of noHandle to mzero- - - you can probably benefit from some do blocks at this point-- - if you're passing around the request explictly, stop. You can just- "rq <- askRq" whenever you need it.-- - consider embedding your favorite monad transformer into your ServerPartTs.- To make this work, you'll want to read the documentation for simpleHTTP',- mapServerPartT, and WebT- - - consider reading the newly minted documentation for- Happstack.Server.SimpleHTTP. Hopefully you'll learn something.-- Windows Bin Path Caveats- ------------------------------- By default when you install say ghc 6.8.3 or 6.10.1, windows won't setup the paths.- You need to perform these steps after running the installer for ghc:- 1. Right Click on "My Computer"- 2. Left Click on "Properties"- 3. Advanced Tab- 4. Environmental Variables- 5. Add or Edit existing 'PATH' variable- If you have ghc 6.8.3 for instance:- 1. Prepend "C:\ghc\ghc-6.8.3;C:\ghc\ghc-6.8.3\bin;" to the Variable value- 2. Click OK- 3. Restart and cmd windows you have open- 6. Now all the commands should work i.e. ghci, ghc-pkg, perl etc.- 7. You will need happy to compile happstack- Follow these steps:- 1. Install happy via cabal install or the manual method- 2. Prepend "C:\Documents and Settings\user\Application Data\cabal\bin"- to your Environment Path variable where user is your username.- 3. Now any binaries installed by cabal packages will also be in your- command path.-
− commands/happstack.hs
@@ -1,91 +0,0 @@--- happstack command-module Main (main) where--import Control.Monad (filterM, liftM, mapM, mapM_)-import Paths_happstack (getDataDir)-import System.Environment (getArgs)-import System.Directory- ( canonicalizePath- , createDirectoryIfMissing- , doesFileExist- , doesDirectoryExist- , copyFile- )-import System.FilePath ((</>), makeRelative)-import Happstack.Util.AutoBuild (autoBuild)-import Happstack.Util.FileManip (always, find)--data Command- = NewProjectCmd FilePath- | BuildAutoCmd String String [String]- | HelpCmd--main :: IO ()-main = do- args <- getArgs- case processArgs args of- NewProjectCmd dir -> newProject dir- BuildAutoCmd buildCmd binPath binArgs -> buildAuto buildCmd binPath binArgs- HelpCmd -> do- putStrLn "Usage: happstack <command>"- putStrLn "Possible commands:"- putStrLn " build auto <buildCmd> <binPath> <binArgs>...: invoke the auto-builder"- putStrLn " new project <dir>: create a new happstack project"- -processArgs :: [String] -> Command-processArgs ("build" : "auto" : buildCmd : binPath : binArgs) =- BuildAutoCmd buildCmd binPath binArgs-processArgs ["new", "project", dir] = NewProjectCmd dir-processArgs ["help"] = HelpCmd-processArgs _ = HelpCmd- -buildAuto :: String -> String -> [String] -> IO ()-buildAuto = autoBuild--newProject :: FilePath -> IO ()-newProject destDir' = do- dataDir <- liftM (</> "templates" </> "project") getDataDir--- destDir <- canonicalizePath destDir' -- this won't work because the directory does not exist yet- let destDir = destDir'- - -- create destDir if needed- createDir destDir-- -- create dirs- srcDirs <- getSourceDirs dataDir-- let destDirs = map ((destDir </>) . makeRelative dataDir) srcDirs- mapM_ createDir destDirs-- -- create files-- srcFiles <- getSourceFiles dataDir- let destFiles = map ((destDir </>) . makeRelative dataDir) srcFiles- mapM_ cp $ zip srcFiles destFiles-- return ()- where createDir = createDirectoryIfMissing True- --- only source dirs-getSourceDirs :: FilePath -> IO [FilePath]-getSourceDirs dataDir = filterM doesDirectoryExist =<< getSourceData dataDir---- only source files-getSourceFiles :: FilePath -> IO [FilePath]-getSourceFiles dataDir = filterM doesFileExist =<< getSourceData dataDir---- source data for project skeleton-getSourceData :: FilePath -> IO [FilePath]-getSourceData rawDataDir = do- dataDir <- canonicalizePath rawDataDir- all <- mapM canonicalizePath =<< (find always always dataDir)- return $ filter (/= dataDir) all---- does not work for folders-cp :: (FilePath, FilePath) -> IO ()-cp (src, dest) = do- exists <- doesFileExist dest- if exists- then putStrLn $ "File exists already, skipping: " ++ dest- else copyFile src dest-
happstack.cabal view
@@ -1,5 +1,5 @@ Name: happstack-Version: 6.0.6+Version: 6.1.7 Synopsis: The haskell application server stack + code generation Description: The haskell application server stack License: BSD3@@ -11,44 +11,6 @@ Build-Type: Simple Cabal-Version: >= 1.6 -data-files: CHANGELOG- CREDITS- RELEASE_NOTES- templates/project/COPYING- templates/project/bin/run.bat- templates/project/bin/run-interactive.bat- templates/project/bin/build.sh- templates/project/bin/run-interactive.sh- templates/project/bin/run.sh- templates/project/bin/build.bat- templates/project/Setup.hs- templates/project/templates/readme.st- templates/project/guestbook.cabal- templates/project/src/Pages/PostEntry.hs- templates/project/src/Pages/AppTemplate.hs- templates/project/src/Pages/Readme.hs- templates/project/src/Pages/Common.hs- templates/project/src/Pages/GuestBookEntries.hs- templates/project/src/State/GuestBook.hs- templates/project/src/Types/GuestBook.hs- templates/project/src/State.hs- templates/project/src/Main.hs- templates/project/src/Routes.hs- templates/project/src/Pages.hs- templates/project/src/Logger.hs- templates/project/public/theme/images/menu_hover.gif- templates/project/public/theme/images/grunge.gif- templates/project/public/theme/images/entrymeta.gif- templates/project/public/theme/images/date.gif- templates/project/public/theme/images/logo.gif- templates/project/public/theme/images/peel.gif- templates/project/public/theme/images/menu_hili.gif- templates/project/public/theme/images/ql_rss.gif- templates/project/public/theme/images/blockquote.gif- templates/project/public/theme/images/header_loop.gif- templates/project/public/theme/readme.txt- templates/project/public/theme/style.css- source-repository head type: darcs subdir: happstack@@ -62,27 +24,18 @@ Default: False Library- exposed-modules: Happstack.State.ClockTime if flag(tests) Exposed-modules: Happstack.Tests other-modules: Paths_happstack - build-depends: base >= 3,+ build-depends: base >= 3 && <5, happstack-data >= 6.0 && < 6.1, happstack-ixset >= 6.0 && < 6.2, happstack-server >= 6.0 && < 6.6, happstack-state >= 6.0 && < 6.2,- happstack-util >= 6.0 && < 6.1,- old-time-+ happstack-util >= 6.0 && < 6.1 - if flag(base4)- Build-Depends: base >= 4 && < 5, syb- else- build-depends: haskell-src-exts == 0.3.9,- HStringTemplate < 0.6 - hs-source-dirs: src if flag(tests) hs-source-dirs: tests @@ -91,19 +44,10 @@ else ghc-options: -Wall -Executable happstack- ghc-options: -threaded- build-depends: directory >= 1,- filepath >= 1- - hs-source-dirs: commands- main-is: happstack.hs-- Executable happstack-tests Main-Is: Test.hs GHC-Options: -threaded- hs-source-dirs: tests, src+ hs-source-dirs: tests if flag(tests) Buildable: True Build-depends: HUnit
− src/Happstack/State/ClockTime.hs
@@ -1,18 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveDataTypeable,- FlexibleInstances, MultiParamTypeClasses, FlexibleContexts,- UndecidableInstances, StandaloneDeriving, TypeSynonymInstances- #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--- |instances of Typeable, Data, Serialize, Version, and Default for ClockTime-module Happstack.State.ClockTime (ClockTime(..)) where--import Data.Generics (Data, Typeable)-import Happstack.Data (deriveNewData)-import Happstack.State (Version, deriveSerialize)-import System.Time (ClockTime(..))--deriving instance Typeable ClockTime-deriving instance Data ClockTime-instance Version ClockTime-$(deriveSerialize ''ClockTime)-$(deriveNewData [''ClockTime])
− templates/project/COPYING
@@ -1,29 +0,0 @@-Copyright (c) 2011, Jeremy Shaw-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:--Redistributions of source code must retain the above copyright-notice, this list of conditions and the following disclaimer.--Redistributions in binary form must reproduce the above copyright-notice, this list of conditions and the following disclaimer in the-documentation and/or other materials provided with the distribution.--Neither the name of the Jeremy Shaw; nor the names of its contributors-may be used to endorse or promote products derived from this software-without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR-CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,-EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,-PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR-PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING-NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
− templates/project/Setup.hs
@@ -1,13 +0,0 @@-#!/usr/bin/env runghc--module Main where--import Distribution.Simple-import Distribution.Simple.Program--trhsxProgram = simpleProgram "trhsx"--main :: IO ()-main = defaultMainWithHooks simpleUserHooks {- hookedPrograms = [trhsxProgram]- }
− templates/project/bin/build.bat
@@ -1,1 +0,0 @@-ghc -isrc src\Main.hs --make -o app
− templates/project/bin/build.sh
@@ -1,2 +0,0 @@-#!/bin/sh-ghc -isrc src/Main.hs --make -o app
− templates/project/bin/run-interactive.bat
@@ -1,1 +0,0 @@-ghci -isrc -isrc-interactive-only src\Main.hs
− templates/project/bin/run-interactive.sh
@@ -1,2 +0,0 @@-#!/bin/sh-ghci -isrc -isrc-interactive-only src/Main.hs
− templates/project/bin/run.bat
@@ -1,1 +0,0 @@-runghc -isrc src\Main.hs
− templates/project/bin/run.sh
@@ -1,2 +0,0 @@-#!/bin/sh-runghc -isrc src/Main.hs
− templates/project/guestbook.cabal
@@ -1,60 +0,0 @@-Name: guestbook-Version: 1.0-Author: Jeremy Shaw <jeremy@seereason.com>, Matthew Elder <matt@mattelder.org>-Copyright: 2009-2011, Jeremy Shaw-License: BSD3-License-file: COPYING-Stability: Experimental-Category: Web-Synopsis: An example guestbook application which uses happstack and HSP-Description:- This small example guestbook makes an excellent starting point for- your own happstack applications.-Cabal-version: >= 1.4.0.0-Build-type: Custom-Data-files: - public/theme/style.css- public/theme/images/date.gif- public/theme/images/ql_rss.gif- public/theme/images/header_loop.gif- public/theme/images/blockquote.gif- public/theme/images/menu_hili.gif- public/theme/images/grunge.gif- public/theme/images/entrymeta.gif- public/theme/images/logo.gif- public/theme/images/peel.gif- public/theme/images/menu_hover.gif- public/theme/readme.txt--Flag base4- Description: Choose the even newer, even smaller, split-up base package.--Executable guestbook-server- Main-Is: Main.hs- hs-source-dirs: src-- GHC-Options: -threaded -Wall -Wwarn -O2 -fno-warn-name-shadowing -fno-warn-missing-signatures -fwarn-tabs -fno-warn-unused-binds -fno-warn-orphans -fwarn-unused-imports- Build-depends: extensible-exceptions,- happstack,- happstack-data,- happstack-hsp,- happstack-hstringtemplate,- happstack-server,- happstack-state,- happstack-util,- hsp,- hsx,- hslogger,- mtl,- old-time,- old-locale,- utf8-string---- if !os(windows)- -- Cabal has a bug on windows and cannot find trhsx- Build-Tools: trhsx-- if flag(base4)- Build-Depends: base >= 4 && < 5, syb
− templates/project/public/theme/images/blockquote.gif
binary file changed (103 → absent bytes)
− templates/project/public/theme/images/date.gif
binary file changed (941 → absent bytes)
− templates/project/public/theme/images/entrymeta.gif
binary file changed (182 → absent bytes)
− templates/project/public/theme/images/grunge.gif
binary file changed (3669 → absent bytes)
− templates/project/public/theme/images/header_loop.gif
binary file changed (207 → absent bytes)
− templates/project/public/theme/images/logo.gif
binary file changed (3102 → absent bytes)
binary file changed (313 → absent bytes)
binary file changed (205 → absent bytes)
− templates/project/public/theme/images/peel.gif
binary file changed (4961 → absent bytes)
− templates/project/public/theme/images/ql_rss.gif
binary file changed (296 → absent bytes)
− templates/project/public/theme/readme.txt
@@ -1,1 +0,0 @@-Theme by Dezinerfolio.com
− templates/project/public/theme/style.css
@@ -1,349 +0,0 @@- -/* -Theme Name: Dezinerfolio (s)impress -Theme URI: dezinerfolio.com -Description: Simple and Clean theme -Version: 2.0 -Author: Navdeep Raj -*/ - -*{ - margin:0; - padding:0; -} - -body{ - font-family: arial, helvetica; - font-size:14px; - background: #fff; -} - -#header{ - height:98px; - clear:both; - background:#FFF url(images/header_loop.gif) repeat-x 0 0; -} - -.mainlogo{ - float:left; - padding:0px 50px; -} - -.mainlogo a{ - background:url(images/logo.gif) no-repeat 0 0; - width:144px; - height:98px; - display:block; - overflow:hidden; - text-indent:-9999px; -} - -.topnavi li{ - float:left; - list-style:none; - overflow:hidden; -} - -.topnavi .page_item{ - background:url(images/header_loop.gif) repeat-x left top; - border-left:1px solid #e4e4e4; - border-right:1px solid #e4e4e4; - display:block; -} - -.topnavi li a{ - padding:60px 20px 0 20px; - height:27px; - display:block; - float:left; - text-decoration:none; - font-size:12px; - color:#585858; -} - -.topnavi li a:hover{ - background:url(images/menu_hover.gif) repeat-x 0 0; -} - -.topnavi .current_page_item{ - background:url(images/menu_hili.gif) repeat-x left top; - border:1px solid #3e8709; - overflow:hidden; - display:block; -} - -.topnavi .current_page_item a:hover{ - background:url(images/menu_hili.gif) repeat-x left top; -} - -.topnavi .current_page_item a{ - color:#FFF; - font-weight:bold; -} - -.grunge{ - background:url(images/grunge.gif); - width:105px; - height:98px; - display:block; - float:left; -} - -.side1{ - float:left; - width:200px; - padding:12px -} - -.side2{ - float:left; - width:200px; - padding:12px; -} - -.sbar_section{ - padding:10px 0; -} - -.side1 li, .side2 li{ - list-style:none; -} - -.side1 li a, .side2 li a{ - padding:8px 5px; - display:block; - border-bottom:1px solid #CDCDCD; - text-decoration:none; - color:#555; -} - -.side1 li a:hover, .side2 li a:hover{ - border-bottom:1px solid #888; - color:#222; - background:#f1f1f1; -} - -.side1{ - border-right:1px solid #ddd; -} - -.side1 h2, .side2 h2{ - color:#333; - font-size:16px; - padding:5px 0; -} - -.sbar_section #s{ - padding:4px; - border:1px solid #CDCDCD; - text-align:center; - font-family:Georgia, "Times New Roman", Times, serif; - color:#555; - width:185px; - background:#f1f1f1; -} - -.sbar_section #s:hover, .sbar_section #s:focus{ - border:1px solid #888; - background:#FFF; -} - -.peel{ - background:url(images/peel.gif); - width:102px; - height:129px; - overflow:hidden; - display:block; - position:absolute; - z-index:9999px; - right:0; - top:0; -} - -.wrap{ - padding-left:265px; - color:#333; - padding-right:25px; -} - -.wrap h1 a, .wrap h1{ - color:#59ba12; - font-size:20px; - font-family:Arial, Helvetica, sans-serif; - font-weight:bold; - text-decoration:none; -} - - -.wrap p{ - padding:15px 0px; - line-height:19px; -} - -.wrap img{ - padding:10px; -} - -.wrap ul{ - padding-left:20px; -} -.wrap li{ - padding:5px; -} - -.wrap ul p{ - padding:0; -} - -blockquote { - background:transparent url(images/blockquote.gif) no-repeat scroll left top; - line-height:18px; -} - - - - -.wrap h2 a, .wrap h2{ - color:#333333; - font-size:18px; - font-family:Arial, Helvetica, sans-serif; - font-weight:normal; -} - -.entry-meta{ - background:red; - display:block; - font-size:11px; - background:url(images/entrymeta.gif) repeat-x left bottom; - padding:12px; - border:1px solid #cfcfcf; - line-height:18px; -} - -.entry-meta a{ - text-decoration:none; - color:#4a9d0d; -} - -.entry-meta a:hover{ - color:#0066FF; -} - - - -.date{ - float:left; - background:red; - background:url(images/date.gif) no-repeat; - width:45px; - height:48px; - margin-top:-8px; - padding-top:2px; - font-size:16px; - color:#FFFFFF; - font-weight:bold; - padding-left:11px; - z-index:9999999999999px; -} - -.date div{ - color:#999999; - font-size:11px; - padding-top:8px; -} - -.posttop{ - border-bottom:2px solid #52af10; - padding-bottom:25px; - margin-bottom:8px; -} - -.posttop .feedback a{ - color:#666; - text-decoration:none; - float:right; - padding-top:5px; -} - -.footer{ - padding:15px; - background:#222; - clear:both; - text-align:center; - color:#999; - margin-top:25px; -} - -.footer a{ - color:#59ba12; - text-decoration:none; -} - -.commentlist li{ - list-style:none; -} - -#commentform p{ - padding:5px; -} - -#comment, #author, #email, #url{ - width:250px; - padding:3px; - font-family:Arial, Helvetica, sans-serif; - font-size:12px; - color:#333; - border:1px solid #AAA; -} - - -#comment:hover, #author:hover, #email:hover, #url:hover, #comment:focus, #author:focus, #email:focus, #url:focus{ - border:1px solid #333; -} - -#commentform label{ - color:#666666; -} - -#commentform #submit{ - padding:5px 15px; - border:none; - width:260px; - text-align:center; - background:#FFF url(images/entrymeta.gif) repeat-x left bottom; - color:#666; - border:1px solid #999; - cursor:pointer; -} - -.wrap ul.commentlist{ - padding:20px 0px; -} - -.commentlist li{ - padding:10px; - border-bottom:1px solid #AAA; -} - -.commentmetadata -{ - color:#999; - } - -.commentlist .commentmetadata a{ - color:#999; -} - -.commentlist li.alt{ - background:#F4F4F4; -} - -.storycontent a, #commentform a, .commentlist li a{ - color:#009900; - text-decoration:none; -} - -.accesskey -{ - text-decoration: underline; - }
− templates/project/src/Logger.hs
@@ -1,66 +0,0 @@-module Logger (- LoggerHandle- , setupLogger- , teardownLogger- , withLogger-) where--import Control.Exception.Extensible (bracket)--import System.Log.Logger- ( Priority(..)- , rootLoggerName- , setLevel- , setHandlers- , updateGlobalLogger- )-import System.Log.Handler (close)-import System.Log.Handler.Simple (GenericHandler, fileHandler, streamHandler)-import System.IO (stdout, Handle)---- | Opaque type covering all information needed to teardown the logger.-data LoggerHandle = LoggerHandle { - rootLogHandler :: GenericHandler Handle- , accessLogHandler :: GenericHandler Handle- , serverLogHandler :: GenericHandler Handle- }---- | Install the loggers required by the application. -setupLogger :: IO LoggerHandle-setupLogger = do- appLog <- fileHandler "app.log" INFO- accessLog <- fileHandler "access.log" INFO- stdoutLog <- streamHandler stdout NOTICE-- -- Root Log- updateGlobalLogger- rootLoggerName- (setLevel DEBUG . setHandlers [appLog])-- -- Access Log- updateGlobalLogger- "Happstack.Server.AccessLog.Combined"- (setLevel INFO . setHandlers [accessLog])-- -- Server Log- updateGlobalLogger- "Happstack.Server"- (setLevel NOTICE . setHandlers [stdoutLog])- -- return opaque AppLogger handle- return $ LoggerHandle appLog accessLog stdoutLog---- | Tear down the application logger; i.e. close all associated log handlers.-teardownLogger :: LoggerHandle -> IO ()-teardownLogger handle = do- close $ serverLogHandler handle- close $ accessLogHandler handle- close $ rootLogHandler handle---- | Bracket an IO action which denotes the whole scope where the loggers of--- the application are needed to installed. Sets them up before running the action--- and tears them down afterwards. Even in case of an exception. -withLogger :: IO a -> IO a-withLogger = bracket setupLogger teardownLogger . const-- -
− templates/project/src/Main.hs
@@ -1,193 +0,0 @@-module Main where--import Data.Version (showVersion)--import Control.Concurrent (MVar, forkIO, killThread)-import Control.Exception (bracket)--import System.Environment (getArgs)-import System.Log.Logger (Priority(..), logM)-import System.Exit (exitWith, ExitCode(..), exitFailure)-import System.Console.GetOpt --import Happstack.Util.Cron (cron)-import Happstack.State (waitForTermination)-import Happstack.Server- ( Conf(port)- , simpleHTTP- , nullConf- , validator- , wdgHTMLValidator- )-import Happstack.State- ( Component- , Proxy(..)- , Methods- , TxControl- , Saver(Queue, FileSaver)- , runTxSystem- , shutdownSystem- , createCheckpoint- )--import Logger (withLogger)-import Routes (routes)-import State (AppState)---- NOTE: You need to change this file name such that it reflects the name of--- your project in the .cabal file, because it is auto-generated by cabal.-import Paths_guestbook (version)------------------------------------------------------------------------------------ Main Function---------------------------------------------------------------------------------main = withLogger $ do-- -- convert command line arguments into list of flags- flags <- parseConfig =<< getArgs-- -- display information like help or version, if required- displayInfo flags-- -- run server- runServer flags----- | Display information required by flags. Currently, this is either the help--- message or the version information.-displayInfo :: [Flag] -> IO ()-displayInfo flags- | any isHelp flags = putStr helpMessage >> exitWith ExitSuccess- | any isVersion flags = putStr versionInfo >> exitWith ExitSuccess- | otherwise = return ()------------------------------------------------------------------------------------ Command Line Interface Content----------------------------------------------------------------------------------- | Program name used to identify your application. --- It influences the version and help message, as well as the directory name--- for the state of your application.-progName = "guestbook-server"--fullName = "Happstack Guestbook Example"--copyrightInfo = "Copyright (C) 2009 <your-name-here>"-licenceInfo = "See the accompanying licence for copying conditions."---- | Version information extracted from Paths_guestbook-versionInfo = unlines- [ fullName ++ " (" ++ progName ++ "), version " ++ showVersion version- , copyrightInfo- , licenceInfo- ]---- | A simple usage message listing all flags possible.-helpMessage = usageInfo header opts- where - header = "Usage: "++progName++" [OPTION...]"------------------------------------------------------------------------------------ Server----------------------------------------------------------------------------------- | Configuration information-data AppConf- = AppConf { httpConf :: Conf- , store :: FilePath- , static :: FilePath - }---- | Default configuration--- FIXME: Should incorporate directories queried via Paths_guestbook module-defaultConf :: String -> AppConf-defaultConf progName- = AppConf { httpConf = nullConf- , store = "_local/" ++ progName ++ "_state"- , static = "public"- }---- | Run the server with the given configuration.-runServer :: [Flag] -> IO ()-runServer flags = do- -- combine all server config flags- let appConf = foldr ($) (defaultConf progName) [f | ServerConfig f <- flags] -- -- start the state system- withSystemState' (store appConf) stateProxy $ \control -> do- - -- start the http server- withThread (simpleHTTP (httpConf appConf) routes) $ do-- -- checkpoint the state once a day- withThread (cron (60*60*24) (createCheckpoint control)) $ do- - -- wait for termination signal- logM "Happstack.Server" NOTICE "System running, press 'e <ENTER>' or Ctrl-C to stop server" - waitForTermination-- where- startSystemState' :: (Component st, Methods st) => String -> Proxy st -> IO (MVar TxControl)- startSystemState' = runTxSystem . Queue . FileSaver-- withSystemState' :: (Component st, Methods st) => String -> Proxy st -> (MVar TxControl -> IO a) -> IO a- withSystemState' name proxy action = - bracket (startSystemState' name proxy) createCheckpointAndShutdown action-- withThread init action = bracket (forkIO $ init) (killThread) (\_ -> action)-- createCheckpointAndShutdown control = do- logM "Happstack.Server" NOTICE "Creating system checkpoint" - createCheckpoint control- logM "Happstack.Server" NOTICE "System shutdown" - shutdownSystem control-- -- simon.meier@inf.ethz.ch: I currently don't know what this is used for!- -- FIXME: Add sensible comment.- stateProxy :: Proxy AppState- stateProxy = Proxy------------------------------------------------------------------------------------ Command Line Parsing----------------------------------------------------------------------------------- | Flags-data Flag = - ServerConfig (AppConf -> AppConf)- | Help- | Version---- Flag selectors-isHelp flag = case flag of Help -> True; _ -> False-isVersion flag = case flag of Version -> True; _ -> False---- | Command line options.-opts :: [OptDescr Flag]-opts = [ Option [] ["http-port"] (ReqArg setPort "port") "Port to bind http server"- , Option [] ["no-validate"] (NoArg $ setValidator Nothing) "Turn off HTML validation"- , Option [] ["validate"] (NoArg $ setValidator (Just wdgHTMLValidator)) "Turn on HTML validation"- , Option [] ["store"] (ReqArg setMacidDir "PATH") "The directory used for database storage."- , Option [] ["static"] (ReqArg setStaticDir "PATH") "The directory searched for static files" - , Option [] ["version"] (NoArg Version) "Display version information" - , Option [] ["help"] (NoArg Help) "Display this help message" - ]- where- setPort p = ServerConfig $ \c -> c { httpConf = (httpConf c) {port = read p} }- setValidator v = ServerConfig $ \c -> c { httpConf = (httpConf c) {validator = v } }- setMacidDir p = ServerConfig $ \c -> c { store = p }- setStaticDir p = ServerConfig $ \c -> c { static = p }---- | Parse the command line arguments into a list of flags. Exits with usage--- message, in case of failure.-parseConfig :: [String] -> IO [Flag]-parseConfig args = case getOpt Permute opts args of- (flags,_,[]) -> return flags- (_,_,errs) -> do- logM progName ERROR ("Failure while parsing command line:\n"++unlines errs)- putStr helpMessage- exitFailure
− templates/project/src/Pages.hs
@@ -1,9 +0,0 @@-module Pages - ( guestBookEntriesPage- , postEntryPage- , readmePage - ) where--import Pages.Readme-import Pages.GuestBookEntries-import Pages.PostEntry
− templates/project/src/Pages/AppTemplate.hs
@@ -1,95 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}-module Pages.AppTemplate where--import Control.Applicative ((<$>))-import HSP-import Happstack.Server (ServerPart, ServerPartT, Response, toResponse)-import HSP.ServerPartT () -- instance XMLGenerator (ServerPartT m)-import Happstack.Server.HSP.HTML ()--appTemplate ::- ( EmbedAsChild (ServerPartT IO) headers- , EmbedAsChild (ServerPartT IO) body- ) =>- String -> headers -> body -> ServerPart Response-appTemplate title headers body = toResponse <$> (unXMLGenT (appTemplate' title headers body))--appTemplate' :: - ( EmbedAsChild (ServerPartT IO) headers- , EmbedAsChild (ServerPartT IO) body- ) =>- String -> headers -> body -> XMLGenT (ServerPartT IO) XML-appTemplate' title headers body =- <html>- <head>- <title><% title %></title>- <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />- <link rel="stylesheet" type="text/css" href="/theme/style.css" media="screen" />- <% headers %>- </head>- <body>- <div id="header">- <div class="grunge"></div>- <div class="peel"></div>- <div class="topnavi">- <ul>- <li class="current_page_item"><a href="/" title="Guestbook">Guestbook</a></li>- </ul>- </div>- </div>-- <div class="side1">- <div class="sbar_section">- <h2>Links</h2>- <ul>- <li class="cat-item cat-item-1"><a href="http://happstack.com/" title="happstack" accesskey="H"><span class="accesskey">H</span>appstack</a></li>- <li class="cat-item cat-item-2"><a href="http://happstack.com/docs" title="happstack" accesskey="T"><span class="accesskey">T</span>utorials</a></li>- </ul>- </div>- </div>-- <div class="wrap">- <div class="innercont_main">-- <div class="post">- <div class="posttop">- <div class="date">14<div>Feb</div></div>- <h1 class="posttitle">Happstack Guestbook</h1>- <div class="storycontent">- <p>- Hey congrats! You're using- <a href="http://happstack.com">Happstack</a>.- This is a guestbook example which you can freely change to your- whims and fancies.- </p>- <p>- This page is written using Haskell Server Pages (HSP). For an example- of a page using HStringTemplate, look at the- <a href="/README">dynamic README</a>.- </p>- <p>Leave a message for the next visitor here...</p>- <form action="/guestbook" 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="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>- </div>- </div>-- <% body %>- </div>- </div>- - <div class="footer">- <div class="finalfooter">Theme : <a href="http://www.dezinerfolio.com/2007/10/10/just-another-wodpress-theme" title="sIMPRESS v2 theme">sIMPRESS v2</a> by <a href="http://dezinerfolio.com" title="Dezinerfolio">Dezinerfolio</a></div>- </div>-- </body>- </html>--
− templates/project/src/Pages/Common.hs
@@ -1,11 +0,0 @@-module Pages.Common (dateStr) where--import System.Locale (defaultTimeLocale)-import System.Time (ClockTime(..), formatCalendarTime, toUTCTime)--dateStr :: ClockTime -> String-dateStr ct =- formatCalendarTime- defaultTimeLocale- "%a, %B %d, %Y at %H:%M:%S (UTC)"- (toUTCTime ct)
− templates/project/src/Pages/GuestBookEntries.hs
@@ -1,42 +0,0 @@-{-# OPTIONS_GHC -F -pgmFtrhsx #-}-module Pages.GuestBookEntries - ( guestBookEntriesPage - ) where--import HSP-import Happstack.Server (Method(GET), Response, ServerPart, ServerPartT, methodM)-import Happstack.State (query)-import Pages.AppTemplate (appTemplate)-import Pages.Common (dateStr)-import State.GuestBook (ReadGuestBook(..))-import Types.GuestBook (GuestBook(..), GuestBookEntry(..))--guestBookEntriesPage :: ServerPart Response-guestBookEntriesPage =- do methodM GET- gb <- query ReadGuestBook- appTemplate "Guestbook Entries" () (guestBookXML gb)--guestBookXML :: GuestBook -> XMLGenT (ServerPartT IO) XML-guestBookXML (GuestBook entries) =- <div>- <h2 id="comments" class="h2comment">Words of Wisdom</h2>- <div class="clear" />- <ul class="commentlist">- <% mapM guestBookEntryXML $ zip entries (cycle [False,True]) %>- </ul>- </div>--guestBookEntryXML :: (GuestBookEntry, Bool) -> XMLGenT (ServerPartT IO) XML-guestBookEntryXML ((GuestBookEntry author message date email), alt) =- <li class=(if alt then "alt" else "")>- <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 ++ ">"--
− templates/project/src/Pages/PostEntry.hs
@@ -1,23 +0,0 @@-module Pages.PostEntry (postEntryPage) where--import Control.Monad.Trans (liftIO)-import Happstack.Server (Method(POST), ServerPart, Response, look, methodM, seeOther, toResponse)-import Happstack.State (update)-import State.GuestBook (AddGuestBookEntry(..))-import System.Time (getClockTime)-import Types.GuestBook (GuestBookEntry(..))--postEntryPage :: ServerPart Response-postEntryPage =- do methodM POST -- only accept a post method- author <- look "author" -- `mplus` (error "GuestBookEntry, need author")- message <- look "message" -- `mplus` (error "GuesBookEntry, need message")- email <- look "email" -- `mplus` (error "GuestBookEntry: need email")- now <- liftIO getClockTime- let entry = GuestBookEntry { author = (if null author then "Anonymous" else author) - , message = message - , date = now - , email = email- }- update $ AddGuestBookEntry entry- seeOther "/guestbook" (toResponse "/guestbook")
− templates/project/src/Pages/Readme.hs
@@ -1,14 +0,0 @@--- | demonstration of using HStringTemplate to render a page-module Pages.Readme (readmePage) where--import Control.Monad.Trans (liftIO)-import Happstack.Server (Method(GET), Response, ServerPart, methodM)-import Happstack.Server.HStringTemplate (webST)-import Pages.Common (dateStr)-import System.Time (getClockTime)--readmePage :: ServerPart Response-readmePage =- do methodM GET- now <- liftIO getClockTime- webST "readme" [("time", dateStr now)]
− templates/project/src/Routes.hs
@@ -1,23 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}-module Routes (routes) where--import Control.Monad (msum)-import Happstack.Server ( Browsing(EnableBrowsing), Method(GET), Response, ServerPart- , decodeBody, defaultBodyPolicy, dir, methodM, serveDirectory- , seeOther, toResponse)-import Pages (guestBookEntriesPage, postEntryPage, readmePage)--routes :: ServerPart Response-routes = - do decodeBody (defaultBodyPolicy "/tmp/" 4096 4096 4096) -- decode the request body if present. - msum [ methodM GET >> seeOther "/guestbook" (toResponse ()) -- redirect / to /guestbook- , dir "guestbook" $ guestBookRoutes -- HSP pages- , dir "README" $ readmePage -- HStringTemplate example- , serveDirectory EnableBrowsing ["index.html"] "public" -- static file serving- ]--guestBookRoutes :: ServerPart Response-guestBookRoutes =- msum [ guestBookEntriesPage - , postEntryPage- ]
− templates/project/src/State.hs
@@ -1,28 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveDataTypeable,- FlexibleInstances, MultiParamTypeClasses, FlexibleContexts,- UndecidableInstances, TypeOperators- #-}-module State where--import Happstack.Data (Default, Version(..), deriveSerialize, defaultValue, deriveAll)-import Happstack.State ((:+:), Component(..), Dependencies, End, mkMethods)-import State.GuestBook (GuestBook)---- |top-level application state--- in this case, the top-level state itself does not contain any state-$(deriveAll [''Show, ''Eq, ''Ord, ''Default]- [d|- data AppState = AppState- |])--$(deriveSerialize ''AppState)-instance Version AppState---- |top-level application component--- we depend on the GuestBook component-instance Component AppState where- type Dependencies AppState = GuestBook :+: End- initialValue = defaultValue- --- create types for event serialization-$(mkMethods ''AppState [])
− templates/project/src/State/GuestBook.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveDataTypeable,- FlexibleInstances, MultiParamTypeClasses, FlexibleContexts,- UndecidableInstances- #-}-module State.GuestBook - ( GuestBook(..)- , ReadGuestBook(..)- , AddGuestBookEntry(..)- ) where--import Happstack.State (Component(..), Dependencies, End, Query, Update, mkMethods)-import Control.Monad.Reader (ask)-import Control.Monad.State (modify)-import Types.GuestBook (GuestBook(..), GuestBookEntry(..))---- | get the 'GuestBook'-readGuestBook :: Query GuestBook GuestBook-readGuestBook = ask- --- | add a 'GuestBookEntry' to the 'GuestBook'-addGuestBookEntry :: GuestBookEntry -> Update GuestBook ()-addGuestBookEntry e = modify $ \(GuestBook gb) -> (GuestBook (e:gb))---- |make Guestbook its own Component-instance Component GuestBook where- type Dependencies GuestBook = End- initialValue = GuestBook []- --- create types for event serialization-$(mkMethods ''GuestBook ['readGuestBook, 'addGuestBookEntry])
− templates/project/src/Types/GuestBook.hs
@@ -1,27 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, UndecidableInstances #-}-module Types.GuestBook where--import Happstack.Data (Default, Version, deriveAll, deriveSerialize)-import System.Time (ClockTime)-import Happstack.State.ClockTime () -- instance Data ClockTime--$(deriveAll [''Show, ''Eq, ''Ord, ''Default]- [d|- -- |GuestBookEntry: simple guest book entry- data GuestBookEntry = GuestBookEntry- { author :: String- , message :: String- , date :: ClockTime- , email :: String- }-- -- |GuestBook: a list of GuestBookEntry- newtype GuestBook = GuestBook { guestBookEntries :: [GuestBookEntry] }- |])--$(deriveSerialize ''GuestBookEntry)-instance Version GuestBookEntry--$(deriveSerialize ''GuestBook)-instance Version GuestBook-
− templates/project/templates/readme.st
@@ -1,6 +0,0 @@-This is a dynamic README file which uses HStringTemplate.--The time is $time$.--Thanks for reading!-