[ghc-happstack-server] patch for newer time lib in ghc-7.6
Jens Petersen
petersen at fedoraproject.org
Thu Jun 13 05:14:05 UTC 2013
commit f78665229ca3e05b94b076d93cfaae1f778b6d9d
Author: Jens Petersen <petersen at redhat.com>
Date: Thu Jun 13 14:13:43 2013 +0900
patch for newer time lib in ghc-7.6
ghc-happstack-server.spec | 3 +
happstack-server-7.0-ghc76-time.patch | 159 +++++++++++++++++++++++++++++++++
2 files changed, 162 insertions(+), 0 deletions(-)
---
diff --git a/ghc-happstack-server.spec b/ghc-happstack-server.spec
index e2df659..1867fb6 100644
--- a/ghc-happstack-server.spec
+++ b/ghc-happstack-server.spec
@@ -12,6 +12,7 @@ URL: http://hackage.haskell.org/package/%{pkg_name}
Source0: http://hackage.haskell.org/packages/archive/%{pkg_name}/%{version}/%{pkg_name}-%{version}.tar.gz
Patch1: happstack-server-default-to-base4.patch
Patch2: happstack-server-7.0.0-blaze-html.patch
+Patch3: happstack-server-7.0-ghc76-time.patch
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-rpm-macros
@@ -70,6 +71,7 @@ This package provides the Haskell %{pkg_name} library development files.
%setup -q -n %{pkg_name}-%{version}
%patch1 -p1 -b .1-orig~
%patch2 -p1 -b .2-blaze~
+%patch3 -p1 -b .3-time~
cabal-tweak-dep-ver base64-bytestring "== 0.1.*" "== 1.*"
cabal-tweak-dep-ver blaze-html "< 0.6" "< 0.7"
@@ -103,6 +105,7 @@ cabal-tweak-dep-ver transformers "< 0.3" "< 0.4"
%changelog
* Fri Jun 07 2013 Jens Petersen <petersen at redhat.com> - 7.0.0-9
- update to new simplified Haskell Packaging Guidelines
+- patch for newer time lib in ghc-7.6
* Tue Mar 19 2013 Jens Petersen <petersen at redhat.com> - 7.0.0-8
- allow blaze-html-0.6
diff --git a/happstack-server-7.0-ghc76-time.patch b/happstack-server-7.0-ghc76-time.patch
new file mode 100644
index 0000000..a840146
--- /dev/null
+++ b/happstack-server-7.0-ghc76-time.patch
@@ -0,0 +1,159 @@
+diff a/happstack-server.cabal b/happstack-server.cabal
+--- a/happstack-server.cabal
++++ b/happstack-server.cabal
+@@ -90,7 +90,6 @@
+ monad-control >= 0.3 && < 0.4,
+ mtl >= 2 && < 2.1,
+ old-locale,
+- old-time,
+ parsec < 4,
+ process,
+ sendfile >= 0.7.1 && < 0.8,
+--- a/src/Happstack/Server/FileServe/BuildingBlocks.hs
++++ b/src/Happstack/Server/FileServe/BuildingBlocks.hs
+@@ -54,6 +54,7 @@ module Happstack.Server.FileServe.BuildingBlocks
+ isDot
+ ) where
+
++import Control.Applicative ((<$>))
+ import Control.Exception.Extensible (IOException, bracket, catch)
+ import Control.Monad (MonadPlus(mzero), msum)
+ import Control.Monad.Trans (MonadIO(liftIO))
+@@ -62,6 +62,7 @@
+ import Data.Maybe (fromMaybe)
+ import Data.Map (Map)
+ import qualified Data.Map as Map
++import Data.Time (UTCTime, formatTime)
+ import Happstack.Server.Monads (ServerMonad(askRq), FilterMonad, WebMonad)
+ import Happstack.Server.Response (ToMessage(toResponse), ifModifiedSince, forbidden, ok, seeOther)
+ import Happstack.Server.Types (Length(ContentLength), Request(rqPaths, rqUri), Response(SendFile), RsFlags(rsfLength), nullRsFlags, result, resultBS, setHeader)
+@@ -71,7 +72,6 @@
+ import System.IO (IOMode(ReadMode), hFileSize, hClose, openBinaryFile, withBinaryFile)
+ import System.Locale (defaultTimeLocale)
+ import System.Log.Logger (Priority(DEBUG), logM)
+-import System.Time (CalendarTime, formatCalendarTime, toCalendarTime, toUTCTime)
+ import Text.Blaze ((!))
+ import qualified Text.Blaze.Html5 as H
+ import qualified Text.Blaze.Html5.Attributes as A
+@@ -157,7 +158,7 @@ isDot = isD . reverse
+ -- | Use sendFile to send the contents of a Handle
+ sendFileResponse :: String -- ^ content-type string
+ -> FilePath -- ^ file path for content to send
+- -> Maybe (CalendarTime, Request) -- ^ mod-time for the handle (MUST NOT be later than server's time of message origination), incoming request (used to check for if-modified-since header)
++ -> Maybe (UTCTime, Request) -- ^ mod-time for the handle (MUST NOT be later than server's time of message origination), incoming request (used to check for if-modified-since header)
+ -> Integer -- ^ offset into Handle
+ -> Integer -- ^ number of bytes to send
+ -> Response
+@@ -173,7 +174,7 @@ sendFileResponse ct filePath mModTime offset count =
+ --
+ lazyByteStringResponse :: String -- ^ content-type string (e.g. @\"text/plain; charset=utf-8\"@)
+ -> L.ByteString -- ^ lazy bytestring content to send
+- -> Maybe (CalendarTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)
++ -> Maybe (UTCTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)
+ -> Integer -- ^ offset into the bytestring
+ -> Integer -- ^ number of bytes to send (offset + count must be less than or equal to the length of the bytestring)
+ -> Response
+@@ -188,7 +189,7 @@ lazyByteStringResponse ct body mModTime offset count =
+ -- | Send the contents of a Lazy ByteString
+ strictByteStringResponse :: String -- ^ content-type string (e.g. @\"text/plain; charset=utf-8\"@)
+ -> S.ByteString -- ^ lazy bytestring content to send
+- -> Maybe (CalendarTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)
++ -> Maybe (UTCTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)
+ -> Integer -- ^ offset into the bytestring
+ -> Integer -- ^ number of bytes to send (offset + count must be less than or equal to the length of the bytestring)
+ -> Response
+@@ -213,7 +214,7 @@ filePathSendFile contentType fp =
+ do count <- liftIO $ withBinaryFile fp ReadMode hFileSize -- garbage collection should close this
+ modtime <- liftIO $ getModificationTime fp
+ rq <- askRq
+- return $ sendFileResponse contentType fp (Just (toUTCTime modtime, rq)) 0 count
++ return $ sendFileResponse contentType fp (Just (modtime, rq)) 0 count
+
+ -- | Send the specified file with the specified mime-type using lazy ByteStrings
+ --
+@@ -230,7 +231,7 @@ filePathLazy contentType fp =
+ modtime <- liftIO $ getModificationTime fp
+ count <- liftIO $ hFileSize handle
+ rq <- askRq
+- return $ lazyByteStringResponse contentType contents (Just (toUTCTime modtime, rq)) 0 count
++ return $ lazyByteStringResponse contentType contents (Just (modtime, rq)) 0 count
+
+ -- | Send the specified file with the specified mime-type using strict ByteStrings
+ --
+@@ -246,7 +247,7 @@ filePathStrict contentType fp =
+ modtime <- liftIO $ getModificationTime fp
+ count <- liftIO $ withBinaryFile fp ReadMode hFileSize
+ rq <- askRq
+- return $ strictByteStringResponse contentType contents (Just (toUTCTime modtime, rq)) 0 count
++ return $ strictByteStringResponse contentType contents (Just (modtime, rq)) 0 count
+
+ -- * High-level functions for serving files
+
+@@ -566,7 +567,7 @@ renderDirectoryContents localPath fps =
+ -- a new page template to wrap around this HTML.
+ --
+ -- see also: 'getMetaData', 'renderDirectoryContents'
+-renderDirectoryContentsTable :: [(FilePath, Maybe CalendarTime, Maybe Integer, EntryKind)] -- ^ list of files+meta data, see 'getMetaData'
++renderDirectoryContentsTable :: [(FilePath, Maybe UTCTime, Maybe Integer, EntryKind)] -- ^ list of files+meta data, see 'getMetaData'
+ -> H.Html
+ renderDirectoryContentsTable fps =
+ H.table $ do H.thead $ do H.th $ H.toHtml ""
+@@ -538,13 +538,13 @@
+ H.th $ H.toHtml "Size"
+ H.tbody $ mapM_ mkRow (zip fps $ cycle [False, True])
+ where
+- mkRow :: ((FilePath, Maybe CalendarTime, Maybe Integer, EntryKind), Bool) -> H.Html
++ mkRow :: ((FilePath, Maybe UTCTime, Maybe Integer, EntryKind), Bool) -> H.Html
+ mkRow ((fp, modTime, count, kind), alt) =
+ (if alt then (! A.class_ (H.toValue "alt")) else id) $
+ H.tr $ do
+ H.td (mkKind kind)
+ H.td (H.a ! A.href (H.toValue fp) $ H.toHtml fp)
+- H.td ! A.class_ (H.toValue "date") $ (H.toHtml $ maybe "-" (formatCalendarTime defaultTimeLocale "%d-%b-%Y %X %Z") modTime)
++ H.td ! A.class_ (H.toValue "date") $ (H.toHtml $ maybe "-" (formatTime defaultTimeLocale "%d-%b-%Y %X %Z") modTime)
+ (maybe id (\c -> (! A.title (H.toValue (show c)))) count) (H.td ! A.class_ (H.toValue "size") $ (H.toHtml $ maybe "-" prettyShow count))
+ mkKind :: EntryKind -> H.Html
+ mkKind File = return ()
+@@ -568,10 +568,10 @@
+ -- | look up the meta data associated with a file
+ getMetaData :: FilePath -- ^ path to directory on disk containing the entry
+ -> FilePath -- ^ entry in that directory
+- -> IO (FilePath, Maybe CalendarTime, Maybe Integer, EntryKind)
++ -> IO (FilePath, Maybe UTCTime, Maybe Integer, EntryKind)
+ getMetaData localPath fp =
+ do let localFp = localPath </> fp
+- modTime <- (fmap Just . toCalendarTime =<< getModificationTime localFp) `catch`
++ modTime <- (fmap Just <$> getModificationTime localFp) `catch`
+ (\(_ :: IOException) -> return Nothing)
+ count <- do de <- doesDirectoryExist localFp
+ if de
+--- a/src/Happstack/Server/Response.hs
++++ b/src/Happstack/Server/Response.hs
+@@ -34,11 +34,11 @@
+ 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 System.Time (CalendarTime, formatCalendarTime)
+ import qualified Text.Blaze.Html as Blaze
+ import qualified Text.Blaze.Renderer.Utf8 as Blaze
+ import Text.Html (Html, renderHtml)
+@@ -174,12 +174,12 @@ flatten = fmap toResponse
+ -- If the 'Request' includes the @if-modified-since@ header and the
+ -- 'Response' has not been modified, then return 304 (Not Modified),
+ -- otherwise return the 'Response'.
+-ifModifiedSince :: CalendarTime -- ^ mod-time for the 'Response' (MUST NOT be later than server's time of message origination)
++ifModifiedSince :: UTCTime -- ^ mod-time for the 'Response' (MUST NOT be later than server's time of message origination)
+ -> Request -- ^ incoming request (used to check for if-modified-since)
+ -> Response -- ^ Response to send if there are modifications
+ -> Response
+ ifModifiedSince modTime request response =
+- let repr = formatCalendarTime defaultTimeLocale "%a, %d %b %Y %X GMT" modTime
++ let repr = formatTime defaultTimeLocale "%a, %d %b %Y %X GMT" modTime
+ notmodified = getHeader "if-modified-since" request == Just (B.pack $ repr)
+ in if notmodified
+ then noContentLength $ result 304 "" -- Not Modified
More information about the scm-commits
mailing list