hpaste

{-# OPTIONS -fglasgow-exts -fth -fallow-undecidable-instances #-}

module Main where

import HAppS

import Data.Typeable
import Control.Monad.State (get, put)

auth :: Int -> IO Bool
auth id = return True

homepage :: String
homepage =  "<form action=\"print\" method=\"post\"><p><label for=\"file\">File to print: </label><input type=\"text\" name=\"file\"><br><input type=\"submit\" value=\"Send\"> <input type=\"reset\"></p></input>"


data MyState = MySt { appVal :: Int } deriving (Read,Show,Typeable)
 
instance Serialize MyState where
  encodeStringM = defaultEncodeStringM
  decodeStringM = defaultDecodeStringM
  
$(inferStartState ''MyState) -- boilerplate that will eventually be SYB
 
instance FromReqURI [String] MyState where
    fromReqURI expr uri
        = do [val] <- fromReqURI (Prefix expr) uri
             fmap MySt $ mbRead val
 
main = stdHTTP $ noState : 
       [
        h [""]  () $ ok $ val $ homepage,
        --h ["set"] GET $ ok $ \newVal () -> do respond ("New value is " ++ show newVal), --this don't work!!
        h ["set"] GET $ ok $ \newVal () -> do put newVal; respond ("New value is " ++ show newVal)
       ]

uncommenting: h ["set"] GET $ ok $ \newVal () -> do respond ("New value is " ++ show newVal),

BlueTux:~/Desktop/Haskell/Guttemberg Phas$ ghc --make AuthTest.hs
[1 of 1] Compiling Main             ( AuthTest.hs, AuthTest.o )
Loading package base ... linking ... done.
Loading package template-haskell ... linking ... done.
Loading package haskell98 ... linking ... done.
Loading package HaXml-1.13.2 ... linking ... done.
Loading package mtl-1.0 ... linking ... done.
Loading package parsec-2.0 ... linking ... done.
Loading package html-1.0 ... linking ... done.
Loading package network-2.0 ... linking ... done.
Loading package stm-2.0 ... linking ... done.
Loading package regex-base-0.71 ... linking ... done.
Loading package regex-posix-0.71 ... linking ... done.
Loading package regex-compat-0.71 ... linking ... done.
Loading package binary-0.2 ... linking ... done.
Loading package HList-0.1 ... linking ... done.
Loading package HAppS-0.8.8 ... linking ... done.

AuthTest.hs:33:8:
    No instance for (FromReqURI [[Char]] a)
      arising from use of `h' at AuthTest.hs:33:8-20
    Possible fix:
      add an instance declaration for (FromReqURI [[Char]] a)
    In the first argument of `($)', namely `h ["set"] GET'
    In the expression:
          (h ["set"] GET)
        $ (ok
         $ (\ newVal () -> do respond ("New value is " ++ (show newVal))))
    In the second argument of `(:)', namely
        `[(h [""] ()) $ (ok $ (val $ homepage)),
          (h ["set"] GET)
        $ (ok
         $ (\ newVal () -> do respond ("New value is " ++ (show newVal)))),
          (h ["set"] GET)
        $ (ok
         $ (\ newVal ()
                -> do put newVal
                      respond ("New value is " ++ (show newVal))))]'

Powered by HAppS. Copyright (c) 2007 glguy @ #haskell. Source via darcs.