srid/ema
1
1
Fork 0
mirror of https://github.com/srid/ema.git synced 2024-11-29 09:25:14 +03:00
Code Issues Projects Releases Wiki Activity

subRoutesIso doesn't havae to be a class method

Browse Source
This commit is contained in:
Sridhar Ratnakumar 2022-07-02 14:11:41 -04:00
parent 192760d689
commit 505168f783
2 changed files with 13 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Ema/Route/Generic.hs
View File

@ -32,7 +32,7 @@ import Ema.Route.Lib.Folder (FolderRoute (FolderRoute))
import Ema.Route.Lib.Multi (MultiModel, MultiRoute)
import GHC.Generics qualified as GHC
import Generics.SOP (All, I (..), NP)
import Optics.Core (ReversibleOptic (re), equality, review)
import Optics.Core (ReversibleOptic (re), coercedTo, equality, review, (%))
import Prelude hiding (All, Generic)
-- | DerivingVia type to generically derive `IsRoute`
@ -125,10 +125,6 @@ instance
HasSubRoutes (GenericRoute r opts)
where
type SubRoutes (GenericRoute r opts) = OptSubRoutes r opts
subRoutesIso' =
(,)
(gtoSubRoutes @r @(OptSubRoutes r opts) . rfrom . coerce @_ @r)
(coerce @r . rto . gfromSubRoutes @r)
instance
( GSubModels (RouteModel (GenericRoute r opts)) (MultiModel (OptSubRoutes r opts)) (OptSubModels r opts)
@ -152,7 +148,6 @@ instance
, mm ~ MultiModel (SubRoutes r)
, a ~ RouteModel r
, a ~ OptModel r opts
, SubRoutes r ~ OptSubRoutes r opts
, IsRoute mr
, RouteModel mr ~ NP I mm
, GenericRouteOpts r opts
@ -162,7 +157,7 @@ instance
type RouteModel (GenericRoute r opts) = OptModel r opts
routeEncoder =
routeEncoder @mr
& mapRouteEncoder equality (re subRoutesIso) (subModels @r)
& mapRouteEncoder equality (re (subRoutesIso @r) % coercedTo) (subModels @r)
allRoutes m =
GenericRoute . review subRoutesIso
<$> allRoutes (subModels @r m)

29
src/Ema/Route/Generic/SubRoute.hs
View File

@ -4,7 +4,7 @@
{-# LANGUAGE UndecidableInstances #-}
module Ema.Route.Generic.SubRoute (
HasSubRoutes (SubRoutes, subRoutesIso'),
HasSubRoutes (SubRoutes),
subRoutesIso,
-- DerivingVia types
GSubRoutes,
@ -15,7 +15,7 @@ module Ema.Route.Generic.SubRoute (
import Data.SOP.Constraint (AllZipF)
import Data.SOP.NS (trans_NS)
import Ema.Route.Generic.RGeneric (RConstructorNames, RDatatypeName, RGeneric (..))
import Ema.Route.Generic.RGeneric (RGeneric (..))
import Ema.Route.Lib.Multi (MultiRoute)
import GHC.TypeLits (AppendSymbol, Symbol)
#if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
@ -41,22 +41,15 @@ class HasSubRoutes r where
-- | The sub-routes in the `r` (for each constructor).
type SubRoutes r :: [Type]
type SubRoutes r = GSubRoutes (RDatatypeName r) (RConstructorNames r) (RCode r)
-- You should use @subRoutesIso@ instead of this function directly.
subRoutesIso' :: ((r -> MultiRoute (SubRoutes r)), (MultiRoute (SubRoutes r) -> r))
default subRoutesIso' ::
( RGeneric r
, ValidSubRoutes r (SubRoutes r)
) =>
((r -> MultiRoute (SubRoutes r)), (MultiRoute (SubRoutes r) -> r))
subRoutesIso' =
(,) (gtoSubRoutes @r . rfrom) (rto . gfromSubRoutes @r)
-- We cannot put this inside the `HasSubRoutes` type-class due to coercion issues with DerivingVia
-- See https://stackoverflow.com/a/71490273/55246
subRoutesIso :: HasSubRoutes r => Iso' r (MultiRoute (SubRoutes r))
subRoutesIso = uncurry iso subRoutesIso'
subRoutesIso ::
forall r.
( RGeneric r
, HasSubRoutes r
, ValidSubRoutes r (SubRoutes r)
) =>
Iso' r (MultiRoute (SubRoutes r))
subRoutesIso =
iso (gtoSubRoutes @r . rfrom) (rto . gfromSubRoutes @r)
gtoSubRoutes ::
forall r subRoutes.