@@ -1,5 +1,9 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveFunctor #-}
5+{-# LANGUAGE DeriveFoldable #-}
6+{-# LANGUAGE DeriveTraversable #-}
37{-# LANGUAGE FlexibleInstances #-}
48{-# LANGUAGE OverloadedStrings #-}
59{-# LANGUAGE ScopedTypeVariables #-}
@@ -11,6 +15,7 @@ module Web.Internal.HttpApiData where
1115
1216#if __GLASGOW_HASKELL__ < 710
1317import Control.Applicative
18+import Data.Foldable (Foldable)
1419import Data.Traversable (Traversable(traverse))
1520#endif
1621
@@ -48,6 +53,9 @@ import TextShow (TextShow, showt)
4853
4954import qualified Data.UUID.Types as UUID
5055
56+import Data.Typeable (Typeable)
57+import Data.Data (Data)
58+
5159-- $setup
5260-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
5361-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
@@ -586,3 +594,13 @@ instance ToHttpApiData UUID.UUID where
586594instance FromHttpApiData UUID.UUID where
587595 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
588596 parseHeader = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
597+
598+
599+-- | Lenient parameters. 'FromHttpApiData' combinators always return `Right`.
600+newtype LenientData a = LenientData { getLenientData :: Either Text a }
601+ deriving (Eq, Ord, Show, Read, Typeable, Data, Functor, Foldable, Traversable)
602+
603+instance FromHttpApiData a => FromHttpApiData (LenientData a) where
604+ parseUrlPiece = Right . LenientData . parseUrlPiece
605+ parseHeader = Right . LenientData . parseHeader
606+ parseQueryParam = Right . LenientData . parseQueryParam