diff --git a/CHANGELOG b/CHANGELOG deleted file mode 100644 --- a/CHANGELOG +++ /dev/null @@ -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) - diff --git a/CREDITS b/CREDITS deleted file mode 100644 --- a/CREDITS +++ /dev/null @@ -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 - -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 - - 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 - diff --git a/RELEASE_NOTES b/RELEASE_NOTES deleted file mode 100644 --- a/RELEASE_NOTES +++ /dev/null @@ -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\\Application Data\cabal\bin - where is your windows username. - - 3. Run this command: - happstack new project - where 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. - diff --git a/commands/happstack.hs b/commands/happstack.hs deleted file mode 100644 --- a/commands/happstack.hs +++ /dev/null @@ -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 " - putStrLn "Possible commands:" - putStrLn " build auto ...: invoke the auto-builder" - putStrLn " new project : 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 - diff --git a/happstack.cabal b/happstack.cabal --- a/happstack.cabal +++ b/happstack.cabal @@ -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 diff --git a/src/Happstack/State/ClockTime.hs b/src/Happstack/State/ClockTime.hs deleted file mode 100644 --- a/src/Happstack/State/ClockTime.hs +++ /dev/null @@ -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]) diff --git a/templates/project/COPYING b/templates/project/COPYING deleted file mode 100644 --- a/templates/project/COPYING +++ /dev/null @@ -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. diff --git a/templates/project/Setup.hs b/templates/project/Setup.hs deleted file mode 100644 --- a/templates/project/Setup.hs +++ /dev/null @@ -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] - } diff --git a/templates/project/bin/build.bat b/templates/project/bin/build.bat deleted file mode 100644 --- a/templates/project/bin/build.bat +++ /dev/null @@ -1,1 +0,0 @@ -ghc -isrc src\Main.hs --make -o app diff --git a/templates/project/bin/build.sh b/templates/project/bin/build.sh deleted file mode 100644 --- a/templates/project/bin/build.sh +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -ghc -isrc src/Main.hs --make -o app diff --git a/templates/project/bin/run-interactive.bat b/templates/project/bin/run-interactive.bat deleted file mode 100644 --- a/templates/project/bin/run-interactive.bat +++ /dev/null @@ -1,1 +0,0 @@ -ghci -isrc -isrc-interactive-only src\Main.hs diff --git a/templates/project/bin/run-interactive.sh b/templates/project/bin/run-interactive.sh deleted file mode 100644 --- a/templates/project/bin/run-interactive.sh +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -ghci -isrc -isrc-interactive-only src/Main.hs diff --git a/templates/project/bin/run.bat b/templates/project/bin/run.bat deleted file mode 100644 --- a/templates/project/bin/run.bat +++ /dev/null @@ -1,1 +0,0 @@ -runghc -isrc src\Main.hs diff --git a/templates/project/bin/run.sh b/templates/project/bin/run.sh deleted file mode 100644 --- a/templates/project/bin/run.sh +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -runghc -isrc src/Main.hs diff --git a/templates/project/guestbook.cabal b/templates/project/guestbook.cabal deleted file mode 100644 --- a/templates/project/guestbook.cabal +++ /dev/null @@ -1,60 +0,0 @@ -Name: guestbook -Version: 1.0 -Author: Jeremy Shaw , Matthew Elder -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 diff --git a/templates/project/public/theme/images/blockquote.gif b/templates/project/public/theme/images/blockquote.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/blockquote.gif and /dev/null differ diff --git a/templates/project/public/theme/images/date.gif b/templates/project/public/theme/images/date.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/date.gif and /dev/null differ diff --git a/templates/project/public/theme/images/entrymeta.gif b/templates/project/public/theme/images/entrymeta.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/entrymeta.gif and /dev/null differ diff --git a/templates/project/public/theme/images/grunge.gif b/templates/project/public/theme/images/grunge.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/grunge.gif and /dev/null differ diff --git a/templates/project/public/theme/images/header_loop.gif b/templates/project/public/theme/images/header_loop.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/header_loop.gif and /dev/null differ diff --git a/templates/project/public/theme/images/logo.gif b/templates/project/public/theme/images/logo.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/logo.gif and /dev/null differ diff --git a/templates/project/public/theme/images/menu_hili.gif b/templates/project/public/theme/images/menu_hili.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/menu_hili.gif and /dev/null differ diff --git a/templates/project/public/theme/images/menu_hover.gif b/templates/project/public/theme/images/menu_hover.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/menu_hover.gif and /dev/null differ diff --git a/templates/project/public/theme/images/peel.gif b/templates/project/public/theme/images/peel.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/peel.gif and /dev/null differ diff --git a/templates/project/public/theme/images/ql_rss.gif b/templates/project/public/theme/images/ql_rss.gif deleted file mode 100644 Binary files a/templates/project/public/theme/images/ql_rss.gif and /dev/null differ diff --git a/templates/project/public/theme/readme.txt b/templates/project/public/theme/readme.txt deleted file mode 100644 --- a/templates/project/public/theme/readme.txt +++ /dev/null @@ -1,1 +0,0 @@ -Theme by Dezinerfolio.com diff --git a/templates/project/public/theme/style.css b/templates/project/public/theme/style.css deleted file mode 100644 --- a/templates/project/public/theme/style.css +++ /dev/null @@ -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; - } diff --git a/templates/project/src/Logger.hs b/templates/project/src/Logger.hs deleted file mode 100644 --- a/templates/project/src/Logger.hs +++ /dev/null @@ -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 - - - diff --git a/templates/project/src/Main.hs b/templates/project/src/Main.hs deleted file mode 100644 --- a/templates/project/src/Main.hs +++ /dev/null @@ -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 " -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 ' 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 diff --git a/templates/project/src/Pages.hs b/templates/project/src/Pages.hs deleted file mode 100644 --- a/templates/project/src/Pages.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Pages - ( guestBookEntriesPage - , postEntryPage - , readmePage - ) where - -import Pages.Readme -import Pages.GuestBookEntries -import Pages.PostEntry diff --git a/templates/project/src/Pages/AppTemplate.hs b/templates/project/src/Pages/AppTemplate.hs deleted file mode 100644 --- a/templates/project/src/Pages/AppTemplate.hs +++ /dev/null @@ -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 = - - - <% title %> - - - <% headers %> - - - - -
-
-

