Initial import version 2.12

Examples/LICENSE

@@ -0,0 +1,30 @@
+The WASH License
+
+Copyright 2001-2003, Peter Thiemann.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:  
+
+   1. Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer. 
+   2. 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. 
+   3. The name of the author may not be used to endorse or promote
+      products derived from this software without specific prior
+      written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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. 

Examples/Makefile

@@ -0,0 +1,14 @@
+CGIDIR= /usr/lib/cgi-bin/WASH
+CONFIGFLAGS= --prefix=$(CGIDIR)
+INSTALLFLAGS=
+SETUP= ./Setup.lhs
+
+all:
+	$(SETUP) configure $(CONFIGFLAGS)
+	$(SETUP) build
+
+install:
+	$(SETUP) install $(INSTALLFLAGS)
+
+clean:	
+	$(SETUP) clean

Examples/Setup.lhs

@@ -0,0 +1,6 @@
+#!/usr/bin/env runhaskell
+arch-tag: Main setup script
+
+> import Distribution.Simple
+
+> main = defaultMain

Examples/WASHExamples.cabal

@@ -0,0 +1,155 @@
+Name: WashNGoExamples
+Version: 2.10
+License: BSD3
+License-File: LICENSE
+Author: Peter Thiemann
+Copyright: Copyright 2001-2006, Peter Thiemann
+Homepage: http://www.informatik.uni-freiburg.de/~thiemann/haskell/WASH/
+Category: Web
+Stability: Beta
+Synopsis: Example package for WASH
+Build-Depends: base, haskell98, parsec, WashNGo>=2.10
+
+Executable: Date
+Main-Is: Date.hs
+Hs-Source-Dirs: new
+Ghc-Options: -pgmF wash2hs -F -fglasgow-exts
+
+Executable: Date2
+Main-Is: Date2.hs
+Hs-Source-Dirs: new
+Ghc-Options: -pgmF wash2hs -F -fglasgow-exts
+
+-- Executable: Reservation
+-- Main-Is: Reservation.hs
+-- Hs-Source-Dirs: new
+-- Ghc-Options: -pgmF wash2hs -F
+
+Executable: CalcHistory
+Main-Is: CalcHistory.hs
+Hs-Source-Dirs: old
+
+Executable: CalcFix
+Main-Is: CalcFix.hs
+Hs-Source-Dirs: old
+
+Executable: Calculator
+Main-Is: Calculator.hs
+Hs-Source-Dirs: old
+
+Executable: Counter
+Main-Is: Counter.hs
+Hs-Source-Dirs: old
+
+Executable: HelloWorld
+Main-Is: HelloWorld.hs
+Hs-Source-Dirs: old
+
+Executable: Multiplication
+Main-Is: Multiplication.hs
+Hs-Source-Dirs: old
+
+Executable: UpDownCounter
+Main-Is: UpDownCounter.hs
+Hs-Source-Dirs: old
+
+Executable: UseAT
+Main-Is: UseAT.hs
+Hs-Source-Dirs: old
+
+Executable: UseCGI4
+Main-Is: UseCGI4.hs
+Hs-Source-Dirs: old
+
+Executable: UseGraphics
+Main-Is: UseGraphics.hs
+Hs-Source-Dirs: old
+
+Executable: GuessNumberCookie
+Main-Is: GuessNumberCookie.hs
+Hs-Source-Dirs: old
+
+Executable: GuessNumber
+Main-Is: GuessNumber.hs
+Hs-Source-Dirs: old
+
+Executable: GuessNumberNoCheating
+Main-Is: GuessNumberNoCheating.hs
+Hs-Source-Dirs: old
+
+Executable: TimeTable
+Main-Is: TimeTable.hs
+Hs-Source-Dirs: old
+
+Executable: SendFile
+Main-Is: SendFile.hs
+Hs-Source-Dirs: old
+
+Executable: Tutorial
+Main-Is: Tutorial.hs
+Hs-Source-Dirs: old
+
+Executable: Upload
+Main-Is: Upload.hs
+Hs-Source-Dirs: old
+
+Executable: Vote
+Main-Is: Vote.hs
+Hs-Source-Dirs: old
+
+Executable: TinyShop
+Main-Is: TinyShop.hs
+Hs-Source-Dirs: old
+
+Executable: TinyShopXX
+Main-Is: TinyShopXX.hs
+Hs-Source-Dirs: old
+
+Executable: ex1
+Main-Is: ex1.hs
+Hs-Source-Dirs: old
+
+Executable: ex2-2
+Main-Is: ex2-2.hs
+Hs-Source-Dirs: old
+
+Executable: ex2-3
+Main-Is: ex2-3.hs
+Hs-Source-Dirs: old
+
+Executable: ex3-1
+Main-Is: ex3-1.hs
+Hs-Source-Dirs: old
+
+Executable: ex3-2-a
+Main-Is: ex3-2-a.hs
+Hs-Source-Dirs: old
+
+Executable: ex3-2-b
+Main-Is: ex3-2-b.hs
+Hs-Source-Dirs: old
+
+Executable: NewCounter
+Main-Is: Counter.hs
+Hs-Source-Dirs: new
+Ghc-Options: -pgmF wash2hs -F
+
+Executable: NewHelloWorld
+Main-Is: HelloWorld.hs
+Hs-Source-Dirs: new
+Ghc-Options: -pgmF wash2hs -F
+
+Executable: NewMultiplication
+Main-Is: Multiplication.hs
+Hs-Source-Dirs: new
+Ghc-Options: -pgmF wash2hs -F
+
+Executable: NewGuessNumberNoCheating
+Main-Is: GuessNumberNoCheating.hs
+Hs-Source-Dirs: new
+Ghc-Options: -pgmF wash2hs -F
+
+Executable: NewTutorial
+Main-Is: Tutorial.hs
+Hs-Source-Dirs: new
+Ghc-Options: -pgmF wash2hs -F

