packages feed

happstack (empty) → 0.2.1

raw patch · 38 files changed

+1414/−0 lines, 38 filesdep +HStringTemplatedep +HUnitdep +basesetup-changedbinary-added

Dependencies added: HStringTemplate, HUnit, base, bytestring, directory, filepath, happstack-data, happstack-ixset, happstack-server, happstack-state, happstack-util, haskell-src-exts, hslogger, hsp, hsx, mtl, old-time, syb, utf8-string

Files

+ CHANGELOG view
@@ -0,0 +1,34 @@+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+ +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)+
+ COPYING view
@@ -0,0 +1,30 @@+Copyright 2009 Happstack.com+Copyright 2005 HAppS LLC+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 HAppS.org; 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.
+ CREDITS view
@@ -0,0 +1,33 @@+-- 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 view
@@ -0,0 +1,216 @@+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.+
+ Setup.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain+
+ commands/happstack.hs view
@@ -0,0 +1,102 @@+-- happstack command+module Main where++import Paths_happstack (getDataDir)+import System.Environment (getArgs)+import System.Directory (createDirectoryIfMissing, doesFileExist, copyFile)+import System.FilePath ((</>))+import Control.Monad (mapM_)++data Command+  = NewProjectCmd FilePath+  | HelpCmd++main :: IO ()+main = do+  args <- getArgs+  case (processArgs args) of+    NewProjectCmd dir -> do+      newProject dir+    HelpCmd -> do+      putStrLn "Usage: happstack <command>"+      putStrLn "Possible commands:"+      putStrLn "  new project <dir>: create a new happstack project"+  +processArgs :: [String] -> Command+processArgs ["new", "project", dir] = NewProjectCmd dir+processArgs ["help"]                = HelpCmd+processArgs _                       = HelpCmd+    +newProject :: FilePath -> IO ()+newProject destDir = do+  dataDir <- getDataDir+  +  -- create destDir if needed+  createDirectoryIfMissing True destDir+  +  -- create folders+  mapM_ (createDirectoryIfMissing False) (destinationFolders destDir)+  +  -- copy files+  mapM_ cp $ zip (sourceFiles dataDir) (destinationFiles destDir)+      +-- destination folders that need to be created+destinationFolders destDir =+  map+    (destDir </>) +    [ "bin"+    , "dist"+    , "public"+    , "public/theme"+    , "public/theme/images"+    , "src"+    , "templates"+    ]+  +-- source files for project skeleton (needs to know dataDir location)+sourceFiles dataDir =+  map (dataDir </>) projectFiles++-- destination files for project skeleton+destinationFiles destDir =+  map ((destDir </>) . removePrefix) projectFiles+  where removePrefix = drop $ length "templates/project/" ++-- all files in the data dir+projectFiles = +  [ "templates/project/bin/build.bat"+  , "templates/project/bin/build.sh"+  , "templates/project/bin/run-interactive.bat"+  , "templates/project/bin/run-interactive.sh"+  , "templates/project/bin/run.bat"+  , "templates/project/bin/run.sh"+  , "templates/project/guestbook.cabal"+  , "templates/project/public/theme/images/blockquote.gif"+  , "templates/project/public/theme/images/date.gif"+  , "templates/project/public/theme/images/entrymeta.gif"+  , "templates/project/public/theme/images/grunge.gif"+  , "templates/project/public/theme/images/header_loop.gif"+  , "templates/project/public/theme/images/logo.gif"+  , "templates/project/public/theme/images/menu_hili.gif"+  , "templates/project/public/theme/images/menu_hover.gif"+  , "templates/project/public/theme/images/peel.gif"+  , "templates/project/public/theme/images/ql_rss.gif"+  , "templates/project/public/theme/readme.txt"+  , "templates/project/public/theme/style.css"+  , "templates/project/Setup.hs"+  , "templates/project/src/AppControl.hs"+  , "templates/project/src/AppLogger.hs"+  , "templates/project/src/AppState.hs"+  , "templates/project/src/AppView.hs"+  , "templates/project/src/Main.hs"+  , "templates/project/templates/readme.st"+  ]++-- 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
@@ -0,0 +1,101 @@+Name:                happstack+Version:             0.2.1+Synopsis:            The haskell application server stack + code generation+Description:         The haskell application server stack+License:             BSD3+License-file:        COPYING+Author:              Happstack team, HAppS LLC+Maintainer:          Happstack team <happs@googlegroups.com>+homepage:            http://happstack.com+Category:            Web, Distributed Computing+Build-Type:          Simple+Cabal-Version:       >= 1.4++data-files:          CHANGELOG+                     CREDITS+                     RELEASE_NOTES+                     templates/project/bin/build.bat+                     templates/project/bin/build.sh+                     templates/project/bin/run-interactive.bat+                     templates/project/bin/run-interactive.sh+                     templates/project/bin/run.bat+                     templates/project/bin/run.sh+                     templates/project/guestbook.cabal+                     templates/project/public/theme/images/blockquote.gif+                     templates/project/public/theme/images/date.gif+                     templates/project/public/theme/images/entrymeta.gif+                     templates/project/public/theme/images/grunge.gif+                     templates/project/public/theme/images/header_loop.gif+                     templates/project/public/theme/images/logo.gif+                     templates/project/public/theme/images/menu_hili.gif+                     templates/project/public/theme/images/menu_hover.gif+                     templates/project/public/theme/images/peel.gif+                     templates/project/public/theme/images/ql_rss.gif+                     templates/project/public/theme/readme.txt+                     templates/project/public/theme/style.css+                     templates/project/Setup.hs+                     templates/project/src/AppControl.hs+                     templates/project/src/AppLogger.hs+                     templates/project/src/AppState.hs+                     templates/project/src/AppView.hs+                     templates/project/src/Main.hs+                     templates/project/templates/readme.st++Flag base4+    Description: Choose the even newer, even smaller, split-up base package.++Flag tests+    Description: Build the testsuite, and include the tests in the library+    Default: False++Library+  exposed-modules:     Happstack.Server.HSP.HTML+                       Happstack.Server.HStringTemplate+                       Happstack.State.ClockTime+  if flag(tests)+    Exposed-modules:   Happstack.Tests+  other-modules:       Paths_happstack++  build-depends:       base >= 3,+                       bytestring,+                       happstack-data >= 0.2.1 && < 0.3,+                       happstack-ixset >= 0.2.1 && < 0.3,+                       happstack-server >= 0.2.1 && < 0.3,+                       happstack-state >= 0.2.1 && < 0.3,+                       happstack-util >= 0.2.1 && < 0.3,+                       hslogger,+                       hsp >= 0.4.5 && < 0.5,+                       HStringTemplate >= 0.4.3 && < 0.5,+                       mtl,+                       old-time,+                       utf8-string+                       +  if flag(base4)+    Build-Depends:     base >= 4 && < 5, syb+  else+    build-depends:     haskell-src-exts == 0.3.9,+                       hsx == 0.4.5++  hs-source-dirs:      src+  if flag(tests)+    hs-source-dirs:    tests++  ghc-options:         -Wall++Executable happstack+  build-depends:       directory >= 1,+                       filepath >= 1+                       +  hs-source-dirs:      commands+  main-is:             happstack.hs+++Executable happstack-tests+  Main-Is: Test.hs+  GHC-Options: -threaded+  Build-depends: HUnit+  hs-source-dirs: tests, src+  if flag(tests)+    Buildable: True+  else+    Buildable: False
+ src/Happstack/Server/HSP/HTML.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Happstack.Server.HSP.HTML+  ( webHSP+  ) where++import Control.Monad.Trans (MonadIO(), liftIO)+import qualified Data.ByteString.Char8 as P+import qualified Data.ByteString.Lazy.UTF8 as L+import Happstack.Server+  ( ToMessage(toMessage, toContentType, toResponse)+  , Response()+  )+import HSP+  ( HSP()+  , XML()+  , XMLMetaData(XMLMetaData, contentType)+  , evalHSP+  , html4Strict+  , renderAsHTML+  )++instance ToMessage XML where+    toContentType _ = P.pack "text/html;charset=utf-8"+    toMessage xml   = toMessage (html4Strict, xml)++instance ToMessage (Maybe XMLMetaData, XML) where+    toContentType (Just md,_) = P.pack (contentType md)+    toContentType _ = P.pack "text/html;charset=utf-8"+    toMessage (Just (XMLMetaData (showDt, dt) _ pr), xml) = +        L.fromString ((if showDt then (dt ++) else id) (pr xml))+    toMessage (Nothing, xml) =+        L.fromString (renderAsHTML xml)++webHSP :: (MonadIO m) => HSP XML -> m Response+webHSP hsp = return . toResponse =<< liftIO (evalHSP Nothing hsp)+
+ src/Happstack/Server/HStringTemplate.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, PatternSignatures #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Happstack.Server.HStringTemplate (webST) where++import Happstack.Server+  ( ToMessage(toMessage, toContentType, toResponse)+  , Response+  )+import Control.Monad.Trans (MonadIO, liftIO)+import Text.StringTemplate+  ( STGroup+  , StringTemplate+  , directoryGroupLazy+  , getStringTemplate+  , render+  , setManyAttrib+  )+import qualified Data.ByteString.Char8 as B (pack)+import qualified Data.ByteString.Lazy.Char8 as L (pack)+import System.Log.Logger (Priority(..), logM)+log' :: Priority -> String -> IO ()+log' = logM "Happstack.Server.HStringTemplate"++-- FIXME: Caveat, assumes text/html, can this be handled at the filter level?+instance ToMessage (StringTemplate String) where+    toContentType _ = B.pack "text/plain;charset=utf-8"+    toMessage = L.pack . render++-- renders a name template with attrs+webST :: (MonadIO m) => String -> [(String, String)] -> m Response+webST name attrs = do+  grp :: STGroup String <- liftIO $ directoryGroupLazy "templates"+  case getStringTemplate name grp of+    Just tmp -> do+      -- FIXME: I would rather use show, but StringTemplate String has no Show instance+      liftIO $ log' INFO ("webST executing: " ++ name)+      return . toResponse $ setManyAttrib attrs tmp+    Nothing  -> fail $ "Template does not exist: " ++ name+
+ src/Happstack/State/ClockTime.hs view
@@ -0,0 +1,18 @@+{-# 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/Setup.hs view
@@ -0,0 +1,13 @@+#!/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 view
@@ -0,0 +1,1 @@+ghc -isrc src\Main.hs --make -o dist\app
+ templates/project/bin/build.sh view
@@ -0,0 +1,2 @@+#!/bin/sh+ghc -isrc src/Main.hs --make -o dist/app
+ templates/project/bin/run-interactive.bat view
@@ -0,0 +1,1 @@+ghci -isrc src\Main.hs
+ templates/project/bin/run-interactive.sh view
@@ -0,0 +1,2 @@+#!/bin/sh+ghci -isrc src/Main.hs
+ templates/project/bin/run.bat view
@@ -0,0 +1,1 @@+runghc -isrc src\Main.hs
+ templates/project/bin/run.sh view
@@ -0,0 +1,2 @@+#!/bin/sh+runghc -isrc src/Main.hs
+ templates/project/guestbook.cabal view
@@ -0,0 +1,48 @@+Name: guestbook+Version: 1.0+Author: Jeremy Shaw <jeremy@seereason.com>, Matthew Elder <matt@mattelder.org>+Copyright: 2009 Jeremy Shaw+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/Thumbs.db+        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.++Library+ Exposed-Modules:+  AppControl,+  AppLogger,+  AppState+ 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: happstack-state, happstack-server, hslogger, mtl, old-time, old-locale, hsx, hsp, happstack, utf8-string, happstack-data+ if flag(base4)+    Build-Depends: base >= 4 && < 5, syb++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: happstack-util+ Build-Tools: trhsx
+ templates/project/public/theme/images/blockquote.gif view

binary file changed (absent → 103 bytes)

+ templates/project/public/theme/images/date.gif view

binary file changed (absent → 941 bytes)

+ templates/project/public/theme/images/entrymeta.gif view

binary file changed (absent → 182 bytes)

+ templates/project/public/theme/images/grunge.gif view

binary file changed (absent → 3669 bytes)

+ templates/project/public/theme/images/header_loop.gif view

binary file changed (absent → 207 bytes)

+ templates/project/public/theme/images/logo.gif view

binary file changed (absent → 3102 bytes)

+ templates/project/public/theme/images/menu_hili.gif view

binary file changed (absent → 313 bytes)

+ templates/project/public/theme/images/menu_hover.gif view

binary file changed (absent → 205 bytes)

+ templates/project/public/theme/images/peel.gif view

binary file changed (absent → 4961 bytes)

+ templates/project/public/theme/images/ql_rss.gif view

binary file changed (absent → 296 bytes)

+ templates/project/public/theme/readme.txt view
@@ -0,0 +1,1 @@+Theme by Dezinerfolio.com
+ templates/project/public/theme/style.css view
@@ -0,0 +1,349 @@+
+/*
+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/AppControl.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+module AppControl (appHandler) where++import AppState+import AppView+import Control.Applicative((<$>))+import Control.Monad(msum)+import Control.Monad.Trans(liftIO, MonadIO)+import Data.ByteString.Lazy.UTF8 (toString)+import Happstack.Data (defaultValue)+import Happstack.Server+import Happstack.State (update,query)+import System.Time (getClockTime)++appHandler :: ServerPartT IO Response+appHandler = msum+  [ methodM GET >> seeOther "/entries" (toResponse ()) -- matches /+  , dir "entries" $ msum[postEntry, getEntries]        -- RESTful /entries+  , dir "README" getREADME                             -- StringTemplate example+  , fileServe ["index.html"] "public"                  -- static files+  ]++getEntries = methodM GET >> do+  gb <- query ReadGuestBook+  renderFromBody "Happstack Guestbook Example" gb++getREADME = methodM GET >> do+  now <- liftIO getClockTime+  renderREADME now++postEntry = methodM POST >> do -- only accept a post method+  Just entry <- getData -- get the data+  now <- liftIO getClockTime+  update $ AddGuestBookEntry entry{date=now}+  seeOther "/entries" (toResponse ())++-- this tells happstack how to turn post data into a datatype using 'withData'+instance FromData GuestBookEntry where+  fromData = do+    author  <- toString <$> lookBS "author"+    message <- toString <$> lookBS "message"+    return $ GuestBookEntry (if (null author) then "Anonymous" else author) message defaultValue+
+ templates/project/src/AppLogger.hs view
@@ -0,0 +1,25 @@+module AppLogger (setupLogger) where++import System.Log.Logger+  ( Priority(..)+  , setLevel+  , setHandlers+  , getLogger+  , getRootLogger+  , saveGlobalLogger+  )+import System.Log.Handler.Simple (fileHandler, streamHandler)+import System.IO (stdout)++setupLogger = do+  logFileHandler <- fileHandler ("app.log") DEBUG+  stdoutHandler <- streamHandler stdout DEBUG++  -- Log Everything to app.log+  server <- getRootLogger+  saveGlobalLogger $ setLevel DEBUG $ setHandlers [logFileHandler] server++  -- Log Happstack.Server messages of at least INFO priority to stdout+  server <- getLogger "Happstack.Server"+  saveGlobalLogger $ setLevel INFO $ setHandlers [stdoutHandler] server+
+ templates/project/src/AppState.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveDataTypeable,+    FlexibleInstances, MultiParamTypeClasses, FlexibleContexts,+    UndecidableInstances+    #-}+module AppState where+import Happstack.Data+import Happstack.State+import Control.Monad.Reader (ask)+import Control.Monad.State (get, put)+import Happstack.State.ClockTime++-- GuestBookEntry: simple guest book entry+$(deriveAll [''Show, ''Eq, ''Ord]+  [d|+      data GuestBookEntry = GuestBookEntry+          { author  :: String+          , message :: String+          , date    :: ClockTime+          }+      +      newtype GuestBook = GuestBook { guestBookEntries :: [GuestBookEntry] }+   |]+ )++$(deriveSerialize ''GuestBookEntry)+instance Version GuestBookEntry++$(deriveSerialize ''GuestBook)+instance Version GuestBook++-- AppState: define our own component, 'AppState' for data persistence+$(deriveAll [''Show, ''Eq, ''Ord]+  [d|+      data AppState = AppState+          { guestBook :: GuestBook+          }+   |])+$(deriveSerialize ''AppState)+instance Version AppState++instance Component AppState where+  type Dependencies AppState = End+  initialValue = AppState (GuestBook []) -- empty list of GuestBookEntry's++-- readGuestBook: get the guestBook from AppState+readGuestBook :: Query AppState GuestBook+readGuestBook = do+  state <- ask+  return $ guestBook state+  +addGuestBookEntry :: GuestBookEntry -> Update AppState  ()+addGuestBookEntry e = do+  st <- get+  let (GuestBook gb) = guestBook st+  put st{guestBook=GuestBook (e:gb)}+  +-- create types for event serialization+$(mkMethods ''AppState ['readGuestBook, 'addGuestBookEntry])+
+ templates/project/src/AppView.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module AppView where++import AppState+import HSP+import System.Locale (defaultTimeLocale)+import System.Time (formatCalendarTime, toUTCTime)+import Control.Monad.Trans (MonadIO)+import Happstack.Server.HStringTemplate (webST)+import Happstack.Server.HSP.HTML (webHSP)++-- Convenience Functions+dateStr ct =+  formatCalendarTime+    defaultTimeLocale+    "%a, %B %d, %Y at %H:%M:%S (UTC)"+    (toUTCTime ct)++-- Main Implementation+instance (XMLGenerator m) => (EmbedAsChild m (GuestBookEntry, Bool)) where+    asChild ((GuestBookEntry author message date), alt) =+        <%+           <li class=(if alt then "alt" else "")>+            <strong><% author %></strong> said:<br /><br />+            <% map p (lines message) %>+            <br />+            <small class="commentmetadata"><% dateStr date %></small> +           </li>+         %>+        where p str = <p><% str %></p>++instance (XMLGenerator m) => (EmbedAsChild m GuestBook) where+    asChild (GuestBook entries) = +        <% +         <div>+          <h2 id="comments" class="h2comment">Words of Wisdom</h2>+          <div class="clear" />+          <ul class="commentlist">+           <% zip entries (cycle [False,True]) %>+          </ul>+         </div>+        %>++renderFromBody title body = webHSP $ pageFromBody title body+pageFromBody :: (EmbedAsChild (HSPT' IO) xml) => String -> xml -> HSP XML+pageFromBody title body =+    withMetaData html4Strict $+    <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" />+     </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/tutorials.html" 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> 0.2.+              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="/entries" method="post" enctype="multipart/form-data:charset=UTF-8" accept-charset="UTF-8">+            <p><label for="author">A<span class="accesskey">u</span>thor</label><br /><input type="text" name="author" id="author" tabindex="1" accesskey="U" /></p>+            <p><label for="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><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>++renderREADME now = do+  webST "readme" [("time", dateStr now)]+
+ templates/project/src/Main.hs view
@@ -0,0 +1,95 @@+module Main where++import Control.Concurrent (MVar(..), forkIO, killThread)+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 System.Environment (getArgs, getProgName)+import System.Log.Logger (Priority(..), logM)+import System.Exit (exitFailure)+import System.Console.GetOpt +import AppLogger (setupLogger)+import AppState (AppState(..))+import AppControl (appHandler)++stateProxy :: Proxy AppState+stateProxy = Proxy++main = do+  -- progname effects where state is stored and what the logfile is named+  let progName = "guestbook"+  +  args <- getArgs+  setupLogger++  appConf <- case parseConfig args of+               (Left e) -> do logM progName ERROR (unlines e)+                              exitFailure+               (Right f) -> return (f $ defaultConf progName)+  +  -- start the state system+  control <- startSystemState' (store appConf) stateProxy+  +  -- start the http server+  httpTid <- forkIO $ simpleHTTP (httpConf appConf) appHandler++  -- checkpoint the state once a day+  cronTid <- forkIO $ cron (60*60*24) (createCheckpoint control)+  +  -- wait for termination signal+  waitForTermination+  +  -- cleanup+  killThread httpTid+  killThread cronTid+  createCheckpoint control+  shutdownSystem control +++data AppConf+    = AppConf { httpConf :: Conf+              , store :: FilePath+              , static :: FilePath +              }++defaultConf :: String -> AppConf+defaultConf progName+    = AppConf { httpConf = nullConf+              , store    = "_local/" ++ progName ++ "_state"+              , static   = "public"+              }++opts :: [OptDescr (AppConf -> AppConf)]+opts = [ Option [] ["http-port"]   (ReqArg (\h c -> c { httpConf = (httpConf c) {port = read h} }) "port") "port to bind http server"+       , Option [] ["no-validate"] (NoArg (\ c -> c { httpConf = (httpConf c) { validator = Nothing } })) "Turn off HTML validation"+       , Option [] ["validate"]    (NoArg (\ c -> c { httpConf = (httpConf c) { validator = Just wdgHTMLValidator } })) "Turn on HTML validation"+       , Option [] ["store"]       (ReqArg (\h c -> c {store = h}) "PATH") "The directory used for database storage."+       , Option [] ["static"]      (ReqArg (\h c -> c {static = h}) "PATH") "The directory searched for static files" +       ]++parseConfig :: [String] -> Either [String] (AppConf -> AppConf)+parseConfig args+    = case getOpt Permute opts args of+        (flags,_,[]) -> Right $ \appConf -> foldr ($) appConf flags+        (_,_,errs)   -> Left errs++startSystemState' :: (Component st, Methods st) => String -> Proxy st -> IO (MVar TxControl)+startSystemState' path proxy =+    runTxSystem (Queue (FileSaver path)) proxy+
+ templates/project/templates/readme.st view
@@ -0,0 +1,6 @@+This is a dynamic README file which uses HStringTemplate.++The time is $time$.++Thanks for reading!+
+ tests/Happstack/Tests.hs view
@@ -0,0 +1,12 @@+module Happstack.Tests where++import qualified Happstack.Util.Tests       as Util+import qualified Happstack.Data.Tests       as Data+import qualified Happstack.Data.IxSet.Tests as IxSet+import qualified Happstack.State.Tests      as State+import qualified Happstack.Server.Tests     as Server+import qualified Happstack.Server.Tests     as Contrib+import Test.HUnit++allTests :: Test+allTests = ("happstack" ~: [ Util.allTests, Data.allTests, IxSet.allTests, State.allTests, Server.allTests, Contrib.allTests ])
+ tests/Test.hs view
@@ -0,0 +1,19 @@+module Main where++import Happstack.Tests (allTests)+import Test.HUnit (errors, failures, putTextToShowS,runTestText, runTestTT)+import System.Exit (exitFailure)+import System.IO (hIsTerminalDevice, stdout)++-- |A simple driver for running the local test suite.+main :: IO ()+main =+    do c <- do istty <- hIsTerminalDevice stdout+               if istty+                  then runTestTT allTests+                  else do (c,st) <- runTestText putTextToShowS allTests+                          putStrLn (st "")+                          return c+       case (failures c) + (errors c) of+         0 -> return ()+         n -> exitFailure