diff --git a/happstack-server.cabal b/happstack-server.cabal --- a/happstack-server.cabal +++ b/happstack-server.cabal @@ -1,5 +1,5 @@ Name: happstack-server -Version: 7.4.2 +Version: 7.4.3 Synopsis: Web related tools and services. Description: Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course License: BSD3 diff --git a/src/Happstack/Server/FileServe/BuildingBlocks.hs b/src/Happstack/Server/FileServe/BuildingBlocks.hs --- a/src/Happstack/Server/FileServe/BuildingBlocks.hs +++ b/src/Happstack/Server/FileServe/BuildingBlocks.hs @@ -65,7 +65,6 @@ import Data.Maybe (fromMaybe) import Data.Map (Map) import qualified Data.Map as Map -import Data.Time (UTCTime, formatTime) import Data.Time.Compat (toUTCTime) import Filesystem.Path.CurrentOS (commonPrefix, encodeString, decodeString, collapse, append) import Happstack.Server.Monads (ServerMonad(askRq), FilterMonad, WebMonad) @@ -74,11 +73,17 @@ import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents, getModificationTime) import System.FilePath ((), addTrailingPathSeparator, hasDrive, isPathSeparator, joinPath, takeExtension, isValid) import System.IO (IOMode(ReadMode), hFileSize, hClose, openBinaryFile, withBinaryFile) -import System.Locale (defaultTimeLocale) import System.Log.Logger (Priority(DEBUG), logM) import Text.Blaze.Html ((!)) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A + +#if MIN_VERSION_time(1,5,0) +import Data.Time (UTCTime, formatTime, defaultTimeLocale) +#else +import System.Locale (defaultTimeLocale) +import Data.Time (UTCTime, formatTime) +#endif -- * Mime-Type / Content-Type diff --git a/src/Happstack/Server/Internal/Clock.hs b/src/Happstack/Server/Internal/Clock.hs --- a/src/Happstack/Server/Internal/Clock.hs +++ b/src/Happstack/Server/Internal/Clock.hs @@ -12,9 +12,14 @@ import Data.IORef import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixSecondsToUTCTime) -import Data.Time.Format (formatTime) import System.IO.Unsafe -import System.Locale + +#if MIN_VERSION_time(1,5,0) +import Data.Time.Format (formatTime, defaultTimeLocale) +#else +import Data.Time.Format (formatTime) +import System.Locale (defaultTimeLocale) +#endif import qualified Data.ByteString.Char8 as B diff --git a/src/Happstack/Server/Internal/Cookie.hs b/src/Happstack/Server/Internal/Cookie.hs --- a/src/Happstack/Server/Internal/Cookie.hs +++ b/src/Happstack/Server/Internal/Cookie.hs @@ -23,10 +23,15 @@ import Data.List ((\\), intersperse) import Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Data.Time.Format (formatTime) import Happstack.Server.Internal.Clock (getApproximateUTCTime) import Text.ParserCombinators.Parsec hiding (token) -import System.Locale (defaultTimeLocale) + +#if MIN_VERSION_time(1,5,0) +import Data.Time.Format (formatTime, defaultTimeLocale) +#else +import Data.Time.Format (formatTime) +import System.Locale (defaultTimeLocale) +#endif -- | a type for HTTP cookies. Usually created using 'mkCookie'. data Cookie = Cookie diff --git a/src/Happstack/Server/Internal/LogFormat.hs b/src/Happstack/Server/Internal/LogFormat.hs --- a/src/Happstack/Server/Internal/LogFormat.hs +++ b/src/Happstack/Server/Internal/LogFormat.hs @@ -3,8 +3,12 @@ , formatRequestCombined ) where -import System.Locale (defaultTimeLocale) +#if MIN_VERSION_time(1,5,0) +import Data.Time.Format (FormatTime(..), formatTime, defaultTimeLocale) +#else import Data.Time.Format (FormatTime(..), formatTime) +import System.Locale (defaultTimeLocale) +#endif -- | Format the time as describe in the Apache combined log format. -- http://httpd.apache.org/docs/2.2/logs.html#combined diff --git a/src/Happstack/Server/Internal/Monads.hs b/src/Happstack/Server/Internal/Monads.hs --- a/src/Happstack/Server/Internal/Monads.hs +++ b/src/Happstack/Server/Internal/Monads.hs @@ -173,7 +173,7 @@ instance MonadTrans (ServerPartT) where lift m = withRequest (\_ -> lift m) -instance (Monad m) => Monoid (ServerPartT m a) where +instance (Monad m, MonadPlus m) => Monoid (ServerPartT m a) where mempty = mzero mappend = mplus @@ -486,7 +486,7 @@ instance MonadTrans WebT where lift = WebT . lift . lift . lift -instance (Monad m) => MonadPlus (WebT m) where +instance (Monad m, MonadPlus m) => MonadPlus (WebT m) where -- | Aborts a computation. -- -- This is primarily useful because 'msum' will take an array of @@ -505,7 +505,7 @@ lft (Left r, _) = Left r lft (Right a, f) = Right (a, f) -instance (Monad m) => Monoid (WebT m a) where +instance (Monad m, MonadPlus m) => Monoid (WebT m a) where mempty = mzero mappend = mplus @@ -561,7 +561,7 @@ liftWebT (Just (Right x,f)) = pass (return x)>>= (\a -> return $ Just (Right a,f)) -- | Deprecated: use 'msum'. -multi :: Monad m => [ServerPartT m a] -> ServerPartT m a +multi :: (Monad m, MonadPlus m) => [ServerPartT m a] -> ServerPartT m a multi = msum {-# DEPRECATED multi "Use msum instead" #-} diff --git a/src/Happstack/Server/Response.hs b/src/Happstack/Server/Response.hs --- a/src/Happstack/Server/Response.hs +++ b/src/Happstack/Server/Response.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances, ScopedTypeVariables #-} -- | Functions and classes related to generating a 'Response' and setting the response code. For detailed instruction see the Happstack Crash Course: -module Happstack.Server.Response +module Happstack.Server.Response ( -- * Converting values to a 'Response' ToMessage(..) , flatten @@ -34,24 +34,29 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT -import Data.Time (UTCTime, formatTime) import Happstack.Server.Internal.Monads (FilterMonad(composeFilter)) import Happstack.Server.Types (Response(..), Request(..), nullRsFlags, getHeader, noContentLength, redirect, result, setHeader, setHeaderBS) import Happstack.Server.SURI (ToSURI) -import System.Locale (defaultTimeLocale) import qualified Text.Blaze.Html as Blaze import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze import Text.Html (Html, renderHtml) import qualified Text.XHtml as XHtml (Html, renderHtml) +#if MIN_VERSION_time(1,5,0) +import Data.Time (UTCTime, formatTime, defaultTimeLocale) +#else +import Data.Time (UTCTime, formatTime) +import System.Locale (defaultTimeLocale) +#endif + -- | A low-level function to build a 'Response' from a content-type -- and a 'ByteString'. -- -- Creates a 'Response' in a manner similar to the 'ToMessage' class, -- but without requiring an instance declaration. --- +-- -- example: --- +-- -- > import Data.ByteString.Char8 as C -- > import Data.ByteString.Lazy.Char8 as L -- > import Happstack.Server @@ -85,7 +90,7 @@ -- -- > main = serve Nothing $ toResponse "hello, world!" -- --- Minimal definition: 'toMessage' (and usually 'toContentType'). +-- Minimal definition: 'toMessage' (and usually 'toContentType'). class ToMessage a where toContentType :: a -> B.ByteString toContentType _ = B.pack "text/plain" @@ -194,31 +199,31 @@ -- -- A filter for setting the response code. Generally you will use a -- helper function like 'ok' or 'seeOther'. --- +-- -- > main = simpleHTTP nullConf $ do setResponseCode 200 -- > return "Everything is OK" --- +-- -- see also: 'resp' -setResponseCode :: FilterMonad Response m => +setResponseCode :: FilterMonad Response m => Int -- ^ response code -> m () setResponseCode code = composeFilter $ \r -> r{rsCode = code} -- | Same as @'setResponseCode' status >> return val@. --- +-- -- Use this if you want to set a response code that does not already --- have a helper function. --- +-- have a helper function. +-- -- > main = simpleHTTP nullConf $ resp 200 "Everything is OK" -resp :: (FilterMonad Response m) => +resp :: (FilterMonad Response m) => Int -- ^ response code -> b -- ^ value to return -> m b resp status val = setResponseCode status >> return val -- | Respond with @200 OK@. --- +-- -- > main = simpleHTTP nullConf $ ok "Everything is OK" ok :: (FilterMonad Response m) => a -> m a ok = resp 200 @@ -239,7 +244,7 @@ return res -- | Respond with @302 Found@. --- +-- -- You probably want 'seeOther'. This method is not in popular use anymore, and is generally treated like 303 by most user-agents anyway. found :: (FilterMonad Response m, ToSURI uri) => uri -> res -> m res found uri res = do modifyResponse $ redirect 302 uri @@ -284,7 +289,7 @@ forbidden = resp 403 -- | Respond with @404 Not Found@. --- +-- -- > main = simpleHTTP nullConf $ notFound "What you are looking for has not been found." notFound :: (FilterMonad Response m) => a -> m a notFound = resp 404 @@ -324,4 +329,4 @@ showString "\nrsValidator = " . shows (rsValidator res). showString "\nsfFilePath = " . shows (sfFilePath res) . showString "\nsfOffset = " . shows (sfOffset res) . - showString "\nsfCount = " $ show (sfCount res) + showString "\nsfCount = " $ show (sfCount res) diff --git a/src/Happstack/Server/RqData.hs b/src/Happstack/Server/RqData.hs --- a/src/Happstack/Server/RqData.hs +++ b/src/Happstack/Server/RqData.hs @@ -92,7 +92,7 @@ newtype ReaderError r e a = ReaderError { unReaderError :: ReaderT r (Either e) a } deriving (Functor, Monad, MonadPlus) -instance (Error e) => MonadReader r (ReaderError r e) where +instance (Error e, Monoid e) => MonadReader r (ReaderError r e) where ask = ReaderError ask local f m = ReaderError $ local f (unReaderError m) @@ -157,7 +157,7 @@ rqDataError e = mapRqData ((Left e) `apEither`) (return ()) -- instance (MonadPlus m, MonadIO m, ServerMonad m) => (HasRqData m) where -instance (MonadIO m) => HasRqData (ServerPartT m) where +instance (MonadIO m, MonadPlus m) => HasRqData (ServerPartT m) where askRqEnv = do rq <- askRq mbi <- liftIO $ if ((rqMethod rq == POST) || (rqMethod rq == PUT)) && (isDecodable (ctype rq))