File: CalcFix.hs

package info (click to toggle)
washngo 2.9-4.1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 2,876 kB
  • ctags: 273
  • sloc: haskell: 54,162; makefile: 1,086; ansic: 305; sh: 153; sql: 13
file content (36 lines) | stat: -rw-r--r-- 1,009 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
--  2001-2005 Peter Thiemann
module Main where

import Char
import Prelude hiding (head, span, map)
import WASH.CGI.CGI hiding (div)

main = 
  run mainCGI

mainCGI = 
  calc "0" id

calc dstr f =
  standardQuery "Calculator" $ table $
  do dsp <- tr (td (textInputField (attr "value" dstr ## attr "name" "result")
		    ## attr "colspan" "4"))
     let button c = td (submit dsp (calcAction c f)
				   (attr "value" [c] ## attr "name" ('k': [c])))
     tr (button '1' ## button '2' ## button '3' ## button '+')
     tr (button '4' ## button '5' ## button '6' ## button '-')
     tr (button '7' ## button '8' ## button '9' ## button '*')
     tr (button 'C' ## button '0' ## button '=' ## button '/')

calcAction c f dsp
  | isDigit c = calc (dstr ++ [c]) f
  | c == 'C'  = mainCGI
  | c == '='  = calc (show (f (read dstr :: Integer))) id
  | otherwise = calc "0" (optable c (read dstr :: Integer))
  where dstr = value dsp
	optable '+' = (+)
	optable '-' = (-)
	optable '*' = (*)
	optable '/' = div