{-# OPTIONS -XExistentialQuantification  -XTypeSynonymInstances
            -XFlexibleInstances -XDeriveDataTypeable #-}
module MFlow.Hack.Response where

import Hack
import MFlow.Cookies
import Data.ByteString.Lazy.Char8
import MFlow(HttpData(..))
import Data.Typeable
import Data.Monoid

--import Debug.Trace
--
--(!>)= flip trace

class ToResponse a where
      toResponse :: a -> Response



data TResp = TRempty | forall a.ToResponse a=>TRespR a |  forall a.(Typeable a, ToResponse a, Monoid a) => TResp a deriving Typeable

instance Monoid TResp where
      mempty = TRempty
      mappend (TResp x) (TResp y)=
         case cast y of
              Just y' -> TResp $ mappend x y'
              Nothing -> error $ "fragment of type " ++ show ( typeOf  y)  ++ " after fragment of type " ++ show ( typeOf x)



defaultResponse :: String ->  IO Response
defaultResponse  msg=  return  . toResponse $ "<p>Page not found or error ocurred:<br/>" ++ msg ++  "<br/><a href=\"/\" >home</a> </p>"


instance ToResponse TResp where
  toResponse (TResp x)= toResponse x
  toResponse (TRespR r)= toResponse r
  
instance ToResponse Response where
      toResponse = id

instance ToResponse ByteString  where
      toResponse x= Response{status=200, headers=[ctype {-,("Content-Length",show $ B.length x) -}], body= x}

instance ToResponse String  where
      toResponse x= Response{status=200, headers=[ctype{-,("Content-Length",show $ B.length x) -}], body= pack x}




instance ToResponse a => ToResponse (HttpData a)  where
  toResponse (HttpData cookies x)=   (toResponse x) {headers= cookieHeaders cookies}

--
--instance ToResponse (HSP XML) where
--  toResponse xml=unsafePerformIO $ do
--       (_,html) <- evalHSP Nothing xml
--       let bs= pack $ renderAsHTML html
--       return $ toResponse bs



{-
instance IResource Env where
      keyResource  env=user ++ "#" ++ flowId where
           user= case lookup "user" $ http env of
                                Nothing -> "nokey"
                                Just user -> user
           flowId= case lookup "flow"$ http env of
                                Nothing -> error ": No FlowID"
                                Just fl -> fl
      serialize= show
      deserialize= error "Env deserialize: undefined"
      writeResource _ = return ()
      readResource _ = undefined
-}
--instance Read Env where
--      readsPrec= error "Env Read: undefined"
{-
instance IResource Response where
      keyResource _ = "resp"
      serialize= show
      deserialize= error "Response deserialize: undefined"
      writeResource _ = return ()
      readResource _ = undefined
-}


instance Typeable Env where
     typeOf = \_-> mkTyConApp (mkTyCon "Hack.Env") []

instance Typeable Response where
     typeOf = \_-> mkTyConApp (mkTyCon "Hack.Response")[]