Links

- -
-
- -
-
- -
-
-
14
Feb
-

Happstack Guestbook

-
-

- Hey congrats! You're using - Happstack. - This is a guestbook example which you can freely change to your - whims and fancies. -

-

- This page is written using Haskell Server Pages (HSP). For an example - of a page using HStringTemplate, look at the - dynamic README. -

-

Leave a message for the next visitor here...

-
-


-

-


-


-

-

-
-
-
-
- - <% body %> -
-
- -
-
Theme : sIMPRESS v2 by Dezinerfolio
-
- - - - - diff --git a/templates/project/src/Pages/Common.hs b/templates/project/src/Pages/Common.hs deleted file mode 100644 --- a/templates/project/src/Pages/Common.hs +++ /dev/null @@ -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) diff --git a/templates/project/src/Pages/GuestBookEntries.hs b/templates/project/src/Pages/GuestBookEntries.hs deleted file mode 100644 --- a/templates/project/src/Pages/GuestBookEntries.hs +++ /dev/null @@ -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) = -
-

Words of Wisdom

-
-
    - <% mapM guestBookEntryXML $ zip entries (cycle [False,True]) %> -
-
- -guestBookEntryXML :: (GuestBookEntry, Bool) -> XMLGenT (ServerPartT IO) XML -guestBookEntryXML ((GuestBookEntry author message date email), alt) = -
  • - <% author ++ (displayemail email) %> said:

    - <% map p (lines message) %> -
    - <% dateStr date %> -
    • - where p str =

    <% str %>

    - displayemail "" = "" - displayemail x = "<" ++ x ++ ">" - - diff --git a/templates/project/src/Pages/PostEntry.hs b/templates/project/src/Pages/PostEntry.hs deleted file mode 100644 --- a/templates/project/src/Pages/PostEntry.hs +++ /dev/null @@ -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") diff --git a/templates/project/src/Pages/Readme.hs b/templates/project/src/Pages/Readme.hs deleted file mode 100644 --- a/templates/project/src/Pages/Readme.hs +++ /dev/null @@ -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)] diff --git a/templates/project/src/Routes.hs b/templates/project/src/Routes.hs deleted file mode 100644 --- a/templates/project/src/Routes.hs +++ /dev/null @@ -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 - ] diff --git a/templates/project/src/State.hs b/templates/project/src/State.hs deleted file mode 100644 --- a/templates/project/src/State.hs +++ /dev/null @@ -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 []) diff --git a/templates/project/src/State/GuestBook.hs b/templates/project/src/State/GuestBook.hs deleted file mode 100644 --- a/templates/project/src/State/GuestBook.hs +++ /dev/null @@ -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]) diff --git a/templates/project/src/Types/GuestBook.hs b/templates/project/src/Types/GuestBook.hs deleted file mode 100644 --- a/templates/project/src/Types/GuestBook.hs +++ /dev/null @@ -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 - diff --git a/templates/project/templates/readme.st b/templates/project/templates/readme.st deleted file mode 100644 --- a/templates/project/templates/readme.st +++ /dev/null @@ -1,6 +0,0 @@ -This is a dynamic README file which uses HStringTemplate. - -The time is $time$. - -Thanks for reading! -