From a5f4e27c1901afd39e2cec2c4a82045a13a1d12c Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Wed, 18 Jan 2017 13:57:15 +0200
Subject: [PATCH] Add LenientData

---
 src/Web/HttpApiData.hs          |  3 +++
 src/Web/Internal/HttpApiData.hs | 18 ++++++++++++++++++
 2 files changed, 21 insertions(+)

diff --git a/src/Web/HttpApiData.hs b/src/Web/HttpApiData.hs
index d4e2abf..b6c607f 100644
--- a/src/Web/HttpApiData.hs
+++ b/src/Web/HttpApiData.hs
@@ -35,6 +35,9 @@ module Web.HttpApiData (
   parseBoundedEnumOfI,
   parseBoundedTextData,
 
+  -- * Lenient data
+  LenientData (..),
+
   -- * Other helpers
   showTextData,
   readTextData,
diff --git a/src/Web/Internal/HttpApiData.hs b/src/Web/Internal/HttpApiData.hs
index f029df7..1e8131b 100644
--- a/src/Web/Internal/HttpApiData.hs
+++ b/src/Web/Internal/HttpApiData.hs
@@ -1,5 +1,9 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -11,6 +15,7 @@ module Web.Internal.HttpApiData where
 
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative
+import Data.Foldable (Foldable)
 import Data.Traversable (Traversable(traverse))
 #endif
 
@@ -48,6 +53,9 @@ import TextShow (TextShow, showt)
 
 import qualified Data.UUID.Types as UUID
 
+import Data.Typeable (Typeable)
+import Data.Data (Data)
+
 -- $setup
 -- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
 -- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
@@ -586,3 +594,13 @@ instance ToHttpApiData UUID.UUID where
 instance FromHttpApiData UUID.UUID where
     parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
     parseHeader   = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
+
+
+-- | Lenient parameters. 'FromHttpApiData' combinators always return `Right`.
+newtype LenientData a = LenientData { getLenientData :: Either Text a }
+    deriving (Eq, Ord, Show, Read, Typeable, Data, Functor, Foldable, Traversable)
+
+instance FromHttpApiData a => FromHttpApiData (LenientData a) where
+    parseUrlPiece   = Right . LenientData . parseUrlPiece
+    parseHeader     = Right . LenientData . parseHeader
+    parseQueryParam = Right . LenientData . parseQueryParam