From 760fd793104ae4235055ad49c94ac014f014496e Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 1 Jul 2022 12:46:21 -0400
Subject: [PATCH] Replace Coercible with GIsomorphic

---
 src/Ema/Example/Ex03_Store.hs     |  1 +
 src/Ema/Route/Generic/Example.hs  |  2 +-
 src/Ema/Route/Generic/SubRoute.hs | 29 +++++++++++++++++++++++------
 src/Ema/Route/Lib/File.hs         |  8 ++++----
 src/Ema/Route/Lib/Folder.hs       |  2 +-
 5 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/src/Ema/Example/Ex03_Store.hs b/src/Ema/Example/Ex03_Store.hs
index 323c17a..11517ec 100644
--- a/src/Ema/Example/Ex03_Store.hs
+++ b/src/Ema/Example/Ex03_Store.hs
@@ -33,6 +33,7 @@ data Model = Model
 
 newtype Slug = Slug Text
   deriving newtype (Show, Eq, Ord, IsString, ToString, FromJSON, FromJSONKey)
+  deriving stock (Generic)
 
 newtype Product = Product {unProduct :: Text}
   deriving newtype (Show, Eq, Ord, IsString, ToString, FromJSON)
diff --git a/src/Ema/Route/Generic/Example.hs b/src/Ema/Route/Generic/Example.hs
index 5262157..4434965 100644
--- a/src/Ema/Route/Generic/Example.hs
+++ b/src/Ema/Route/Generic/Example.hs
@@ -37,7 +37,7 @@ instance HasSubRoutes R where
 -}
 
 data NumRoute = NumRoute
-  deriving stock (Show, Eq)
+  deriving stock (Show, Eq, Generic)
 
 instance IsRoute NumRoute where
   type RouteModel NumRoute = Int
diff --git a/src/Ema/Route/Generic/SubRoute.hs b/src/Ema/Route/Generic/SubRoute.hs
index c325853..cde92f7 100644
--- a/src/Ema/Route/Generic/SubRoute.hs
+++ b/src/Ema/Route/Generic/SubRoute.hs
@@ -25,9 +25,10 @@ import GHC.TypeLits.Extra.Symbol (StripPrefix, ToLower)
 #else 
 import GHC.TypeLits
 #endif
-import Generics.SOP (All, I (..), NS, SameShapeAs, Top)
+import GHC.Generics qualified as GHC
+import Generics.SOP (All, I (..), NS, SameShapeAs, Top, unI)
 import Generics.SOP.Type.Metadata qualified as SOPM
-import Optics.Core (Iso', iso)
+import Optics.Core (Iso', iso, view)
 import Prelude hiding (All)
 
 {- | HasSubRoutes is a class of routes with an underlying MultiRoute (and MultiModel) representation.
@@ -77,7 +78,7 @@ gtoSubRoutes ::
   ) =>
   NS I (RCode r) ->
   MultiRoute subRoutes
-gtoSubRoutes = trans_NS (Proxy @Coercible) coerce
+gtoSubRoutes = trans_NS (Proxy @GIsomorphic) (I . view giso . unI)
 
 gfromSubRoutes ::
   forall r subRoutes.
@@ -86,7 +87,7 @@ gfromSubRoutes ::
   ) =>
   MultiRoute subRoutes ->
   NS I (RCode r)
-gfromSubRoutes = trans_NS (Proxy @Coercible) coerce
+gfromSubRoutes = trans_NS (Proxy @GIsomorphic) (I . view giso . unI)
 
 -- | @subRoutes@ are valid sub-routes of @r@
 type ValidSubRoutes r subRoutes =
@@ -94,10 +95,26 @@ type ValidSubRoutes r subRoutes =
   , SameShapeAs subRoutes (RCode r)
   , All Top (RCode r)
   , All Top subRoutes
-  , AllZipF Coercible (RCode r) subRoutes
-  , AllZipF Coercible subRoutes (RCode r)
+  , AllZipF GIsomorphic (RCode r) subRoutes
+  , AllZipF GIsomorphic subRoutes (RCode r)
   )
 
+{- | Types `a` and `b` are isomorphic via their generic representation
+
+  Unlike `Coercible` this constraint does not require that the two types have
+  identical *runtime* representation. For example, `data Foo = Foo` is not
+  coercible to `()` (they have different runtime representations), but they are
+  both isomorphic via their generic representation.
+-}
+class (Generic a, Generic b, GHC.Rep a () `Coercible` GHC.Rep b ()) => GIsomorphic a b where
+  giso :: Iso' a b
+
+instance (Generic a, Generic b, GHC.Rep a () `Coercible` GHC.Rep b ()) => GIsomorphic a b where
+  giso =
+    iso
+      (GHC.to @b @() . coerce . GHC.from @a @())
+      (GHC.to @a @() . coerce . GHC.from @b @())
+
 #if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
 type family GSubRoutes (name :: SOPM.DatatypeName) (constrs :: [SOPM.ConstructorName]) (xs :: [Type]) :: [Type] where
   GSubRoutes _ _ '[] = '[]
diff --git a/src/Ema/Route/Lib/File.hs b/src/Ema/Route/Lib/File.hs
index cbc2bc6..3596a5f 100644
--- a/src/Ema/Route/Lib/File.hs
+++ b/src/Ema/Route/Lib/File.hs
@@ -16,13 +16,13 @@ import Optics.Core (equality, prism')
 
  TODO: Can this type be simplified? See https://stackoverflow.com/q/72755053/55246
 -}
-newtype FileRoute (filename :: Symbol) = FileRoute ()
-  deriving stock (Eq, Ord, Show)
+data FileRoute (filename :: Symbol) = FileRoute
+  deriving stock (Eq, Ord, Show, Generic)
 
 instance KnownSymbol fn => IsRoute (FileRoute fn) where
   type RouteModel (FileRoute fn) = ()
   routeEncoder =
     singletonRouteEncoder (symbolVal (Proxy @fn))
-      & mapRouteEncoder equality (prism' (const ()) (const $ Just $ FileRoute ())) id
+      & mapRouteEncoder equality (prism' (const ()) (const $ Just FileRoute)) id
   allRoutes () =
-    [FileRoute ()]
+    [FileRoute]
diff --git a/src/Ema/Route/Lib/Folder.hs b/src/Ema/Route/Lib/Folder.hs
index 3ae45ff..3a46980 100644
--- a/src/Ema/Route/Lib/Folder.hs
+++ b/src/Ema/Route/Lib/Folder.hs
@@ -17,7 +17,7 @@ import Text.Show (Show (show))
 
 -- | A route that is prefixed at some URL prefix
 newtype FolderRoute (prefix :: Symbol) r = FolderRoute {unFolderRoute :: r}
-  deriving newtype (Eq, Ord)
+  deriving newtype (Eq, Ord, Generic)
 
 instance (Show r, KnownSymbol prefix) => Show (FolderRoute prefix r) where
   show (FolderRoute r) = symbolVal (Proxy @prefix) <> "/:" <> Text.Show.show r