From 49801db15149cab5e1b211d7d06ae65d4fa0d397 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Sun, 6 Dec 2020 14:56:41 +0100
Subject: [PATCH] Revert "Move WithStatus to cookbook [WIP]"

This reverts commit 5e43135e37e0b033ce5654cdfdf9daadcc7728e3.
---
 servant/src/Servant/API.hs       |  2 +-
 servant/src/Servant/API/UVerb.hs | 33 +++++++++++++++++++++++++++++++-
 2 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs
index 146b2866..deb974ae 100644
--- a/servant/src/Servant/API.hs
+++ b/servant/src/Servant/API.hs
@@ -127,7 +127,7 @@ import           Servant.API.Sub
                  ((:>))
 import           Servant.API.UVerb
                  (HasStatus, IsMember, StatusOf, Statuses, UVerb, Union,
-                 Unique, inject, statusOf)
+                 Unique, WithStatus (..), inject, statusOf)
 import           Servant.API.Vault
                  (Vault)
 import           Servant.API.Verbs
diff --git a/servant/src/Servant/API/UVerb.hs b/servant/src/Servant/API/UVerb.hs
index d84ea7c3..f7b1f740 100644
--- a/servant/src/Servant/API/UVerb.hs
+++ b/servant/src/Servant/API/UVerb.hs
@@ -28,6 +28,7 @@ module Servant.API.UVerb
     HasStatus (StatusOf),
     statusOf,
     HasStatuses (Statuses, statuses),
+    WithStatus (..),
     module Servant.API.UVerb.Union,
   )
 where
@@ -35,7 +36,7 @@ where
 import Data.Proxy (Proxy (Proxy))
 import GHC.TypeLits (Nat)
 import Network.HTTP.Types (Status, StdMethod)
-import Servant.API.ContentTypes (MimeRender (mimeRender), MimeUnrender (mimeUnrender), NoContent)
+import Servant.API.ContentTypes (NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
 import Servant.API.Status (KnownStatus, statusVal)
 import Servant.API.UVerb.Union
 
@@ -63,6 +64,36 @@ instance (HasStatus a, HasStatuses as) => HasStatuses (a ': as) where
   type Statuses (a ': as) = StatusOf a ': Statuses as
   statuses _ = statusOf (Proxy :: Proxy a) : statuses (Proxy :: Proxy as)
 
+-- | A simple newtype wrapper that pairs a type with its status code.  It
+-- implements all the content types that Servant ships with by default.
+newtype WithStatus (k :: Nat) a = WithStatus a
+  deriving (Eq, Show)
+
+instance MimeRender ctype a => MimeRender ctype (WithStatus _status a) where
+  mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
+
+instance MimeUnrender ctype a => MimeUnrender ctype (WithStatus _status a) where
+  mimeUnrender contentTypeProxy input =
+    WithStatus <$> mimeUnrender contentTypeProxy input
+
+-- | an instance of this typeclass assigns a HTTP status code to a return type
+--
+-- Example:
+--
+-- @
+--    data NotFoundError = NotFoundError String
+--
+--    instance HasStatus NotFoundError where
+--      type StatusOf NotFoundError = 404
+-- @
+--
+-- You can also use the convience newtype wrapper 'WithStatus' if you want to
+-- avoid writing a 'HasStatus' instance manually. It also has the benefit of
+-- showing the status code in the type; which might aid in readability.
+instance KnownStatus n => HasStatus (WithStatus n a) where
+  type StatusOf (WithStatus n a) = n
+
+
 -- | A variant of 'Verb' that can have any of a number of response values and status codes.
 --
 -- FUTUREWORK: it would be nice to make 'Verb' a special case of 'UVerb', and only write