diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for urlencoded + +## 0.5.0.0 -- 2021-07-11 + +* Switch from MonadError to MonadFail diff --git a/src/Data/URLEncoded.hs b/src/Data/URLEncoded.hs --- a/src/Data/URLEncoded.hs +++ b/src/Data/URLEncoded.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, CPP #-} -- |Implements a data type for constructing and destructing -- x-www-urlencoded strings. See -- @@ -38,18 +38,24 @@ import qualified Prelude import Prelude hiding ( null, lookup, filter ) -import Data.List.Split ( unintercalate ) +import Data.List.Split ( splitOn ) import Control.Monad ( liftM ) import Control.Arrow ( (>>>) ) -import Control.Monad.Error ( MonadError ) import Network.URI ( unEscapeString, escapeURIString, isUnreserved, URI(uriQuery) ) import Data.Monoid ( Monoid, mappend ) +#if MIN_VERSION_base(4,9,0) +import Data.Semigroup ( Semigroup ) +#endif import Data.List ( intercalate ) import Data.Maybe ( fromMaybe ) -- | A container for URLEncoded data newtype URLEncoded = URLEncoded { pairs :: [(String, String)] } +#if MIN_VERSION_base(4,9,0) + deriving (Semigroup, Monoid, Eq) +#else deriving (Monoid, Eq) +#endif class AddURLEncoded a where (%?) :: URLEncode args => a -> args -> a @@ -166,9 +172,10 @@ showsPrec _ q = (export q ++) -- |Parse this string as x-www-urlencoded -importString :: MonadError e m => String -> m URLEncoded +-- @since 0.5.0.0 +importString :: MonadFail m => String -> m URLEncoded importString "" = return empty -importString s = liftM importList $ mapM parsePair $ unintercalate "&" s +importString s = liftM importList $ mapM parsePair $ splitOn "&" s where parsePair p = case break (== '=') p of (_, []) -> fail $ "Missing value in query string: " ++ show p @@ -176,9 +183,10 @@ , unesc v ) unknown -> error $ "impossible: " ++ show unknown - unesc = unEscapeString . intercalate "%20" . unintercalate "+" + unesc = unEscapeString . intercalate "%20" . splitOn "+" -importURI :: MonadError e m => URI -> m URLEncoded +-- | @since 0.5.0.0 +importURI :: MonadFail m => URI -> m URLEncoded importURI u = case uriQuery u of ('?':s) -> importString s [] -> return empty @@ -186,7 +194,8 @@ -- |Return the /first/ value for the given key, or throw an error if the -- key is not present in the URLEncoded data. -lookup1 :: (URLShow a, MonadError e m) => a -> URLEncoded -> m String +-- @since 0.5.0.0 +lookup1 :: (URLShow a, MonadFail m) => a -> URLEncoded -> m String lookup1 k = lookup k >>> maybe missing return where missing = fail $ "Key not found: " ++ urlShow k diff --git a/test/TestDriver.hs b/test/TestDriver.hs --- a/test/TestDriver.hs +++ b/test/TestDriver.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where -import Control.Monad ( liftM, replicateM, liftM2 ) +import Control.Monad ( liftM, replicateM ) import Data.Monoid ( mconcat ) import Data.Maybe ( isJust ) @@ -19,11 +19,9 @@ arbitrary = do numPairs <- sized $ \n -> choose (0, n) importList `liftM` replicateM numPairs (two arbitraryQueryArg) - coarbitrary = undefined -instance Applicative Gen where - (<*>) = liftM2 ($) - pure = return +two :: Gen b -> Gen (b, b) +two = fmap (\[x,y] -> (x,y)) . vectorOf 2 arbitraryQueryArg :: Gen String arbitraryQueryArg = do @@ -79,11 +77,11 @@ main :: IO () main = mapM_ quickCheck [ property $ \u -> - importString (export u) == (Right u :: Either String URLEncoded) + importString (export u) == (Just u :: Maybe URLEncoded) , property $ \u -> let s = export u - expected = Right s :: Either String String + expected = Just s in (export `liftM` importString s) == expected , property $ \u1 u2 -> @@ -124,7 +122,5 @@ , forAll (multiLists "repeated") $ \(_, u) -> length (lookupAll "repeated" u) > 0 - , property $ \u -> case lookup1 (badKey u) u :: Either String String of - Left _ -> True - Right _ -> False + , property $ \u -> lookup1 (badKey u) u == Nothing ] diff --git a/urlencoded.cabal b/urlencoded.cabal --- a/urlencoded.cabal +++ b/urlencoded.cabal @@ -1,6 +1,6 @@ name: urlencoded -Cabal-Version: >= 1.6 -version: 0.3.0.1 +Cabal-Version: 1.18 +version: 0.5.0.0 synopsis: Generate or process x-www-urlencoded data description: Generate or process x-www-urlencoded data as it @@ -8,36 +8,55 @@ category: Web -homepage: https://github.com/pheaver/urlencoded +homepage: https://github.com/fgaz/urlencoded stability: alpha license: BSD3 license-file: LICENSE author: Josh Hoyt, Philip Weaver -maintainer: philip.weaver@gmail.com -build-type: Custom +maintainer: Francesco Gazzetta +build-type: Simple +extra-doc-files: CHANGELOG.md +tested-with: GHC==9.0.1 + , GHC==8.10.4 + , GHC==8.8.4 -Flag Test - Description: Build the test executable - Default: False +source-repository head + type: git + location: git://github.com/fgaz/urlencoded.git +Flag network-uri + description: Get Network.URI from the network-uri package + default: True + Library - build-depends: base == 4.*, network >= 2.2 && < 4, mtl >= 1.1, split == 0.1.* + build-depends: base >= 4.13 && <4.16 + , mtl >= 1.1 && <2.3 + , split == 0.2.* + if flag(network-uri) + build-depends: network-uri >= 2.6 + , network >= 2.6 + else + build-depends: network-uri < 2.6 + , network < 2.6 && >= 2.2 ghc-options: -Wall hs-source-dirs: src exposed-modules: Data.URLEncoded - --- This executable is not installed by the (custom) Setup program. It is --- used by the test hook (cabal test) -Executable test - if flag(test) - Buildable: True - build-depends: - QuickCheck >= 1.2 && < 1.3 + default-language: Haskell2010 +Test-suite test + type: exitcode-stdio-1.0 + build-depends: base + , QuickCheck >= 2.11 && < 2.15 + , urlencoded + if flag(network-uri) + build-depends: network-uri >= 2.6 + , network >= 2.6 else - Buildable: False + build-depends: network-uri < 2.6 + , network < 2.6 && >= 2.2 GHC-Options: -Wall Main-is: TestDriver.hs - HS-Source-Dirs: src, test - X-Test-Executable: true + HS-Source-Dirs: test + default-language: Haskell2010 +