From a1a2ab2d915f55c949cebe7fb7f22bb93ee01bbe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Th=C3=A9ophile=20Choutri=20de=20Tarl=C3=A9?=
 <theophile@choutri.eu>
Date: Thu, 30 Jan 2025 20:59:01 +0100
Subject: [PATCH] Use new instances

---
 src/web/FloraWeb/Pages/Routes/Sessions.hs | 41 ++++++++++++++---------
 1 file changed, 26 insertions(+), 15 deletions(-)

diff --git a/src/web/FloraWeb/Pages/Routes/Sessions.hs b/src/web/FloraWeb/Pages/Routes/Sessions.hs
index 78da13a3..1b68fd62 100644
--- a/src/web/FloraWeb/Pages/Routes/Sessions.hs
+++ b/src/web/FloraWeb/Pages/Routes/Sessions.hs
@@ -4,6 +4,7 @@ module FloraWeb.Pages.Routes.Sessions where
 
 import Data.Text
 import Generics.SOP (I (..), NP (..), NS (..))
+import Generics.SOP qualified as GSOP
 import Lucid
 import Servant.API
 import Servant.API.ContentTypes.Lucid
@@ -14,6 +15,10 @@ import Web.FormUrlEncoded
 
 import Flora.Model.PersistentSession
 
+instance AsConstructor '[r] (WithHeaders hs r (RespondEmpty code desc)) where
+  toConstructor x = I x :* Nil
+  fromConstructor (I x :* Nil) = x
+
 type Routes = NamedRoutes Routes'
 
 type NewSession =
@@ -39,17 +44,24 @@ data NewSessionResult
   | AuthenticationRequired (Html ())
   deriving stock (Generic)
 
-instance AsUnion NewSessionResponses NewSessionResult where
-  toUnion (AlreadyAuthenticated location) = Z (I ((), location))
-  toUnion (AuthenticationRequired response) = S (Z (I response))
+instance GSOP.Generic NewSessionResult
+
+deriving via
+  GenericAsUnion NewSessionResponses NewSessionResult
+  instance
+    AsUnion NewSessionResponses NewSessionResult
 
-  fromUnion (Z (I ((), location))) = AlreadyAuthenticated location
-  fromUnion (S (Z (I response))) = AuthenticationRequired response
-  fromUnion (S (S x)) = case x of {}
+-- instance AsUnion NewSessionResponses NewSessionResult where
+--   toUnion (AlreadyAuthenticated location) = Z (I ((), location))
+--   toUnion (AuthenticationRequired response) = S (Z (I response))
+--
+--   fromUnion (Z (I ((), location))) = AlreadyAuthenticated location
+--   fromUnion (S (Z (I response))) = AuthenticationRequired response
+--   fromUnion (S (S x)) = case x of {}
 
-instance AsHeaders '[Text, SetCookie] () (Text, SetCookie) where
-  toHeaders (location, cookie) = (I location :* I cookie :* Nil, ())
-  fromHeaders (I location :* I cookie :* Nil, ()) = (location, cookie)
+-- instance AsHeaders '[Text, SetCookie] () (Text, SetCookie) where
+--   toHeaders (location, cookie) = (I location :* I cookie :* Nil, ())
+--   fromHeaders (I location :* I cookie :* Nil, ()) = (location, cookie)
 
 type CreateSession =
   "new"
@@ -75,13 +87,12 @@ data CreateSessionResult
   | AuthenticationSuccess (Text, SetCookie)
   deriving stock (Generic)
 
-instance AsUnion CreateSessionResponses CreateSessionResult where
-  toUnion (AuthenticationFailure body) = Z (I body)
-  toUnion (AuthenticationSuccess (location, cookie)) = S (Z (I (location, cookie)))
+instance GSOP.Generic CreateSessionResult
 
-  fromUnion (Z (I body)) = AuthenticationFailure body
-  fromUnion (S (Z (I headers))) = AuthenticationSuccess headers
-  fromUnion (S (S x)) = case x of {}
+deriving via
+  GenericAsUnion CreateSessionResponses CreateSessionResult
+  instance
+    AsUnion CreateSessionResponses CreateSessionResult
 
 type DeleteSession =
   "delete"