hunk ./debian/changelog 1
+haskell-happstack-extra (0.88) unstable; urgency=low
+
+  * Updated to happstack 0.5.1 from darcs
+
+ -- Jeremy Shaw <jeremy@seereason.com>  Tue, 26 Oct 2010 18:23:24 -0500
+
hunk ./happstack-extra.cabal 2
-Version:          0.87
+Version:          0.88
hunk ./src/Happstack/Extra.hs 8
- , module Happstack.Server.SimpleHTTP
hunk ./src/Happstack/Extra.hs 17
-import Happstack.Server.SimpleHTTP
hunk ./src/Happstack/Server/Account/Server.hs 10
+import Control.Applicative ((<$>), (<*>), optional)
hunk ./src/Happstack/Server/Account/Server.hs 21
-import Happstack.Server (ServerMonad, FilterMonad(..),Method(GET, POST), Response,
+import Happstack.Server (ServerMonad, FilterMonad(..), HasRqData, Method(GET, POST), Response,
hunk ./src/Happstack/Server/Account/Server.hs 25
+import qualified Happstack.Server.Cookie as C
hunk ./src/Happstack/Server/Account/Server.hs 41
-                 addCookie (-1) (mkCookie "sessionId" (show sId))
+                 addCookie C.Session (mkCookie "sessionId" (show sId))
hunk ./src/Happstack/Server/Account/Server.hs 46
-           (MonadIO m, FilterMonad Response m, MonadPlus m, ServerMonad m, AccountData acct, SessionData sess) =>
+           (MonadIO m, FilterMonad Response m, MonadPlus m, ServerMonad m, AccountData acct, SessionData sess, HasRqData m) =>
hunk ./src/Happstack/Server/Account/Server.hs 53
-    [withDataFn lookPairs $ \ pairs ->
+    [withDataFn ((,) <$> (optional $ look "alert") <*> (fmap unEscapeString <$> (optional $ look "dest"))) $ \ (alert, destString) ->
hunk ./src/Happstack/Server/Account/Server.hs 56
-     let destString = fmap unEscapeString (lookup "dest" pairs)
-         destURI = maybe Nothing (\ s -> maybe (parseURI s) Just (parseRelativeReference s)) destString
-         dest = maybe (relURI path []) id destURI
-         alert = lookup "alert" pairs in
+     let destURI = maybe Nothing (\ s -> maybe (parseURI s) Just (parseRelativeReference s)) destString
+         dest = maybe (relURI path []) id destURI in
hunk ./src/Happstack/Server/Account/Server.hs 76
-handleSignUp :: (MonadIO m, FilterMonad Response m, MonadPlus m, ServerMonad m, AccountData a, SessionData s) =>
+handleSignUp :: (MonadIO m, FilterMonad Response m, MonadPlus m, ServerMonad m, AccountData a, SessionData s, HasRqData m) =>
hunk ./src/Happstack/Server/Account/Server.hs 102
-handleSignIn :: (MonadPlus m, MonadIO m, AccountData a, SessionData s, ServerMonad m, FilterMonad Response m) =>
+handleSignIn :: (MonadPlus m, MonadIO m, AccountData a, SessionData s, ServerMonad m, FilterMonad Response m, HasRqData m) =>
hunk ./src/Happstack/Server/Account/Server.hs 121
-handleSignOut :: (MonadIO m, FilterMonad Response m, ServerMonad m, MonadPlus m, SessionData sess) =>
+handleSignOut :: (MonadIO m, FilterMonad Response m, ServerMonad m, MonadPlus m, SessionData sess, HasRqData m) =>
hunk ./src/Happstack/Server/Extra.hs 24
-import Happstack.Server as Happstack (RqData, Request(..), Response(..), ServerPartT(..), WebT(..), FilterMonad(..), ServerMonad(..), WebMonad(..), getHeader, noopValidator
-                   , notFound, setValidator, toResponse, withRequest) 
+import Happstack.Server as Happstack (RqData, Request(..), Response(..), ServerPartT(..), FilterMonad(..), ServerMonad(..), WebMonad(..), HasRqData(..), getHeader, lookPairs, noopValidator, notFound, setValidator, toResponse) 
hunk ./src/Happstack/Server/Extra.hs 39
-prettyRequest (Happstack.Request method paths uri query inputs cookies version headers body' peer)
+prettyRequest (Happstack.Request method paths uri query inputsQuery inputsBody cookies version headers body' peer)
hunk ./src/Happstack/Server/Extra.hs 47
-                              ((define (toHtml "inputs")  +++ (ddef (prettyDlist (map (toHtml *** (toHtml . show)) inputs)))))  +++
+                              ((define (toHtml "inputs")  +++ (ddef (prettyDlist (map (toHtml *** (toHtml . show)) inputsQuery)))))  +++
hunk ./src/Happstack/Server/Extra.hs 51
-                              ((define (toHtml "peer")    +++ (ddef (toHtml (show peer)))))    +++
-                              ((define (toHtml "body")    +++ (ddef (toHtml (show body')))))
+                              ((define (toHtml "peer")    +++ (ddef (toHtml (show peer))))) --    +++
+--                              ((define (toHtml "body")    +++ (ddef (toHtml (show body')))))
hunk ./src/Happstack/Server/Extra.hs 66
-withURI :: (URI -> WebT m a) -> ServerPartT m a
+withURI :: (ServerMonad m) => (URI -> m a) -> m a
hunk ./src/Happstack/Server/Extra.hs 68
-    withRequest (f . fromJust . parseRelativeReference . rqURL)
+    do rq <- askRq
+       (f . fromJust . parseRelativeReference . rqURL) $ rq
hunk ./src/Happstack/Server/Extra.hs 88
-lookPairsPacked :: RqData [(String, U.ByteString)]
-lookPairsPacked = asks fst >>= return . map (\ (n,vbs) -> (n, inputValue vbs))
+lookPairsPacked :: RqData [(String, Either FilePath U.ByteString)]
+lookPairsPacked =
+    do (query, body, _cookies) <- askRqEnv
+       return $ map (\(n,vbs)->(n, inputValue vbs)) (query ++ body)
hunk ./src/Happstack/Server/Extra.hs 95
-lookPairsUnicode :: RqData [(String,String)]
-lookPairsUnicode = 
-    asks fst >>= return . map (\ (n,vbs) -> (n, utf8ToUnicode (inputValue vbs)))
+lookPairsUnicode :: RqData [(String, Either FilePath String)]
+lookPairsUnicode = lookPairs
+{-# DEPRECATED lookPairsUnicode "just use lookPairs" #-}
hunk ./src/Happstack/Server/Extra.hs 107
-
-instance (ServerMonad m) => ServerMonad (XMLGenT m) where
-    askRq   = XMLGenT askRq
-    localRq f (XMLGenT m) = XMLGenT (localRq f m)
-
-instance (FilterMonad a m) => FilterMonad a (XMLGenT m) where
-    setFilter = XMLGenT . setFilter
-    composeFilter f = XMLGenT (composeFilter f)
-    getFilter (XMLGenT m) = XMLGenT (getFilter m)
-
-instance (WebMonad a m) => WebMonad a (XMLGenT m) where
-    finishWith r = XMLGenT $ finishWith r
hunk ./src/Happstack/Server/Formlets.hs 18
+import Data.Maybe (fromMaybe)
hunk ./src/Happstack/Server/Formlets.hs 22
-import Happstack.Server.Extra ()
+import Happstack.Server.HSX()
hunk ./src/Happstack/Server/Formlets.hs 33
-handleForm :: forall a. forall xml1. forall xml2. forall m. forall r. (Monad m) =>
+handleForm :: (Monad m, ServerMonad m, FilterMonad Response m, MonadPlus m, MonadIO m, HasRqData m) =>
hunk ./src/Happstack/Server/Formlets.hs 37
-           -> (a -> WebT m r) -- ^ function which handles POSTed results that successfully validate
+           -> (a -> ServerPartT m r) -- ^ function which handles POSTed results that successfully validate
hunk ./src/Happstack/Server/Formlets.hs 42
-    , withDataFn lookPairs $ \env' ->
-        methodSP POST $ anyRequest $
-                 do let env = map (second Left) env'
-                        (extractor, _, _) = runFormState env frm                        
+    , withDataFn lookEnv $ \env ->
+        methodSP POST $
+                 do let (extractor, _, _) = runFormState env frm                        
hunk ./src/Happstack/Server/Formlets.hs 62
-withDatumSP :: (Show a, QueryEvent ev (Maybe t), MonadIO m, MonadPlus m, ServerMonad m,  FilterMonad Response m) =>
+withDatumSP :: (Show a, QueryEvent ev (Maybe t), MonadIO m, MonadPlus m, ServerMonad m,  FilterMonad Response m, HasRqData m) =>
hunk ./src/Happstack/Server/Formlets.hs 73
-  (EmbedAsChild m xml, EmbedAsAttr m (Attr String String), Functor m, MonadIO m, ToMessage b, FilterMonad Response m, WebMonad Response m, MonadPlus m, ServerMonad m) 
+  (EmbedAsChild m xml, EmbedAsAttr m (Attr String String), Functor m, MonadIO m, ToMessage b, FilterMonad Response m, WebMonad Response m, MonadPlus m, ServerMonad m, HasRqData m) 
hunk ./src/Happstack/Server/Formlets.hs 80
-        withDataFn lookEnv $ \env ->
+    do withDataFn lookEnv $ \env ->
hunk ./src/Happstack/Server/Formlets.hs 98
-    do formData <- asks fst
+    do (query,body,_) <- askRqEnv
hunk ./src/Happstack/Server/Formlets.hs 100
-                case inputFilename value of
-                  Nothing         -> (name, Left $ LU.toString $ inputValue value)
-                  (Just fileName) -> (name, Right $ (File { content = inputValue value
-                                                          , fileName = fileName
-                                                          , F.contentType = F.ContentType { F.ctType       = Happstack.ctType       (inputContentType value)
-                                                                                          , F.ctSubtype    = Happstack.ctSubtype    (inputContentType value)
-                                                                                          , F.ctParameters = Happstack.ctParameters (inputContentType value)
-                                                                                          }
-                                                          }))
-
-                    ) formData
+                     case inputValue value of
+                       (Left fileContentsPath) ->
+                           (name, Right $ (File { content       = LU.fromString $ fileContentsPath -- this is not really correct, it is expecting the contents of the file not the path to the saved contents. Though perhaps this is better
+                                                , fileName      = fromMaybe "" (inputFilename value)
+                                                , F.contentType = F.ContentType { F.ctType       = Happstack.ctType       (inputContentType value)
+                                                                                , F.ctSubtype    = Happstack.ctSubtype    (inputContentType value)
+                                                                                , F.ctParameters = Happstack.ctParameters (inputContentType value)
+                                                                                }
+                                                }))
+                       (Right contents) ->
+                           (name, Left $ LU.toString contents)) (query ++ body)
hunk ./src/Happstack/Server/Session.hs 34
-import Happstack.Server (ServerMonad, withDataFn, readCookieValue)
+import Happstack.Server (ServerMonad, HasRqData, withDataFn, readCookieValue)
hunk ./src/Happstack/Server/Session.hs 95
-withSessionId :: (MonadPlus m, ServerMonad m) => (SessionId -> m a) -> m a
+withSessionId :: (MonadPlus m, ServerMonad m, HasRqData m, MonadIO m) => (SessionId -> m a) -> m a
hunk ./src/Happstack/Server/Session.hs 114
-withSessionDataSP :: (Ord a, Serialize a, Data a, MonadIO m, ServerMonad m, MonadPlus m) => (a -> m r) -> m r
+withSessionDataSP :: (Ord a, Serialize a, Data a, MonadIO m, ServerMonad m, MonadPlus m, HasRqData m) => (a -> m r) -> m r
hunk ./src/Happstack/Server/Session.hs 117
-withMSessionId :: (ServerMonad m, MonadPlus m) => (Maybe SessionId -> m r) -> m r
+withMSessionId :: (ServerMonad m, MonadPlus m, HasRqData m, MonadIO m) => (Maybe SessionId -> m r) -> m r
hunk ./src/Happstack/Server/Session.hs 137
-withMSessionDataSP :: (Ord a, Serialize a, Data a, MonadIO m, ServerMonad m, MonadPlus m) => (Maybe a -> m r) -> m r
+withMSessionDataSP :: (Ord a, Serialize a, Data a, MonadIO m, ServerMonad m, MonadPlus m, HasRqData m) => (Maybe a -> m r) -> m r