module MFlow.Wai.Response where
import Network.Wai
import MFlow.Cookies
import Data.ByteString.Char8 as SB
import Data.ByteString.Lazy.Char8 as B
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(..))
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)
ctype1= [mkparam ctype]
mkParams = Prelude.map mkparam
mkparam (x,y)= (mk $ SB.pack x, SB.pack y)
instance ToResponse TResp where
toResponse (TResp x)= toResponse x
toResponse (TRespR r)= toResponse r
instance ToResponse Response where
toResponse = id
instance ToResponse B.ByteString where
toResponse x= responseLBS status200 ctype1 x
instance ToResponse String where
toResponse x= responseLBS status200 ctype1 $ B.pack x
instance ToResponse HttpData where
toResponse (HttpData hs cookies x)= responseLBS status200 (mkParams $ hs ++ cookieHeaders cookies) x
toResponse (Error NotFound str)= responseLBS status404 [] $ getNotFoundResponse str