Hello community, here is the log from the commit of package ghc-http-api-data for openSUSE:Factory checked in at 2016-09-05 21:20:03 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-http-api-data (Old) and /work/SRC/openSUSE:Factory/.ghc-http-api-data.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-http-api-data" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-http-api-data/ghc-http-api-data.changes 2016-07-21 08:10:18.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-http-api-data.new/ghc-http-api-data.changes 2016-09-05 21:20:07.000000000 +0200 @@ -1,0 +2,5 @@ +Mon Jul 25 11:25:03 UTC 2016 - [email protected] + +- Update to version 0.2.4 revision 0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- http-api-data-0.2.3.tar.gz New: ---- http-api-data-0.2.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-http-api-data.spec ++++++ --- /var/tmp/diff_new_pack.ODIj10/_old 2016-09-05 21:20:09.000000000 +0200 +++ /var/tmp/diff_new_pack.ODIj10/_new 2016-09-05 21:20:09.000000000 +0200 @@ -19,15 +19,14 @@ %global pkg_name http-api-data %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.2.3 +Version: 0.2.4 Release: 0 Summary: Converting to/from HTTP API data like URL pieces, headers and query parameters License: BSD-2-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-bytestring-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel @@ -35,13 +34,13 @@ BuildRequires: ghc-time-locale-compat-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} -BuildRequires: ghc-Glob-devel BuildRequires: ghc-HUnit-devel BuildRequires: ghc-QuickCheck-devel +BuildRequires: ghc-directory-devel BuildRequires: ghc-doctest-devel +BuildRequires: ghc-filepath-devel BuildRequires: ghc-hspec-devel %endif -# End cabal-rpm deps %description Please see README.md. @@ -60,20 +59,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ http-api-data-0.2.3.tar.gz -> http-api-data-0.2.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.2.3/CHANGELOG.md new/http-api-data-0.2.4/CHANGELOG.md --- old/http-api-data-0.2.3/CHANGELOG.md 2016-06-10 02:17:37.000000000 +0200 +++ new/http-api-data-0.2.4/CHANGELOG.md 2016-07-23 23:33:12.000000000 +0200 @@ -1,3 +1,7 @@ +0.2.4 +--- +* Make `parseHeader` total (instead of throwing exceptions on invalid Unicode, see [#30](https://github.com/fizruk/http-api-data/pull/30)). + 0.2.3 --- * Add more parser helpers for `Bounded` `Enum` types. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.2.3/Setup.lhs new/http-api-data-0.2.4/Setup.lhs --- old/http-api-data-0.2.3/Setup.lhs 2015-10-03 22:49:41.000000000 +0200 +++ new/http-api-data-0.2.4/Setup.lhs 2016-07-23 23:33:12.000000000 +0200 @@ -1,7 +1,48 @@ -#!/usr/bin/env runhaskell +#!/usr/bin/runhaskell +\begin{code} +{-# OPTIONS_GHC -Wall #-} +module Main (main) where -> module Main where -> import Distribution.Simple +import Data.List ( nub ) +import Data.Version ( showVersion ) +import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName ) +import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) +import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) +import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) +import Distribution.Simple.BuildPaths ( autogenModulesDir ) +import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag ) +import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) +import Distribution.Verbosity ( Verbosity ) +import System.FilePath ( (</>) ) -> main :: IO () -> main = defaultMain +main :: IO () +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi + buildHook simpleUserHooks pkg lbi hooks flags + } + +generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule verbosity pkg lbi = do + let dir = autogenModulesDir lbi + createDirectoryIfMissingVerbose verbosity True dir + withLibLBI pkg lbi $ \_ libcfg -> do + withTestLBI pkg lbi $ \suite suitecfg -> do + rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines + [ "module Build_" ++ testName suite ++ " where" + , "" + , "autogen_dir :: String" + , "autogen_dir = " ++ show dir + , "" + , "deps :: [String]" + , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) + ] + where + formatdeps = map (formatone . snd) + formatone p = case packageName p of + PackageName n -> n ++ "-" ++ showVersion (packageVersion p) + +testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] +testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys + +\end{code} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.2.3/Web/HttpApiData/Internal.hs new/http-api-data-0.2.4/Web/HttpApiData/Internal.hs --- old/http-api-data-0.2.3/Web/HttpApiData/Internal.hs 2016-06-10 01:42:14.000000000 +0200 +++ new/http-api-data-0.2.4/Web/HttpApiData/Internal.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,569 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeSynonymInstances #-} --- | --- Convert Haskell values to and from HTTP API data --- such as URL pieces, headers and query parameters. -module Web.HttpApiData.Internal where - -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative -import Data.Traversable (Traversable(traverse)) -#endif -import Control.Arrow ((&&&)) - -import Data.Monoid -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS - -import Data.Int -import Data.Word - -import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8, decodeUtf8) -import Data.Text.Read (signed, decimal, rational, Reader) -import qualified Data.Text as T -import qualified Data.Text.Lazy as L - -import Data.Time.Locale.Compat -import Data.Time -import Data.Version - -#if MIN_VERSION_base(4,8,0) -import Data.Void -#endif - -import Text.Read (readMaybe) -import Text.ParserCombinators.ReadP (readP_to_S) - -#if USE_TEXT_SHOW -import TextShow (TextShow, showt) -#endif - --- | Convert value to HTTP API data. --- --- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated --- instance will loop indefinitely. -class ToHttpApiData a where - {-# MINIMAL toUrlPiece | toQueryParam #-} - -- | Convert to URL path piece. - toUrlPiece :: a -> Text - toUrlPiece = toQueryParam - - -- | Convert to HTTP header value. - toHeader :: a -> ByteString - toHeader = encodeUtf8 . toUrlPiece - - -- | Convert to query param value. - toQueryParam :: a -> Text - toQueryParam = toUrlPiece - --- | Parse value from HTTP API data. --- --- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated --- instance will loop indefinitely. -class FromHttpApiData a where - {-# MINIMAL parseUrlPiece | parseQueryParam #-} - -- | Parse URL path piece. - parseUrlPiece :: Text -> Either Text a - parseUrlPiece = parseQueryParam - - -- | Parse HTTP header value. - parseHeader :: ByteString -> Either Text a - parseHeader = parseUrlPiece . decodeUtf8 - - -- | Parse query param value. - parseQueryParam :: Text -> Either Text a - parseQueryParam = parseUrlPiece - --- | Convert multiple values to a list of URL pieces. --- --- >>> toUrlPieces [1, 2, 3] --- ["1","2","3"] -toUrlPieces :: (Functor t, ToHttpApiData a) => t a -> t Text -toUrlPieces = fmap toUrlPiece - --- | Parse multiple URL pieces. --- --- >>> parseUrlPieces ["true", "false"] :: Either Text [Bool] --- Right [True,False] --- >>> parseUrlPieces ["123", "hello", "world"] :: Either Text [Int] --- Left "could not parse: `hello' (input does not start with a digit)" -parseUrlPieces :: (Traversable t, FromHttpApiData a) => t Text -> Either Text (t a) -parseUrlPieces = traverse parseUrlPiece - --- | Convert multiple values to a list of query parameter values. --- --- >>> toQueryParams [fromGregorian 2015 10 03, fromGregorian 2015 12 01] --- ["2015-10-03","2015-12-01"] -toQueryParams :: (Functor t, ToHttpApiData a) => t a -> t Text -toQueryParams = fmap toQueryParam - --- | Parse multiple query parameters. --- --- >>> parseQueryParams ["1", "2", "3"] :: Either Text [Int] --- Right [1,2,3] --- >>> parseQueryParams ["64", "128", "256"] :: Either Text [Word8] --- Left "out of bounds: `256' (should be between 0 and 255)" -parseQueryParams :: (Traversable t, FromHttpApiData a) => t Text -> Either Text (t a) -parseQueryParams = traverse parseQueryParam - --- | Parse URL path piece in a @'Maybe'@. --- --- >>> parseUrlPieceMaybe "12" :: Maybe Int --- Just 12 -parseUrlPieceMaybe :: FromHttpApiData a => Text -> Maybe a -parseUrlPieceMaybe = either (const Nothing) Just . parseUrlPiece - --- | Parse HTTP header value in a @'Maybe'@. --- --- >>> parseHeaderMaybe "hello" :: Maybe Text --- Just "hello" -parseHeaderMaybe :: FromHttpApiData a => ByteString -> Maybe a -parseHeaderMaybe = either (const Nothing) Just . parseHeader - --- | Parse query param value in a @'Maybe'@. --- --- >>> parseQueryParamMaybe "true" :: Maybe Bool --- Just True -parseQueryParamMaybe :: FromHttpApiData a => Text -> Maybe a -parseQueryParamMaybe = either (const Nothing) Just . parseQueryParam - --- | Default parsing error. -defaultParseError :: Text -> Either Text a -defaultParseError input = Left ("could not parse: `" <> input <> "'") - --- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message. -parseMaybeTextData :: (Text -> Maybe a) -> (Text -> Either Text a) -parseMaybeTextData parse input = - case parse input of - Nothing -> defaultParseError input - Just val -> Right val - -#if USE_TEXT_SHOW --- | /Lower case/. --- --- Convert to URL piece using @'TextShow'@ instance. --- The result is always lower cased. --- --- >>> showTextData True --- "true" --- --- This can be used as a default implementation for enumeration types: --- --- @ --- data MyData = Foo | Bar | Baz deriving (Generic) --- --- instance TextShow MyData where --- showt = genericShowt --- --- instance ToHttpApiData MyData where --- toUrlPiece = showTextData --- @ -showTextData :: TextShow a => a -> Text -showTextData = T.toLower . showt -#else --- | /Lower case/. --- --- Convert to URL piece using @'Show'@ instance. --- The result is always lower cased. --- --- >>> showTextData True --- "true" --- --- This can be used as a default implementation for enumeration types: --- --- >>> data MyData = Foo | Bar | Baz deriving (Show) --- >>> instance ToHttpApiData MyData where toUrlPiece = showTextData --- >>> toUrlPiece Foo --- "foo" -showTextData :: Show a => a -> Text -showTextData = T.toLower . showt - --- | Like @'show'@, but returns @'Text'@. -showt :: Show a => a -> Text -showt = T.pack . show -#endif - --- | /Case insensitive/. --- --- Parse given text case insensitive and then parse the rest of the input --- using @'parseUrlPiece'@. --- --- >>> parseUrlPieceWithPrefix "Just " "just 10" :: Either Text Int --- Right 10 --- >>> parseUrlPieceWithPrefix "Left " "left" :: Either Text Bool --- Left "could not parse: `left'" --- --- This can be used to implement @'FromHttpApiData'@ for single field constructors: --- --- >>> data Foo = Foo Int deriving (Show) --- >>> instance FromHttpApiData Foo where parseUrlPiece s = Foo <$> parseUrlPieceWithPrefix "Foo " s --- >>> parseUrlPiece "foo 1" :: Either Text Foo --- Right (Foo 1) -parseUrlPieceWithPrefix :: FromHttpApiData a => Text -> Text -> Either Text a -parseUrlPieceWithPrefix pattern input - | T.toLower pattern == T.toLower prefix = parseUrlPiece rest - | otherwise = defaultParseError input - where - (prefix, rest) = T.splitAt (T.length pattern) input - --- $setup --- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show) --- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p - --- | Parse given bytestring then parse the rest of the input using @'parseHeader'@. --- --- @ --- data BasicAuthToken = BasicAuthToken Text deriving (Show) --- --- instance FromHttpApiData BasicAuthToken where --- parseHeader h = BasicAuthToken \<$\> parseHeaderWithPrefix "Basic " h --- parseQueryParam p = BasicAuthToken \<$\> parseQueryParam p --- @ --- --- >>> parseHeader "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" :: Either Text BasicAuthToken --- Right (BasicAuthToken "QWxhZGRpbjpvcGVuIHNlc2FtZQ==") -parseHeaderWithPrefix :: FromHttpApiData a => ByteString -> ByteString -> Either Text a -parseHeaderWithPrefix pattern input - | pattern `BS.isPrefixOf` input = parseHeader (BS.drop (BS.length pattern) input) - | otherwise = defaultParseError (showt input) - --- | /Case insensitive/. --- --- Parse given text case insensitive and then parse the rest of the input --- using @'parseQueryParam'@. --- --- >>> parseQueryParamWithPrefix "z" "z10" :: Either Text Int --- Right 10 -parseQueryParamWithPrefix :: FromHttpApiData a => Text -> Text -> Either Text a -parseQueryParamWithPrefix pattern input - | T.toLower pattern == T.toLower prefix = parseQueryParam rest - | otherwise = defaultParseError input - where - (prefix, rest) = T.splitAt (T.length pattern) input - -#if USE_TEXT_SHOW --- | /Case insensitive/. --- --- Parse values case insensitively based on @'TextShow'@ instance. --- --- >>> parseBoundedTextData "true" :: Either Text Bool --- Right True --- >>> parseBoundedTextData "FALSE" :: Either Text Bool --- Right False --- --- This can be used as a default implementation for enumeration types: --- --- @ --- data MyData = Foo | Bar | Baz deriving (Show, Bounded, Enum, Generic) --- --- instance TextShow MyData where --- showt = genericShowt --- --- instance FromHttpApiData MyData where --- parseUrlPiece = parseBoundedTextData --- @ -parseBoundedTextData :: (TextShow a, Bounded a, Enum a) => Text -> Either Text a -#else --- | /Case insensitive/. --- --- Parse values case insensitively based on @'Show'@ instance. --- --- >>> parseBoundedTextData "true" :: Either Text Bool --- Right True --- >>> parseBoundedTextData "FALSE" :: Either Text Bool --- Right False --- --- This can be used as a default implementation for enumeration types: --- --- >>> data MyData = Foo | Bar | Baz deriving (Show, Bounded, Enum) --- >>> instance FromHttpApiData MyData where parseUrlPiece = parseBoundedTextData --- >>> parseUrlPiece "foo" :: Either Text MyData --- Right Foo -parseBoundedTextData :: (Show a, Bounded a, Enum a) => Text -> Either Text a -#endif -parseBoundedTextData = parseBoundedEnumOfI showTextData - --- | Lookup values based on a precalculated mapping of their representations. -lookupBoundedEnumOf :: (Bounded a, Enum a, Eq b) => (a -> b) -> b -> Maybe a -lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound]) - --- | Parse values based on a precalculated mapping of their @'Text'@ representation. --- --- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool --- Right True --- --- For case sensitive parser see 'parseBoundedEnumOfI'. -parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a -parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf - --- | /Case insensitive/. --- --- Parse values case insensitively based on a precalculated mapping --- of their @'Text'@ representations. --- --- >>> parseBoundedEnumOfI toUrlPiece "FALSE" :: Either Text Bool --- Right False --- --- For case sensitive parser see 'parseBoundedEnumOf'. -parseBoundedEnumOfI :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a -parseBoundedEnumOfI f = parseBoundedEnumOf (T.toLower . f) . T.toLower - --- | /Case insensitive/. --- --- Parse values case insensitively based on @'ToHttpApiData'@ instance. --- Uses @'toUrlPiece'@ to get possible values. -parseBoundedUrlPiece :: (ToHttpApiData a, Bounded a, Enum a) => Text -> Either Text a -parseBoundedUrlPiece = parseBoundedEnumOfI toUrlPiece - --- | /Case insensitive/. --- --- Parse values case insensitively based on @'ToHttpApiData'@ instance. --- Uses @'toQueryParam'@ to get possible values. -parseBoundedQueryParam :: (ToHttpApiData a, Bounded a, Enum a) => Text -> Either Text a -parseBoundedQueryParam = parseBoundedEnumOfI toQueryParam - --- | Parse values based on @'ToHttpApiData'@ instance. --- Uses @'toHeader'@ to get possible values. -parseBoundedHeader :: (ToHttpApiData a, Bounded a, Enum a) => ByteString -> Either Text a -parseBoundedHeader bs = case lookupBoundedEnumOf toHeader bs of - Nothing -> defaultParseError (decodeUtf8 bs) - Just x -> return x - --- | Parse URL piece using @'Read'@ instance. --- --- Use for types which do not involve letters: --- --- >>> readTextData "1991-06-02" :: Either Text Day --- Right 1991-06-02 --- --- This parser is case sensitive and will not match @'showTextData'@ --- in presense of letters: --- --- >>> readTextData (showTextData True) :: Either Text Bool --- Left "could not parse: `true'" --- --- See @'parseBoundedTextData'@. -readTextData :: Read a => Text -> Either Text a -readTextData = parseMaybeTextData (readMaybe . T.unpack) - --- | Run @'Reader'@ as HTTP API data parser. -runReader :: Reader a -> Text -> Either Text a -runReader reader input = - case reader input of - Left err -> Left ("could not parse: `" <> input <> "' (" <> T.pack err <> ")") - Right (x, rest) - | T.null rest -> Right x - | otherwise -> defaultParseError input - --- | Run @'Reader'@ to parse bounded integral value with bounds checking. --- --- >>> parseBounded decimal "256" :: Either Text Word8 --- Left "out of bounds: `256' (should be between 0 and 255)" -parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a -parseBounded reader input = do - n <- runReader reader input - if (n > h || n < l) - then Left ("out of bounds: `" <> input <> "' (should be between " <> showt l <> " and " <> showt h <> ")") - else Right (fromInteger n) - where - l = toInteger (minBound :: a) - h = toInteger (maxBound :: a) - --- | --- >>> toUrlPiece () --- "_" -instance ToHttpApiData () where - toUrlPiece () = "_" - -instance ToHttpApiData Char where toUrlPiece = T.singleton - --- | --- >>> toUrlPiece (Version [1, 2, 3] []) --- "1.2.3" -instance ToHttpApiData Version where - toUrlPiece = T.pack . showVersion - -#if MIN_VERSION_base(4,8,0) -instance ToHttpApiData Void where - toUrlPiece = absurd -#endif - -instance ToHttpApiData Bool where toUrlPiece = showTextData -instance ToHttpApiData Ordering where toUrlPiece = showTextData - -instance ToHttpApiData Double where toUrlPiece = showt -instance ToHttpApiData Float where toUrlPiece = showt -instance ToHttpApiData Int where toUrlPiece = showt -instance ToHttpApiData Int8 where toUrlPiece = showt -instance ToHttpApiData Int16 where toUrlPiece = showt -instance ToHttpApiData Int32 where toUrlPiece = showt -instance ToHttpApiData Int64 where toUrlPiece = showt -instance ToHttpApiData Integer where toUrlPiece = showt -instance ToHttpApiData Word where toUrlPiece = showt -instance ToHttpApiData Word8 where toUrlPiece = showt -instance ToHttpApiData Word16 where toUrlPiece = showt -instance ToHttpApiData Word32 where toUrlPiece = showt -instance ToHttpApiData Word64 where toUrlPiece = showt - --- | --- >>> toUrlPiece (fromGregorian 2015 10 03) --- "2015-10-03" -instance ToHttpApiData Day where toUrlPiece = T.pack . show - -timeToUrlPiece :: FormatTime t => String -> t -> Text -timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt)) - --- | --- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01) --- "2015-10-03T14:55:01" -instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S" - --- | --- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc --- "2015-10-03T14:55:01+0000" -instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z" - --- | --- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864 --- "2015-10-03T00:14:24Z" -instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ" - -instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer) - -instance ToHttpApiData String where toUrlPiece = T.pack -instance ToHttpApiData Text where toUrlPiece = id -instance ToHttpApiData L.Text where toUrlPiece = L.toStrict - -instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll -instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny - -instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual -instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum -instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct -instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst -instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast - --- | --- >>> toUrlPiece (Just "Hello") --- "just Hello" -instance ToHttpApiData a => ToHttpApiData (Maybe a) where - toUrlPiece (Just x) = "just " <> toUrlPiece x - toUrlPiece Nothing = "nothing" - --- | --- >>> toUrlPiece (Left "err" :: Either String Int) --- "left err" --- >>> toUrlPiece (Right 3 :: Either String Int) --- "right 3" -instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where - toUrlPiece (Left x) = "left " <> toUrlPiece x - toUrlPiece (Right x) = "right " <> toUrlPiece x - --- | --- >>> parseUrlPiece "_" :: Either Text () --- Right () -instance FromHttpApiData () where - parseUrlPiece "_" = pure () - parseUrlPiece s = defaultParseError s - -instance FromHttpApiData Char where - parseUrlPiece s = - case T.uncons s of - Just (c, s') | T.null s' -> pure c - _ -> defaultParseError s - --- | --- >>> showVersion <$> parseUrlPiece "1.2.3" --- Right "1.2.3" -instance FromHttpApiData Version where - parseUrlPiece s = - case reverse (readP_to_S parseVersion (T.unpack s)) of - ((x, ""):_) -> pure x - _ -> defaultParseError s - -#if MIN_VERSION_base(4,8,0) --- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors. -instance FromHttpApiData Void where - parseUrlPiece _ = Left "Void cannot be parsed!" -#endif - -instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece -instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece -instance FromHttpApiData Double where parseUrlPiece = runReader rational -instance FromHttpApiData Float where parseUrlPiece = runReader rational -instance FromHttpApiData Int where parseUrlPiece = parseBounded (signed decimal) -instance FromHttpApiData Int8 where parseUrlPiece = parseBounded (signed decimal) -instance FromHttpApiData Int16 where parseUrlPiece = parseBounded (signed decimal) -instance FromHttpApiData Int32 where parseUrlPiece = parseBounded (signed decimal) -instance FromHttpApiData Int64 where parseUrlPiece = parseBounded (signed decimal) -instance FromHttpApiData Integer where parseUrlPiece = runReader (signed decimal) -instance FromHttpApiData Word where parseUrlPiece = parseBounded decimal -instance FromHttpApiData Word8 where parseUrlPiece = parseBounded decimal -instance FromHttpApiData Word16 where parseUrlPiece = parseBounded decimal -instance FromHttpApiData Word32 where parseUrlPiece = parseBounded decimal -instance FromHttpApiData Word64 where parseUrlPiece = parseBounded decimal -instance FromHttpApiData String where parseUrlPiece = Right . T.unpack -instance FromHttpApiData Text where parseUrlPiece = Right -instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict - --- | --- >>> toGregorian <$> parseUrlPiece "2016-12-01" --- Right (2016,12,1) -instance FromHttpApiData Day where parseUrlPiece = readTextData - -timeParseUrlPiece :: ParseTime t => String -> Text -> Either Text t -timeParseUrlPiece fmt = parseMaybeTextData (timeParseUrlPieceMaybe . T.unpack) - where - timeParseUrlPieceMaybe = parseTime defaultTimeLocale (iso8601DateFormat (Just fmt)) - --- | --- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime --- Right 2015-10-03 14:55:01 -instance FromHttpApiData LocalTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S" - --- | --- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime --- Right 2015-10-03 14:55:01 +0000 -instance FromHttpApiData ZonedTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S%z" - --- | --- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime --- Right 2015-10-03 00:14:24 UTC -instance FromHttpApiData UTCTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%SZ" - -instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece - -instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece -instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece - -instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece -instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece -instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece -instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece -instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece - --- | --- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int) --- Right (Just 123) -instance FromHttpApiData a => FromHttpApiData (Maybe a) where - parseUrlPiece s - | T.toLower (T.take 7 s) == "nothing" = pure Nothing - | otherwise = Just <$> parseUrlPieceWithPrefix "Just " s - --- | --- >>> parseUrlPiece "Right 123" :: Either Text (Either String Int) --- Right (Right 123) -instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b) where - parseUrlPiece s = - Right <$> parseUrlPieceWithPrefix "Right " s - <!> Left <$> parseUrlPieceWithPrefix "Left " s - where - infixl 3 <!> - Left _ <!> y = y - x <!> _ = x - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.2.3/Web/HttpApiData.hs new/http-api-data-0.2.4/Web/HttpApiData.hs --- old/http-api-data-0.2.3/Web/HttpApiData.hs 2016-06-10 01:42:14.000000000 +0200 +++ new/http-api-data-0.2.4/Web/HttpApiData.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,90 +0,0 @@ --- | --- Convert Haskell values to and from HTTP API data --- such as URL pieces, headers and query parameters. -module Web.HttpApiData ( - -- * Examples - -- $examples - - -- * Classes - ToHttpApiData (..), - FromHttpApiData (..), - - -- * @'Maybe'@ parsers - parseUrlPieceMaybe, - parseHeaderMaybe, - parseQueryParamMaybe, - - -- * Prefix parsers - parseUrlPieceWithPrefix, - parseHeaderWithPrefix, - parseQueryParamWithPrefix, - - -- * Multiple URL pieces - toUrlPieces, - parseUrlPieces, - - -- * Multiple query params - toQueryParams, - parseQueryParams, - - -- * Parsers for @'Bounded'@ @'Enum'@s - parseBoundedUrlPiece, - parseBoundedQueryParam, - parseBoundedHeader, - parseBoundedEnumOf, - parseBoundedEnumOfI, - parseBoundedTextData, - - -- * Other helpers - showTextData, - readTextData, -) where - -import Web.HttpApiData.Internal - --- $setup --- --- >>> :set -XOverloadedStrings --- >>> import Control.Applicative --- >>> import Data.Time --- >>> import Data.Int --- >>> import Data.Text (Text) --- >>> import Data.Time (Day) --- >>> import Data.Version - --- $examples --- --- Booleans: --- --- >>> toUrlPiece True --- "true" --- >>> parseUrlPiece "false" :: Either Text Bool --- Right False --- >>> parseUrlPieces ["true", "false", "undefined"] :: Either Text [Bool] --- Left "could not parse: `undefined'" --- --- Numbers: --- --- >>> toQueryParam 45.2 --- "45.2" --- >>> parseQueryParam "452" :: Either Text Int --- Right 452 --- >>> toQueryParams [1..5] --- ["1","2","3","4","5"] --- >>> parseQueryParams ["127", "255"] :: Either Text [Int8] --- Left "out of bounds: `255' (should be between -128 and 127)" --- --- Strings: --- --- >>> toHeader "hello" --- "hello" --- >>> parseHeader "world" :: Either Text String --- Right "world" --- --- Calendar day: --- --- >>> toQueryParam (fromGregorian 2015 10 03) --- "2015-10-03" --- >>> toGregorian <$> parseQueryParam "2016-12-01" --- Right (2016,12,1) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.2.3/http-api-data.cabal new/http-api-data-0.2.4/http-api-data.cabal --- old/http-api-data-0.2.3/http-api-data.cabal 2016-06-10 02:17:37.000000000 +0200 +++ new/http-api-data-0.2.4/http-api-data.cabal 2016-07-23 23:33:12.000000000 +0200 @@ -1,5 +1,5 @@ name: http-api-data -version: 0.2.3 +version: 0.2.4 license: BSD3 license-file: LICENSE author: Nickolay Kudasov <[email protected]> @@ -10,7 +10,7 @@ category: Web stability: unstable cabal-version: >= 1.8 -build-type: Simple +build-type: Custom extra-source-files: test/*.hs CHANGELOG.md @@ -21,6 +21,7 @@ default: False library + hs-source-dirs: src/ build-depends: base >= 4.6 && < 4.10 , text >= 0.5 , bytestring @@ -37,7 +38,7 @@ test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs - hs-source-dirs: test + hs-source-dirs: test/ ghc-options: -Wall build-depends: HUnit , hspec >= 1.3 @@ -46,12 +47,19 @@ , http-api-data , text , time + , bytestring test-suite doctest - build-depends: base, doctest, Glob - hs-source-dirs: test - main-is: DocTest.hs - type: exitcode-stdio-1.0 + ghc-options: -Wall + build-depends: + base, + directory >= 1.0, + doctest >= 0.11 && <0.12, + filepath + default-language: Haskell2010 + hs-source-dirs: test + main-is: DocTest.hs + type: exitcode-stdio-1.0 source-repository head type: git diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.2.3/src/Web/HttpApiData/Internal.hs new/http-api-data-0.2.4/src/Web/HttpApiData/Internal.hs --- old/http-api-data-0.2.3/src/Web/HttpApiData/Internal.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/http-api-data-0.2.4/src/Web/HttpApiData/Internal.hs 2016-07-23 23:33:12.000000000 +0200 @@ -0,0 +1,570 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeSynonymInstances #-} +-- | +-- Convert Haskell values to and from HTTP API data +-- such as URL pieces, headers and query parameters. +module Web.HttpApiData.Internal where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +import Data.Traversable (Traversable(traverse)) +#endif +import Control.Arrow ((&&&), left) +import Control.Monad ((<=<)) + +import Data.Monoid +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS + +import Data.Int +import Data.Word + +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8, decodeUtf8') +import Data.Text.Read (signed, decimal, rational, Reader) +import qualified Data.Text as T +import qualified Data.Text.Lazy as L + +import Data.Time.Locale.Compat +import Data.Time +import Data.Version + +#if MIN_VERSION_base(4,8,0) +import Data.Void +#endif + +import Text.Read (readMaybe) +import Text.ParserCombinators.ReadP (readP_to_S) + +#if USE_TEXT_SHOW +import TextShow (TextShow, showt) +#endif + +-- | Convert value to HTTP API data. +-- +-- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated +-- instance will loop indefinitely. +class ToHttpApiData a where + {-# MINIMAL toUrlPiece | toQueryParam #-} + -- | Convert to URL path piece. + toUrlPiece :: a -> Text + toUrlPiece = toQueryParam + + -- | Convert to HTTP header value. + toHeader :: a -> ByteString + toHeader = encodeUtf8 . toUrlPiece + + -- | Convert to query param value. + toQueryParam :: a -> Text + toQueryParam = toUrlPiece + +-- | Parse value from HTTP API data. +-- +-- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated +-- instance will loop indefinitely. +class FromHttpApiData a where + {-# MINIMAL parseUrlPiece | parseQueryParam #-} + -- | Parse URL path piece. + parseUrlPiece :: Text -> Either Text a + parseUrlPiece = parseQueryParam + + -- | Parse HTTP header value. + parseHeader :: ByteString -> Either Text a + parseHeader = parseUrlPiece <=< (left (T.pack . show) . decodeUtf8') + + -- | Parse query param value. + parseQueryParam :: Text -> Either Text a + parseQueryParam = parseUrlPiece + +-- | Convert multiple values to a list of URL pieces. +-- +-- >>> toUrlPieces [1, 2, 3] +-- ["1","2","3"] +toUrlPieces :: (Functor t, ToHttpApiData a) => t a -> t Text +toUrlPieces = fmap toUrlPiece + +-- | Parse multiple URL pieces. +-- +-- >>> parseUrlPieces ["true", "false"] :: Either Text [Bool] +-- Right [True,False] +-- >>> parseUrlPieces ["123", "hello", "world"] :: Either Text [Int] +-- Left "could not parse: `hello' (input does not start with a digit)" +parseUrlPieces :: (Traversable t, FromHttpApiData a) => t Text -> Either Text (t a) +parseUrlPieces = traverse parseUrlPiece + +-- | Convert multiple values to a list of query parameter values. +-- +-- >>> toQueryParams [fromGregorian 2015 10 03, fromGregorian 2015 12 01] +-- ["2015-10-03","2015-12-01"] +toQueryParams :: (Functor t, ToHttpApiData a) => t a -> t Text +toQueryParams = fmap toQueryParam + +-- | Parse multiple query parameters. +-- +-- >>> parseQueryParams ["1", "2", "3"] :: Either Text [Int] +-- Right [1,2,3] +-- >>> parseQueryParams ["64", "128", "256"] :: Either Text [Word8] +-- Left "out of bounds: `256' (should be between 0 and 255)" +parseQueryParams :: (Traversable t, FromHttpApiData a) => t Text -> Either Text (t a) +parseQueryParams = traverse parseQueryParam + +-- | Parse URL path piece in a @'Maybe'@. +-- +-- >>> parseUrlPieceMaybe "12" :: Maybe Int +-- Just 12 +parseUrlPieceMaybe :: FromHttpApiData a => Text -> Maybe a +parseUrlPieceMaybe = either (const Nothing) Just . parseUrlPiece + +-- | Parse HTTP header value in a @'Maybe'@. +-- +-- >>> parseHeaderMaybe "hello" :: Maybe Text +-- Just "hello" +parseHeaderMaybe :: FromHttpApiData a => ByteString -> Maybe a +parseHeaderMaybe = either (const Nothing) Just . parseHeader + +-- | Parse query param value in a @'Maybe'@. +-- +-- >>> parseQueryParamMaybe "true" :: Maybe Bool +-- Just True +parseQueryParamMaybe :: FromHttpApiData a => Text -> Maybe a +parseQueryParamMaybe = either (const Nothing) Just . parseQueryParam + +-- | Default parsing error. +defaultParseError :: Text -> Either Text a +defaultParseError input = Left ("could not parse: `" <> input <> "'") + +-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message. +parseMaybeTextData :: (Text -> Maybe a) -> (Text -> Either Text a) +parseMaybeTextData parse input = + case parse input of + Nothing -> defaultParseError input + Just val -> Right val + +#if USE_TEXT_SHOW +-- | /Lower case/. +-- +-- Convert to URL piece using @'TextShow'@ instance. +-- The result is always lower cased. +-- +-- >>> showTextData True +-- "true" +-- +-- This can be used as a default implementation for enumeration types: +-- +-- @ +-- data MyData = Foo | Bar | Baz deriving (Generic) +-- +-- instance TextShow MyData where +-- showt = genericShowt +-- +-- instance ToHttpApiData MyData where +-- toUrlPiece = showTextData +-- @ +showTextData :: TextShow a => a -> Text +showTextData = T.toLower . showt +#else +-- | /Lower case/. +-- +-- Convert to URL piece using @'Show'@ instance. +-- The result is always lower cased. +-- +-- >>> showTextData True +-- "true" +-- +-- This can be used as a default implementation for enumeration types: +-- +-- >>> data MyData = Foo | Bar | Baz deriving (Show) +-- >>> instance ToHttpApiData MyData where toUrlPiece = showTextData +-- >>> toUrlPiece Foo +-- "foo" +showTextData :: Show a => a -> Text +showTextData = T.toLower . showt + +-- | Like @'show'@, but returns @'Text'@. +showt :: Show a => a -> Text +showt = T.pack . show +#endif + +-- | /Case insensitive/. +-- +-- Parse given text case insensitive and then parse the rest of the input +-- using @'parseUrlPiece'@. +-- +-- >>> parseUrlPieceWithPrefix "Just " "just 10" :: Either Text Int +-- Right 10 +-- >>> parseUrlPieceWithPrefix "Left " "left" :: Either Text Bool +-- Left "could not parse: `left'" +-- +-- This can be used to implement @'FromHttpApiData'@ for single field constructors: +-- +-- >>> data Foo = Foo Int deriving (Show) +-- >>> instance FromHttpApiData Foo where parseUrlPiece s = Foo <$> parseUrlPieceWithPrefix "Foo " s +-- >>> parseUrlPiece "foo 1" :: Either Text Foo +-- Right (Foo 1) +parseUrlPieceWithPrefix :: FromHttpApiData a => Text -> Text -> Either Text a +parseUrlPieceWithPrefix pattern input + | T.toLower pattern == T.toLower prefix = parseUrlPiece rest + | otherwise = defaultParseError input + where + (prefix, rest) = T.splitAt (T.length pattern) input + +-- $setup +-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show) +-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p + +-- | Parse given bytestring then parse the rest of the input using @'parseHeader'@. +-- +-- @ +-- data BasicAuthToken = BasicAuthToken Text deriving (Show) +-- +-- instance FromHttpApiData BasicAuthToken where +-- parseHeader h = BasicAuthToken \<$\> parseHeaderWithPrefix "Basic " h +-- parseQueryParam p = BasicAuthToken \<$\> parseQueryParam p +-- @ +-- +-- >>> parseHeader "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" :: Either Text BasicAuthToken +-- Right (BasicAuthToken "QWxhZGRpbjpvcGVuIHNlc2FtZQ==") +parseHeaderWithPrefix :: FromHttpApiData a => ByteString -> ByteString -> Either Text a +parseHeaderWithPrefix pattern input + | pattern `BS.isPrefixOf` input = parseHeader (BS.drop (BS.length pattern) input) + | otherwise = defaultParseError (showt input) + +-- | /Case insensitive/. +-- +-- Parse given text case insensitive and then parse the rest of the input +-- using @'parseQueryParam'@. +-- +-- >>> parseQueryParamWithPrefix "z" "z10" :: Either Text Int +-- Right 10 +parseQueryParamWithPrefix :: FromHttpApiData a => Text -> Text -> Either Text a +parseQueryParamWithPrefix pattern input + | T.toLower pattern == T.toLower prefix = parseQueryParam rest + | otherwise = defaultParseError input + where + (prefix, rest) = T.splitAt (T.length pattern) input + +#if USE_TEXT_SHOW +-- | /Case insensitive/. +-- +-- Parse values case insensitively based on @'TextShow'@ instance. +-- +-- >>> parseBoundedTextData "true" :: Either Text Bool +-- Right True +-- >>> parseBoundedTextData "FALSE" :: Either Text Bool +-- Right False +-- +-- This can be used as a default implementation for enumeration types: +-- +-- @ +-- data MyData = Foo | Bar | Baz deriving (Show, Bounded, Enum, Generic) +-- +-- instance TextShow MyData where +-- showt = genericShowt +-- +-- instance FromHttpApiData MyData where +-- parseUrlPiece = parseBoundedTextData +-- @ +parseBoundedTextData :: (TextShow a, Bounded a, Enum a) => Text -> Either Text a +#else +-- | /Case insensitive/. +-- +-- Parse values case insensitively based on @'Show'@ instance. +-- +-- >>> parseBoundedTextData "true" :: Either Text Bool +-- Right True +-- >>> parseBoundedTextData "FALSE" :: Either Text Bool +-- Right False +-- +-- This can be used as a default implementation for enumeration types: +-- +-- >>> data MyData = Foo | Bar | Baz deriving (Show, Bounded, Enum) +-- >>> instance FromHttpApiData MyData where parseUrlPiece = parseBoundedTextData +-- >>> parseUrlPiece "foo" :: Either Text MyData +-- Right Foo +parseBoundedTextData :: (Show a, Bounded a, Enum a) => Text -> Either Text a +#endif +parseBoundedTextData = parseBoundedEnumOfI showTextData + +-- | Lookup values based on a precalculated mapping of their representations. +lookupBoundedEnumOf :: (Bounded a, Enum a, Eq b) => (a -> b) -> b -> Maybe a +lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound]) + +-- | Parse values based on a precalculated mapping of their @'Text'@ representation. +-- +-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool +-- Right True +-- +-- For case sensitive parser see 'parseBoundedEnumOfI'. +parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a +parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf + +-- | /Case insensitive/. +-- +-- Parse values case insensitively based on a precalculated mapping +-- of their @'Text'@ representations. +-- +-- >>> parseBoundedEnumOfI toUrlPiece "FALSE" :: Either Text Bool +-- Right False +-- +-- For case sensitive parser see 'parseBoundedEnumOf'. +parseBoundedEnumOfI :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a +parseBoundedEnumOfI f = parseBoundedEnumOf (T.toLower . f) . T.toLower + +-- | /Case insensitive/. +-- +-- Parse values case insensitively based on @'ToHttpApiData'@ instance. +-- Uses @'toUrlPiece'@ to get possible values. +parseBoundedUrlPiece :: (ToHttpApiData a, Bounded a, Enum a) => Text -> Either Text a +parseBoundedUrlPiece = parseBoundedEnumOfI toUrlPiece + +-- | /Case insensitive/. +-- +-- Parse values case insensitively based on @'ToHttpApiData'@ instance. +-- Uses @'toQueryParam'@ to get possible values. +parseBoundedQueryParam :: (ToHttpApiData a, Bounded a, Enum a) => Text -> Either Text a +parseBoundedQueryParam = parseBoundedEnumOfI toQueryParam + +-- | Parse values based on @'ToHttpApiData'@ instance. +-- Uses @'toHeader'@ to get possible values. +parseBoundedHeader :: (ToHttpApiData a, Bounded a, Enum a) => ByteString -> Either Text a +parseBoundedHeader bs = case lookupBoundedEnumOf toHeader bs of + Nothing -> defaultParseError $ T.pack $ show bs + Just x -> return x + +-- | Parse URL piece using @'Read'@ instance. +-- +-- Use for types which do not involve letters: +-- +-- >>> readTextData "1991-06-02" :: Either Text Day +-- Right 1991-06-02 +-- +-- This parser is case sensitive and will not match @'showTextData'@ +-- in presense of letters: +-- +-- >>> readTextData (showTextData True) :: Either Text Bool +-- Left "could not parse: `true'" +-- +-- See @'parseBoundedTextData'@. +readTextData :: Read a => Text -> Either Text a +readTextData = parseMaybeTextData (readMaybe . T.unpack) + +-- | Run @'Reader'@ as HTTP API data parser. +runReader :: Reader a -> Text -> Either Text a +runReader reader input = + case reader input of + Left err -> Left ("could not parse: `" <> input <> "' (" <> T.pack err <> ")") + Right (x, rest) + | T.null rest -> Right x + | otherwise -> defaultParseError input + +-- | Run @'Reader'@ to parse bounded integral value with bounds checking. +-- +-- >>> parseBounded decimal "256" :: Either Text Word8 +-- Left "out of bounds: `256' (should be between 0 and 255)" +parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a +parseBounded reader input = do + n <- runReader reader input + if (n > h || n < l) + then Left ("out of bounds: `" <> input <> "' (should be between " <> showt l <> " and " <> showt h <> ")") + else Right (fromInteger n) + where + l = toInteger (minBound :: a) + h = toInteger (maxBound :: a) + +-- | +-- >>> toUrlPiece () +-- "_" +instance ToHttpApiData () where + toUrlPiece () = "_" + +instance ToHttpApiData Char where toUrlPiece = T.singleton + +-- | +-- >>> toUrlPiece (Version [1, 2, 3] []) +-- "1.2.3" +instance ToHttpApiData Version where + toUrlPiece = T.pack . showVersion + +#if MIN_VERSION_base(4,8,0) +instance ToHttpApiData Void where + toUrlPiece = absurd +#endif + +instance ToHttpApiData Bool where toUrlPiece = showTextData +instance ToHttpApiData Ordering where toUrlPiece = showTextData + +instance ToHttpApiData Double where toUrlPiece = showt +instance ToHttpApiData Float where toUrlPiece = showt +instance ToHttpApiData Int where toUrlPiece = showt +instance ToHttpApiData Int8 where toUrlPiece = showt +instance ToHttpApiData Int16 where toUrlPiece = showt +instance ToHttpApiData Int32 where toUrlPiece = showt +instance ToHttpApiData Int64 where toUrlPiece = showt +instance ToHttpApiData Integer where toUrlPiece = showt +instance ToHttpApiData Word where toUrlPiece = showt +instance ToHttpApiData Word8 where toUrlPiece = showt +instance ToHttpApiData Word16 where toUrlPiece = showt +instance ToHttpApiData Word32 where toUrlPiece = showt +instance ToHttpApiData Word64 where toUrlPiece = showt + +-- | +-- >>> toUrlPiece (fromGregorian 2015 10 03) +-- "2015-10-03" +instance ToHttpApiData Day where toUrlPiece = T.pack . show + +timeToUrlPiece :: FormatTime t => String -> t -> Text +timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt)) + +-- | +-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01) +-- "2015-10-03T14:55:01" +instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S" + +-- | +-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc +-- "2015-10-03T14:55:01+0000" +instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z" + +-- | +-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864 +-- "2015-10-03T00:14:24Z" +instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ" + +instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer) + +instance ToHttpApiData String where toUrlPiece = T.pack +instance ToHttpApiData Text where toUrlPiece = id +instance ToHttpApiData L.Text where toUrlPiece = L.toStrict + +instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll +instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny + +instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual +instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum +instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct +instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst +instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast + +-- | +-- >>> toUrlPiece (Just "Hello") +-- "just Hello" +instance ToHttpApiData a => ToHttpApiData (Maybe a) where + toUrlPiece (Just x) = "just " <> toUrlPiece x + toUrlPiece Nothing = "nothing" + +-- | +-- >>> toUrlPiece (Left "err" :: Either String Int) +-- "left err" +-- >>> toUrlPiece (Right 3 :: Either String Int) +-- "right 3" +instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where + toUrlPiece (Left x) = "left " <> toUrlPiece x + toUrlPiece (Right x) = "right " <> toUrlPiece x + +-- | +-- >>> parseUrlPiece "_" :: Either Text () +-- Right () +instance FromHttpApiData () where + parseUrlPiece "_" = pure () + parseUrlPiece s = defaultParseError s + +instance FromHttpApiData Char where + parseUrlPiece s = + case T.uncons s of + Just (c, s') | T.null s' -> pure c + _ -> defaultParseError s + +-- | +-- >>> showVersion <$> parseUrlPiece "1.2.3" +-- Right "1.2.3" +instance FromHttpApiData Version where + parseUrlPiece s = + case reverse (readP_to_S parseVersion (T.unpack s)) of + ((x, ""):_) -> pure x + _ -> defaultParseError s + +#if MIN_VERSION_base(4,8,0) +-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors. +instance FromHttpApiData Void where + parseUrlPiece _ = Left "Void cannot be parsed!" +#endif + +instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece +instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece +instance FromHttpApiData Double where parseUrlPiece = runReader rational +instance FromHttpApiData Float where parseUrlPiece = runReader rational +instance FromHttpApiData Int where parseUrlPiece = parseBounded (signed decimal) +instance FromHttpApiData Int8 where parseUrlPiece = parseBounded (signed decimal) +instance FromHttpApiData Int16 where parseUrlPiece = parseBounded (signed decimal) +instance FromHttpApiData Int32 where parseUrlPiece = parseBounded (signed decimal) +instance FromHttpApiData Int64 where parseUrlPiece = parseBounded (signed decimal) +instance FromHttpApiData Integer where parseUrlPiece = runReader (signed decimal) +instance FromHttpApiData Word where parseUrlPiece = parseBounded decimal +instance FromHttpApiData Word8 where parseUrlPiece = parseBounded decimal +instance FromHttpApiData Word16 where parseUrlPiece = parseBounded decimal +instance FromHttpApiData Word32 where parseUrlPiece = parseBounded decimal +instance FromHttpApiData Word64 where parseUrlPiece = parseBounded decimal +instance FromHttpApiData String where parseUrlPiece = Right . T.unpack +instance FromHttpApiData Text where parseUrlPiece = Right +instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict + +-- | +-- >>> toGregorian <$> parseUrlPiece "2016-12-01" +-- Right (2016,12,1) +instance FromHttpApiData Day where parseUrlPiece = readTextData + +timeParseUrlPiece :: ParseTime t => String -> Text -> Either Text t +timeParseUrlPiece fmt = parseMaybeTextData (timeParseUrlPieceMaybe . T.unpack) + where + timeParseUrlPieceMaybe = parseTime defaultTimeLocale (iso8601DateFormat (Just fmt)) + +-- | +-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime +-- Right 2015-10-03 14:55:01 +instance FromHttpApiData LocalTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S" + +-- | +-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime +-- Right 2015-10-03 14:55:01 +0000 +instance FromHttpApiData ZonedTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S%z" + +-- | +-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime +-- Right 2015-10-03 00:14:24 UTC +instance FromHttpApiData UTCTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%SZ" + +instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece + +instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece +instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece + +instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece +instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece +instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece +instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece +instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece + +-- | +-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int) +-- Right (Just 123) +instance FromHttpApiData a => FromHttpApiData (Maybe a) where + parseUrlPiece s + | T.toLower (T.take 7 s) == "nothing" = pure Nothing + | otherwise = Just <$> parseUrlPieceWithPrefix "Just " s + +-- | +-- >>> parseUrlPiece "Right 123" :: Either Text (Either String Int) +-- Right (Right 123) +instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b) where + parseUrlPiece s = + Right <$> parseUrlPieceWithPrefix "Right " s + <!> Left <$> parseUrlPieceWithPrefix "Left " s + where + infixl 3 <!> + Left _ <!> y = y + x <!> _ = x + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.2.3/src/Web/HttpApiData.hs new/http-api-data-0.2.4/src/Web/HttpApiData.hs --- old/http-api-data-0.2.3/src/Web/HttpApiData.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/http-api-data-0.2.4/src/Web/HttpApiData.hs 2016-07-23 23:33:12.000000000 +0200 @@ -0,0 +1,90 @@ +-- | +-- Convert Haskell values to and from HTTP API data +-- such as URL pieces, headers and query parameters. +module Web.HttpApiData ( + -- * Examples + -- $examples + + -- * Classes + ToHttpApiData (..), + FromHttpApiData (..), + + -- * @'Maybe'@ parsers + parseUrlPieceMaybe, + parseHeaderMaybe, + parseQueryParamMaybe, + + -- * Prefix parsers + parseUrlPieceWithPrefix, + parseHeaderWithPrefix, + parseQueryParamWithPrefix, + + -- * Multiple URL pieces + toUrlPieces, + parseUrlPieces, + + -- * Multiple query params + toQueryParams, + parseQueryParams, + + -- * Parsers for @'Bounded'@ @'Enum'@s + parseBoundedUrlPiece, + parseBoundedQueryParam, + parseBoundedHeader, + parseBoundedEnumOf, + parseBoundedEnumOfI, + parseBoundedTextData, + + -- * Other helpers + showTextData, + readTextData, +) where + +import Web.HttpApiData.Internal + +-- $setup +-- +-- >>> :set -XOverloadedStrings +-- >>> import Control.Applicative +-- >>> import Data.Time +-- >>> import Data.Int +-- >>> import Data.Text (Text) +-- >>> import Data.Time (Day) +-- >>> import Data.Version + +-- $examples +-- +-- Booleans: +-- +-- >>> toUrlPiece True +-- "true" +-- >>> parseUrlPiece "false" :: Either Text Bool +-- Right False +-- >>> parseUrlPieces ["true", "false", "undefined"] :: Either Text [Bool] +-- Left "could not parse: `undefined'" +-- +-- Numbers: +-- +-- >>> toQueryParam 45.2 +-- "45.2" +-- >>> parseQueryParam "452" :: Either Text Int +-- Right 452 +-- >>> toQueryParams [1..5] +-- ["1","2","3","4","5"] +-- >>> parseQueryParams ["127", "255"] :: Either Text [Int8] +-- Left "out of bounds: `255' (should be between -128 and 127)" +-- +-- Strings: +-- +-- >>> toHeader "hello" +-- "hello" +-- >>> parseHeader "world" :: Either Text String +-- Right "world" +-- +-- Calendar day: +-- +-- >>> toQueryParam (fromGregorian 2015 10 03) +-- "2015-10-03" +-- >>> toGregorian <$> parseQueryParam "2016-12-01" +-- Right (2016,12,1) + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.2.3/test/DocTest.hs new/http-api-data-0.2.4/test/DocTest.hs --- old/http-api-data-0.2.3/test/DocTest.hs 2015-10-04 03:03:34.000000000 +0200 +++ new/http-api-data-0.2.4/test/DocTest.hs 2016-07-23 23:33:12.000000000 +0200 @@ -1,7 +1,30 @@ -module Main (main) where +module Main where -import System.FilePath.Glob (glob) -import Test.DocTest (doctest) +import Build_doctest (autogen_dir, deps) +import Control.Applicative +import Control.Monad +import Data.List +import System.Directory +import System.FilePath +import Test.DocTest main :: IO () -main = glob "Web/**/*.hs" >>= doctest +main = getSources >>= \sources -> doctest $ + "-isrc" + : ("-i" ++ autogen_dir) + : "-optP-include" + : ("-optP" ++ autogen_dir ++ "/cabal_macros.h") + : "-hide-all-packages" + : map ("-package="++) deps ++ sources + +getSources :: IO [FilePath] +getSources = filter (isSuffixOf ".hs") <$> go "src" + where + go dir = do + (dirs, files) <- getFilesAndDirectories dir + (files ++) . concat <$> mapM go dirs + +getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) +getFilesAndDirectories dir = do + c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir + (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.2.3/test/Spec.hs new/http-api-data-0.2.4/test/Spec.hs --- old/http-api-data-0.2.3/test/Spec.hs 2015-12-10 11:08:55.000000000 +0100 +++ new/http-api-data-0.2.4/test/Spec.hs 2016-07-23 23:33:12.000000000 +0200 @@ -10,6 +10,7 @@ import Data.Time import qualified Data.Text as T import qualified Data.Text.Lazy as L +import qualified Data.ByteString as BS import Data.Version import Test.Hspec @@ -126,3 +127,6 @@ parseUrlPieceMaybe (T.pack "256") `shouldBe` (Nothing :: Maybe Int8) parseUrlPieceMaybe (T.pack "-10") `shouldBe` (Nothing :: Maybe Word) + it "invalid utf8 is handled" $ do + parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text) +
