http-api-data-0.2.4/src/0000755000000000000000000000000012744761230013135 5ustar0000000000000000http-api-data-0.2.4/src/Web/0000755000000000000000000000000012744761230013652 5ustar0000000000000000http-api-data-0.2.4/src/Web/HttpApiData/0000755000000000000000000000000012744761230016015 5ustar0000000000000000http-api-data-0.2.4/test/0000755000000000000000000000000012744761230013325 5ustar0000000000000000http-api-data-0.2.4/src/Web/HttpApiData.hs0000644000000000000000000000350412744761230016353 0ustar0000000000000000-- | -- 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) http-api-data-0.2.4/src/Web/HttpApiData/Internal.hs0000644000000000000000000005101712744761230020131 0ustar0000000000000000{-# 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 http-api-data-0.2.4/test/DocTest.hs0000644000000000000000000000154712744761230015235 0ustar0000000000000000module Main where 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 = 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 http-api-data-0.2.4/test/Spec.hs0000644000000000000000000001153312744761230014556 0ustar0000000000000000{-# Language ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where import Control.Applicative import Data.Int import Data.Char import Data.Word 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 import Test.Hspec.QuickCheck(prop) import Test.QuickCheck import Web.HttpApiData instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary instance Arbitrary L.Text where arbitrary = L.pack <$> arbitrary instance Arbitrary Day where arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary instance Arbitrary LocalTime where arbitrary = LocalTime <$> arbitrary <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60)) instance Eq ZonedTime where ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y instance Arbitrary ZonedTime where arbitrary = ZonedTime <$> arbitrary <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z'])) instance Arbitrary UTCTime where arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400)) instance Arbitrary NominalDiffTime where arbitrary = fromInteger <$> arbitrary instance Arbitrary Version where arbitrary = (version . map abs) <$> nonempty where version branch = Version branch [] nonempty = liftA2 (:) arbitrary arbitrary main :: IO () main = hspec spec (<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool (f <=> g) x = g (f x) == Right x data Proxy a = Proxy checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool) data RandomCase a = RandomCase [Bool] a instance ToHttpApiData a => Show (RandomCase a) where show rc@(RandomCase _ x) = show (toUrlPiece rc) ++ " (original: " ++ show (toUrlPiece x) ++ ")" instance Eq a => Eq (RandomCase a) where RandomCase _ x == RandomCase _ y = x == y instance Arbitrary a => Arbitrary (RandomCase a) where arbitrary = liftA2 RandomCase nonempty arbitrary where nonempty = liftA2 (:) arbitrary arbitrary instance ToHttpApiData a => ToHttpApiData (RandomCase a) where toUrlPiece (RandomCase us x) = T.pack (zipWith (\u -> if u then toUpper else toLower) (cycle us) (T.unpack (toUrlPiece x))) instance FromHttpApiData a => FromHttpApiData (RandomCase a) where parseUrlPiece s = RandomCase [] <$> parseUrlPiece s -- | Check case insensitivity for @parseUrlPiece@. checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a)) spec :: Spec spec = do describe "toUrlPiece <=> parseUrlPiece" $ do checkUrlPiece (Proxy :: Proxy ()) "()" checkUrlPiece (Proxy :: Proxy Char) "Char" checkUrlPieceI (Proxy :: Proxy Bool) "Bool" checkUrlPieceI (Proxy :: Proxy Ordering) "Ordering" checkUrlPiece (Proxy :: Proxy Int) "Int" checkUrlPiece (Proxy :: Proxy Int8) "Int8" checkUrlPiece (Proxy :: Proxy Int16) "Int16" checkUrlPiece (Proxy :: Proxy Int32) "Int32" checkUrlPiece (Proxy :: Proxy Int64) "Int64" checkUrlPiece (Proxy :: Proxy Integer) "Integer" checkUrlPiece (Proxy :: Proxy Word) "Word" checkUrlPiece (Proxy :: Proxy Word8) "Word8" checkUrlPiece (Proxy :: Proxy Word16) "Word16" checkUrlPiece (Proxy :: Proxy Word32) "Word32" checkUrlPiece (Proxy :: Proxy Word64) "Word64" checkUrlPiece (Proxy :: Proxy String) "String" checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict" checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy" checkUrlPiece (Proxy :: Proxy Day) "Day" checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime" checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime" checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime" checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime" checkUrlPiece (Proxy :: Proxy Version) "Version" checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String" checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer" checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text" checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day" it "bad integers are rejected" $ do parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int) it "bounds checking works" $ do 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) http-api-data-0.2.4/LICENSE0000644000000000000000000000253112605304272013347 0ustar0000000000000000The following license covers this documentation, and the source code, except where otherwise indicated. Copyright 2015, Nickolay Kudasov. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. http-api-data-0.2.4/Setup.lhs0000755000000000000000000000401212744761230014156 0ustar0000000000000000#!/usr/bin/runhaskell \begin{code} {-# OPTIONS_GHC -Wall #-} module Main (main) where 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 = 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} http-api-data-0.2.4/http-api-data.cabal0000644000000000000000000000354612744761230015777 0ustar0000000000000000name: http-api-data version: 0.2.4 license: BSD3 license-file: LICENSE author: Nickolay Kudasov maintainer: Nickolay Kudasov synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters. description: Please see README.md homepage: http://github.com/fizruk/http-api-data category: Web stability: unstable cabal-version: >= 1.8 build-type: Custom extra-source-files: test/*.hs CHANGELOG.md README.md flag use-text-show description: Use text-show library for efficient ToHttpApiData implementations. default: False library hs-source-dirs: src/ build-depends: base >= 4.6 && < 4.10 , text >= 0.5 , bytestring , time , time-locale-compat >=0.1.1.0 && <0.2 if flag(use-text-show) cpp-options: -DUSE_TEXT_SHOW build-depends: text-show >= 2 exposed-modules: Web.HttpApiData Web.HttpApiData.Internal ghc-options: -Wall test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test/ ghc-options: -Wall build-depends: HUnit , hspec >= 1.3 , base >= 4 && < 5 , QuickCheck , http-api-data , text , time , bytestring test-suite doctest 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 location: https://github.com/fizruk/http-api-data http-api-data-0.2.4/test/DocTest.hs0000644000000000000000000000154712744761230015235 0ustar0000000000000000module Main where 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 = 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 http-api-data-0.2.4/test/Spec.hs0000644000000000000000000001153312744761230014556 0ustar0000000000000000{-# Language ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where import Control.Applicative import Data.Int import Data.Char import Data.Word 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 import Test.Hspec.QuickCheck(prop) import Test.QuickCheck import Web.HttpApiData instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary instance Arbitrary L.Text where arbitrary = L.pack <$> arbitrary instance Arbitrary Day where arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary instance Arbitrary LocalTime where arbitrary = LocalTime <$> arbitrary <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60)) instance Eq ZonedTime where ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y instance Arbitrary ZonedTime where arbitrary = ZonedTime <$> arbitrary <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z'])) instance Arbitrary UTCTime where arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400)) instance Arbitrary NominalDiffTime where arbitrary = fromInteger <$> arbitrary instance Arbitrary Version where arbitrary = (version . map abs) <$> nonempty where version branch = Version branch [] nonempty = liftA2 (:) arbitrary arbitrary main :: IO () main = hspec spec (<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool (f <=> g) x = g (f x) == Right x data Proxy a = Proxy checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool) data RandomCase a = RandomCase [Bool] a instance ToHttpApiData a => Show (RandomCase a) where show rc@(RandomCase _ x) = show (toUrlPiece rc) ++ " (original: " ++ show (toUrlPiece x) ++ ")" instance Eq a => Eq (RandomCase a) where RandomCase _ x == RandomCase _ y = x == y instance Arbitrary a => Arbitrary (RandomCase a) where arbitrary = liftA2 RandomCase nonempty arbitrary where nonempty = liftA2 (:) arbitrary arbitrary instance ToHttpApiData a => ToHttpApiData (RandomCase a) where toUrlPiece (RandomCase us x) = T.pack (zipWith (\u -> if u then toUpper else toLower) (cycle us) (T.unpack (toUrlPiece x))) instance FromHttpApiData a => FromHttpApiData (RandomCase a) where parseUrlPiece s = RandomCase [] <$> parseUrlPiece s -- | Check case insensitivity for @parseUrlPiece@. checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a)) spec :: Spec spec = do describe "toUrlPiece <=> parseUrlPiece" $ do checkUrlPiece (Proxy :: Proxy ()) "()" checkUrlPiece (Proxy :: Proxy Char) "Char" checkUrlPieceI (Proxy :: Proxy Bool) "Bool" checkUrlPieceI (Proxy :: Proxy Ordering) "Ordering" checkUrlPiece (Proxy :: Proxy Int) "Int" checkUrlPiece (Proxy :: Proxy Int8) "Int8" checkUrlPiece (Proxy :: Proxy Int16) "Int16" checkUrlPiece (Proxy :: Proxy Int32) "Int32" checkUrlPiece (Proxy :: Proxy Int64) "Int64" checkUrlPiece (Proxy :: Proxy Integer) "Integer" checkUrlPiece (Proxy :: Proxy Word) "Word" checkUrlPiece (Proxy :: Proxy Word8) "Word8" checkUrlPiece (Proxy :: Proxy Word16) "Word16" checkUrlPiece (Proxy :: Proxy Word32) "Word32" checkUrlPiece (Proxy :: Proxy Word64) "Word64" checkUrlPiece (Proxy :: Proxy String) "String" checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict" checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy" checkUrlPiece (Proxy :: Proxy Day) "Day" checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime" checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime" checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime" checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime" checkUrlPiece (Proxy :: Proxy Version) "Version" checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String" checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer" checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text" checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day" it "bad integers are rejected" $ do parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int) it "bounds checking works" $ do 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) http-api-data-0.2.4/CHANGELOG.md0000644000000000000000000000154612744761230014165 0ustar00000000000000000.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. 0.2.2 --- * Add instances for more `time` types: `LocalTime`, `ZonedTime`, `UTCTime` and `NominalDiffTime` 0.2.1 --- * Add helpers for multiple URL pieces and query params: * `toUrlPieces`, `parseUrlPieces` * `toQueryParams`, `parseQueryParams` 0.2 --- * Export helper functions from `Web.HttpApiData`: * `parseUrlPieceMaybe`, `parseHeaderMaybe`, `parseQueryParamMaybe` * `parseUrlPieceWithPrefix`, `parseHeaderWithPrefix`, `parseQueryParamWithPrefix` * `showTextData`, `readTextData`, `parseBoundedTextData` * Fix AMP related warnings 0.1.1 --- * Add `use-text-show` flag to optionally use more efficient `TextShow` instances http-api-data-0.2.4/README.md0000644000000000000000000000223712606754411013631 0ustar0000000000000000# http-api-data [![Hackage package](http://img.shields.io/hackage/v/http-api-data.svg)](http://hackage.haskell.org/package/http-api-data) [![Build Status](https://secure.travis-ci.org/fizruk/http-api-data.png?branch=master)](http://travis-ci.org/fizruk/http-api-data) This package defines typeclasses used for converting Haskell data types to and from HTTP API data. ### 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) ``` ## Contributing Contributions and bug reports are welcome!