packages feed

http-api-data 0.2.3 → 0.2.4

raw patch · 9 files changed

+756/−675 lines, 9 filesdep +directorydep +filepathdep −Globdep ~doctestbuild-type:Customsetup-changed

Dependencies added: directory, filepath

Dependencies removed: Glob

Dependency ranges changed: doctest

Files

CHANGELOG.md view
@@ -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.
Setup.lhs view
@@ -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}
− Web/HttpApiData.hs 
@@ -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)-
− Web/HttpApiData/Internal.hs 
@@ -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-
http-api-data.cabal view
@@ -1,5 +1,5 @@ name:            http-api-data-version:         0.2.3+version:         0.2.4 license:         BSD3 license-file:    LICENSE author:          Nickolay Kudasov <nickolay.kudasov@gmail.com>@@ -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
+ src/Web/HttpApiData.hs view
@@ -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)+
+ src/Web/HttpApiData/Internal.hs view
@@ -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+
test/DocTest.hs view
@@ -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
test/Spec.hs view
@@ -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@@ -125,4 +126,7 @@   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)