Examples/new/Counter.hs

@@ -0,0 +1,18 @@
+-- © 2001-2005 Peter Thiemann
+module Main where
+
+-- import Prelude hiding (map, span, head, div)
+import WASH.CGI.CGI
+
+main = 
+  run mainCGI
+
+mainCGI =
+  counter 0
+
+counter n =
+  standardQuery "Counter" 
+    <p>Current counter value <%= n %><br />
+     <input type="submit" WASH:callback="counter (n+1)" />
+     <input type="submit" WASH:callback="counter (n-1)" />
+    </p>

Examples/new/Date.hs

@@ -0,0 +1,35 @@
+-- © 2001, 2002 Peter Thiemann
+module Main where
+
+import Prelude hiding (head, span, div, map)
+import WASH.CGI.CGI
+
+main =
+  run mainCGI
+
+{- 
+getDate =
+  table $ do
+    day <- tr (td (text "Day") ## td (inputField empty))
+    month <- tr (td (text "Month") ## td (inputField empty))
+    return (day, month)
+-}
+
+dateForm =
+  <#> <table>
+       <tr><td>Day</td><td><% day <- inputField empty %></td></tr>
+       <tr><td>Month</td><td> <% month <- inputField empty %> </td></tr>
+     </table>
+    <input type="submit" WASH:callback="displayDate" WASH:parms="day,month" />
+  </#>
+
+showDate :: (Int, Int) -> WithHTML x CGI ()
+showDate (day :: Int, month :: Int) =
+  <#><%= month %>/<%= day %></#>
+
+displayDate :: (Int, Int)        -> CGI ()
+displayDate theDate =
+  standardQuery "displayDate" (showDate theDate)
+
+mainCGI =
+  (standardQuery "Hello World" dateForm)

Examples/new/Date2.hs

@@ -0,0 +1,53 @@
+-- © 2001, 2002 Peter Thiemann
+{-# ghc_options -fglasgow-exts -}
+module Main where
+
+import Prelude hiding (head, span, div, map)
+import WASH.CGI.CGI
+
+main =
+  run mainCGI
+
+getDate :: WithHTML x CGI (InputField Date INVALID)
+getDate =
+  table $ do
+    (day :: InputField Date INVALID) <- tr (td (text "Day") >> td (inputField empty))
+    month <- tr (td (text "Month") >> td (inputField empty))
+    let dm = concatFieldsWith (\dayStr [monthStr] -> '(':dayStr++',':monthStr++")")
+			        day [month] 
+    return dm
+
+{-
+dateForm =
+  <#> <table>
+       <tr><td>Day</td><td><% day <- inputField empty %></td></tr>
+       <tr><td>Month</td><td> <% month <- inputField empty %> </td></tr>
+     </table>
+    <input type="submit" WASH:callback="displayDate" WASH:parms="day,month" />
+  </#>
+-}
+
+datesForm =
+  <#> <table>
+       <tr><td>Arrival</td><td><% arrival <- getDate %></td></tr>
+       <tr><td>Departure</td><td> <% departure <- getDate %> </td></tr>
+     </table>
+    <input type="submit" WASH:callback="displayDates" WASH:parms="arrival,departure" />
+  </#>
+
+showDate :: (Int, Int) -> WithHTML x CGI ()
+showDate (day, month) =
+  <#><%= month %>/<%= day %></#>
+
+type Date = (Int, Int)
+
+showDates :: (Date, Date) -> WithHTML x CGI ()
+showDates (arr, dept) =
+  <#>Arrival <% showDate arr %> Departure <% showDate dept %></#>
+
+displayDates :: ((Int, Int),(Int, Int)) -> CGI ()
+displayDates theDates =
+  standardQuery "displayDate" (showDates theDates)
+
+mainCGI =
+  (standardQuery "Hello World" datesForm)

Examples/new/GuessNumberNoCheating.hs

@@ -0,0 +1,74 @@
+-- © 2001-2005 Peter Thiemann
+module Main where
+
+import Random
+import Monad
+import List
+
+import WASH.CGI.CGI
+import qualified WASH.CGI.Persistent2 as P
+
+import Score
+
+highScoreStore :: CGI (P.T [Score])
+highScoreStore = P.init "GuessNumberNoCheating" []
+
+main :: IO ()
+main =
+  run mainCGI
+
+mainCGI =
+  standardQuery "Guess a number" $
+    do submit0
+	 (play 0 ((1,100) :: (Int,Int)) "I've thought of a number between 1 and 100.")
+         (fieldVALUE "Play the game")
+       submit0 admin (fieldVALUE "Hall of Fame")
+
+play nGuesses ivl aMessage =
+  standardQuery "Guess a number" $
+    do text aMessage
+       text " Make a guess "
+       activeInputField (processGuess (nGuesses + 1) ivl) empty
+
+processGuess nGuesses ivl@(low,hi) aGuess =
+  io (randomRIO ivl) >>= \ aNumber ->
+  if aNumber == aGuess then
+    youGotIt nGuesses
+  else if aGuess < aNumber then
+    let nextivl = if aGuess < low then ivl else (max low aGuess + 1, hi) in
+    play nGuesses nextivl ("Your guess " ++ show aGuess ++ " was too small.")
+  else
+    let nextivl = if aGuess > hi then ivl else (low, min aGuess hi - 1) in
+    play nGuesses nextivl ("Your guess " ++ show aGuess ++ " was too large.")
+
+youGotIt nGuesses =
+  standardQuery "You got it!" 
+    <#>CONGRATULATIONS!
+      <br />
+      It took you <%= nGuesses %> tries to find out.
+      <br />
+      Enter your name for the hall of fame 
+      <% nameF <- textInputField empty %>
+      <br />
+      <% defaultSubmit nameF (addToHighScore nGuesses) empty %>
+    </#>
+
+addToHighScore nGuesses nameF =
+  let name = value nameF in
+  if name == "" then admin else
+  do highScoreList <- highScoreStore
+     P.add highScoreList (Score name nGuesses)
+     admin
+
+admin = 
+  do highScoreList <- highScoreStore
+     highScores <- P.get highScoreList
+     standardQuery "GuessNumber - High Scores" 
+       <table border="border">
+	 <tr><th>Name</th><th># Guesses</th></tr>
+	 <% mapM_ g (sort highScores) %>
+       </table>
+  where
+    g (Score name guesses) =
+      <tr><td><%= name %></td><td><%= guesses %></td></tr>
+