diff --git a/Network/CGI/Cookie.hs b/Network/CGI/Cookie.hs --- a/Network/CGI/Cookie.hs +++ b/Network/CGI/Cookie.hs @@ -29,9 +29,9 @@ import Data.Char (isSpace) import Data.List (intersperse) import Data.Maybe (catMaybes) -import System.Locale (defaultTimeLocale, rfc822DateFormat) -import System.Time (CalendarTime(..), Month(..), Day(..), - formatCalendarTime) +import Data.Time.Calendar (Day(..)) +import Data.Time.Clock (UTCTime(..)) +import Data.Time.Format (defaultTimeLocale, formatTime, rfc822DateFormat) -- -- * Types @@ -47,7 +47,7 @@ -- cookie expires when the browser sessions ends. -- If the date is in the past, the client should -- delete the cookie immediately. - cookieExpires :: Maybe CalendarTime, + cookieExpires :: Maybe UTCTime, -- | The domain suffix to which this cookie will be sent. cookieDomain :: Maybe String, -- | The path to which this cookie will be sent. @@ -96,20 +96,7 @@ -> Cookie deleteCookie c = c { cookieExpires = Just epoch } where - epoch = CalendarTime { - ctYear = 1970, - ctMonth = January, - ctDay = 1, - ctHour = 0, - ctMin = 0, - ctSec = 0, - ctPicosec = 0, - ctWDay = Thursday, - ctYDay = 1, - ctTZName = "GMT", - ctTZ = 0, - ctIsDST = False - } + epoch = UTCTime (ModifiedJulianDay 40587) 0 -- -- * Reading and showing cookies @@ -124,7 +111,7 @@ domain = fmap (showPair "domain") (cookieDomain c) path = fmap (showPair "path") (cookiePath c) secure = if cookieSecure c then Just "secure" else Nothing - dateFmt = formatCalendarTime defaultTimeLocale rfc822DateFormat + dateFmt = formatTime defaultTimeLocale rfc822DateFormat -- | Show a name-value pair. FIXME: if the name or value -- contains semicolons, this breaks. The problem diff --git a/Network/CGI/Monad.hs b/Network/CGI/Monad.hs --- a/Network/CGI/Monad.hs +++ b/Network/CGI/Monad.hs @@ -65,10 +65,10 @@ [typeOf1 (undefined :: m a), typeOf (undefined :: a)] #endif -instance (Functor m, Monad m) => Functor (CGIT m) where +instance (Functor m) => Functor (CGIT m) where fmap f c = CGIT (fmap f (unCGIT c)) -instance (Applicative m, Monad m) => Applicative (CGIT m) where +instance (Applicative m) => Applicative (CGIT m) where pure = CGIT . pure f <*> x = CGIT (unCGIT f <*> unCGIT x) diff --git a/Network/CGI/Protocol.hs b/Network/CGI/Protocol.hs --- a/Network/CGI/Protocol.hs +++ b/Network/CGI/Protocol.hs @@ -33,11 +33,12 @@ ) where import Control.Monad.Trans (MonadIO(..)) +import Data.Char (chr, isHexDigit, digitToInt) import Data.List (intersperse) import qualified Data.Map as Map import Data.Map (Map) import Data.Maybe (fromMaybe, listToMaybe, isJust) -import Network.URI (unEscapeString,escapeURIString,isUnescapedInURI) +import Network.URI (escapeURIString,isUnescapedInURI) import System.Environment (getEnvironment) import System.IO (Handle, hPutStrLn, stderr, hFlush, hSetBinaryMode) @@ -175,7 +176,7 @@ -- | The default content-type for variables. defaultInputType :: ContentType -defaultInputType = ContentType "text" "plain" [] -- FIXME: use some default encoding? +defaultInputType = ContentType "text" "plain" [("charset","windows-1252")] -- -- * Environment variables @@ -236,6 +237,16 @@ -- application\/x-www-form-urlencoded encoding. urlDecode :: String -> String urlDecode = unEscapeString . replace '+' ' ' + +-- | Unescape a percent-encoded string, but doesn't decode UTF-8 encoding. +-- +-- >>> unEscapeString "Hell%C3%B3 w%C3%B3rld" +-- "Hell\195\179 w\195\179rld" +unEscapeString :: String -> String +unEscapeString [] = "" +unEscapeString ('%':x1:x2:s) | isHexDigit x1 && isHexDigit x2 = + chr (digitToInt x1 * 16 + digitToInt x2) : unEscapeString s +unEscapeString (c:s) = c : unEscapeString s -- -- * Request content and form-data stuff diff --git a/cgi.cabal b/cgi.cabal --- a/cgi.cabal +++ b/cgi.cabal @@ -1,5 +1,5 @@ Name: cgi -Version: 3001.2.2.3 +Version: 3001.3.0.0 Copyright: Bjorn Bringert, John Chee, Andy Gill, Anders Kaseorg, Ian Lynagh, Erik Meijer, Sven Panne, Jeremy Shaw Category: Network @@ -14,7 +14,7 @@ This is a Haskell library for writing CGI programs. Build-Type: Simple extra-source-files: changelog -Cabal-Version: >=1.6 +Cabal-Version: >=1.8 source-repository head type: git @@ -48,8 +48,7 @@ xhtml >= 3000.0.0 && < 3000.3, bytestring < 0.11, base >= 4.5 && < 5, - old-time < 1.2, - old-locale < 1.1, + time >= 1.5 && < 1.7, containers < 0.6, multipart >= 0.1.2 && < 0.2 If flag(network-uri) @@ -62,6 +61,19 @@ Else Build-depends: mtl>=2.2.1 && < 2.3 + +test-suite doctests + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: DocTestMain.hs + other-modules: + DocTest + hs-source-dirs: src + ghc-options: -Wall + build-depends: + base + , doctest >= 0.8 && < 0.11 + , QuickCheck >= 2.8.1 && < 2.9 --Executable: printinput --Main-Is: printinput.hs diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,27 +1,39 @@ -3001.2.2.3 +# Change Log +All notable changes to this project will be documented in this file. +This project adheres to the [Package Versiioning Policy](https://wiki.haskell.org/Package_versioning_policy). +## 3001.3.0.0 ### Changed -* CGI.hs haddock: Use web.archive.org link for CGI specification +- Cookie.hs: cookieExpires now has type `Maybe UTCTime` rather than +`Maybe CalendarTime` +- Protocol.hs: URL decoding functions no longer decode UTF-8 encoding +- Functor and Applicative instance of CGIT no longer constrain Functor or +Applicative parameter to be an instance of Monad -3001.2.2.2 +## 3001.2.2.3 ### Changed -* Added support for building with mtl < 2.2.1 via flags - -3001.2.2.1 +* CGI.hs haddock: Use web.archive.org link for CGI specification +## 3001.2.2.2 ### Changed -* Bumped exceptions version to < 0.9 - -3001.2.2.0 +- Added support for building with mtl < 2.2.1 via flags -* MonadMask instance for CGIT +## 3001.2.2.1 +### Changed +- Bumped exceptions version to < 0.9 -3001.2.1.0 +## 3001.2.2.0 +### Added +- MonadMask instance for CGIT -* Applicative instance for CGI Monad -* Deduplicate shared with `multipart` code +## 3001.2.1.0 +### Added +- Applicative instance for CGI Monad -3001.2.0.0 +### Changed +- Deduplicate shared with `multipart` code -* GHC 7.8.3 support +## 3001.2.0.0 +### Changed +- GHC 7.8.3 support diff --git a/src/DocTest.hs b/src/DocTest.hs new file mode 100644 --- /dev/null +++ b/src/DocTest.hs @@ -0,0 +1,7 @@ +module DocTest ( + test + ) where +import Test.DocTest + +test :: IO () +test = doctest ["-iNetwork", "Network/CGI/Protocol.hs"] diff --git a/src/DocTestMain.hs b/src/DocTestMain.hs new file mode 100644 --- /dev/null +++ b/src/DocTestMain.hs @@ -0,0 +1,8 @@ +module Main ( + main + ) where + +import qualified DocTest + +main :: IO () +main = DocTest.test