{-# OPTIONS_GHC -fth -fglasgow-exts -fallow-overlapping-instances -fallow-undecidable-instances  #-}
--module Main1 where
import HAppS
import Control.Monad
import Data.Maybe
import Control.Monad.State

main = do putStrLn "happs started"
          mainHTTP (httpH ".")
	
httpH path = -- noState: -- yet! we will add server state later
	     [
             --return a value with the correct content-type
             -- http://localhost:7080/hello
	     h ["hello"] GET $ ok $ val "hello world"

             --request is passed as arg 
             --you can list multiple methods to match not just one
             ,h ["req"] [GET,POST] $ ok $ showRequest --for all methods
             -- http://localhost:7080/req?foo=bar&baz=zap

             --match all methods if you want
             --also you can pass the remaining path info to your handler
             ,h (Prefix ["path"]) () $ ok $ showPath
             -- http://localhost:7080/path/bas/big

             --automaticly convert from path to your type
             ,h Sum () $ ok $ showSum 
             -- http://localhost:7080/sum/2/3/biff/4
             -- http://localhost:7080/sum/2/3/4

             -- matching on int in path or mismatch causes next handler
             ,h Sum2 () $ ok showSum
             ,h Sum2 () $ badRequest $ val "not int"
             -- http://localhost:7080/sum2/2/3/4
             -- http://localhost:7080/sum2/2/3/biff/4

             --request matches requirememt for type or cascase
             ,h ["mytype"] GET $ ok $ reqMyType 
             -- http://localhost:7080/mytype?arg1=abc&arg2=56
             -- http://localhost:7080/mytype?arg1=abc&arg2=abc
             ,h ["mytype"] GET $ badRequest $ val "not mytype"
             -- http://localhost:7080/mytype

             --we can return XML or define our own toMessage
             ,h ["mytype2"] GET $ ok $ myTypeXML
             -- http://localhost:7080/mytype2
             --view the source!!
                
             --demonstrate using state
             -- POST /incr  #updating state -- state is just an integer
             ,h ["incr"] [POST,GET] $ -- GET here is violation of idempotency
                ok $ \() () -> 
                 modify (+(1::Int)) >> get >>= respond . show

             --serve / as index.html
             --we can transform the request as we go
             --look at the source for pathReWrute and dirIndex in simpleHTTP
             ,h () GET $ pathRewrite $ dirIndex "s/index.html"
             -- http://localhost:7080

             --simple fileserving notice we don't have directory indexing yet!
             ,h (Prefix ["s"]) GET $ respIO $ fileServe path
             -- http://localhost:7080/s
             -- http://localhost:7080/s/index.html
             -- http://localhost:7080/s/.src
             -- http://localhost:7080/s/.src/Main1.hs

             ,  h ["iohandler"]    GET $ ioReadFileHandler
             ,  h ["statehandler"] GET $ stateHandler
             --,  h ["ioandstatehandler"] GET $ ioAndStateHandler
             ]

-- displays contents of HAPPS.hs in current directory
ioReadFileHandler = iohandler $ readFile "./HAppS.hs" 

-- displays incremented state counter
stateHandler = ok $ \() () -> 
                   modify (+(1::Int)) >> get >>= respond . show

-- should combine effect of iohandler with statehandler
-- specifically, should display contents of HAppS.hs, and under that an incremented state handler
-- is this possible
ioAndStateHandler = undefined undefined

--showRequest () (r::Request) = respond $ show r
showPath (xs::[String]) () = respond $ show xs

data Sum = Sum | Sum2 deriving Show
instance FromReqURI Sum [Int] where
    fromReqURI Sum uri = fromReqURI (Prefix ["Sum"]) uri 
                          >>= return . msum . map readM
    fromReqURI Sum2 uri = fromReqURI (Prefix ["Sum2"]) uri 
                          >>= mapM readM >>= return

instance FromReqURI Sum () where
    fromReqURI exp uri = fromReqURI (Prefix [show exp]) uri 
                         >>= return 

showSum (x::[Int]) () =  respond $ show $ sum x

data MyType = MyType {arg1::String,arg2::Int} deriving Show


instance FromMessage MyType where
    fromMessageM m = 
        do
        a1 <- lookM m "arg1" -- string doesn't need to be read
        a2 <- lookMbRead m "arg2" -- read in an int
        return $ MyType a1 a2


reqMyType () myType = respond $ "arg1==" ++ (arg1 myType) ++ 
                      "\n"++(show myType)

instance ToElement MyType where
    toElement (MyType x y) = listElem "MyType" [] 
                             [t "abc" [] x,t "def" [] (show y)]

myTypeXML () (x::MyType) = respond x

iohandler ioaction = \() () -> respond $ do
  res <- ioaction
  --(MySt val) <- get
  sresult 200 $ "completed io action, result: " ++ res