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

import Network.Wai
import MFlow.Cookies

import Data.ByteString.Lazy.UTF8 
import MFlow
import Data.Typeable
import Data.Monoid
import System.IO.Unsafe
import Data.Map as M
import Data.CaseInsensitive
import Network.HTTP.Types
import Control.Workflow(WFErrors(..))
--import Data.String
--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)


mkParams = Prelude.map mkparam
mkparam (x,y)= (mk  x, y)

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= responseLBS status200 [mkparam contentHtml]  x

instance ToResponse String  where
      toResponse x= responseLBS status200 [mkparam contentHtml]  $ fromString x

instance  ToResponse HttpData  where
  toResponse (HttpData hs cookies x)= responseLBS status200 (mkParams ( hs <> cookieHeaders cookies)) x
  toResponse (Error str)=  responseLBS status404 [("Content-Type", "text/html")] str

--  toResponse $ error "FATAL ERROR: HttpData errors should not reach here: MFlow.Forms.Response.hs "