git.iko.soy/jrec
on master help sign in
Add generic-optics instance
commit187646cac88cd210a485b8617e11021c4719bff9 authorSridhar Ratnakumar <srid@srid.ca> dateSun 2 Aug 2020, 13:33 (6 years ago) parent0a96582
4 files changed+27−4
compare with master
unifiedsplit
jrec.cabal+3 src/JRec.hs+15−2 src/JRec/Field.hs+2−2 src/JRec/Super.hs+7
jrec.cabal+3
@@ -51,6 +51,7 @@ library
5151 UnicodeSyntax
5252 ViewPatterns
5353 ConstraintKinds
54+ PackageImports
5455
5556 build-depends:
5657 aeson
@@ -59,7 +60,9 @@ library
5960 , deepseq
6061 , generic-data
6162 , generic-lens
63+ , generic-optics
6264 , ghc-prim
65+ , optics-core
6366 , lens
6467 , mtl
6568 , text
src/JRec.hs+15−2
@@ -12,8 +12,10 @@ module JRec
1212where
1313
1414import Control.Lens ((&), (.~), (^.), coerced)
15−import qualified Data.Generics.Product.Fields as GL
16−import qualified Data.Generics.Wrapped as GL
15+import qualified "generic-lens" Data.Generics.Product.Fields as GL
16+import qualified "generic-lens" Data.Generics.Wrapped as GL
17+import qualified "generic-optics" Data.Generics.Product.Fields as GO
18+import qualified "generic-optics" Data.Generics.Wrapped as GO
1719import Data.Proxy
1820import GHC.Exts (Any)
1921import GHC.Generics
@@ -90,6 +92,17 @@ instance {-# OVERLAPPING #-} (R.Set field fields a' ~ fields', R.Set field field
9092instance {-# OVERLAPPING #-} (R.Set field fields a ~ fields, R.Has field fields a) => GL.HasField' field (Rec fields) a where
9193 field' = R.lens (R.FldProxy @field)
9294
95+----------------------------------------------------------------------------
96+-- generic-optics
97+----------------------------------------------------------------------------
98+
99+instance {-# OVERLAPPING #-} (R.Set field fields a' ~ fields', R.Set field fields' a ~ fields, R.Has field fields a, R.Has field fields' a') => GO.HasField field (Rec fields) (Rec fields') a a' where
100+ field = R.opticLens (R.FldProxy @field)
101+
102+instance {-# OVERLAPPING #-} (R.Set field fields a ~ fields, R.Has field fields a) => GO.HasField' field (Rec fields) a where
103+ field' = R.opticLens (R.FldProxy @field)
104+
105+
93106pattern Rec ::
94107 ( RecTuple tuple fields
95108 ) =>
src/JRec/Field.hs+2−2
@@ -1,7 +1,7 @@
11module JRec.Field where
22
3−import qualified Data.Generics.Labels as GL
4−import qualified Data.Generics.Product.Fields as GL
3+import qualified "generic-lens" Data.Generics.Labels as GL
4+import qualified "generic-lens" Data.Generics.Product.Fields as GL
55import GHC.TypeLits
66
77type Field' (s :: Symbol) a b = (GL.HasField' s a b, GL.Field' s a b)
src/JRec/Super.hs+7
@@ -42,6 +42,7 @@ import GHC.ST (ST (..), runST)
4242import GHC.TypeLits
4343import Generic.Data (gshowsPrec)
4444import Generic.Data.Internal.Show (GShow)
45+import qualified Optics.Lens as OL
4546import Unsafe.Coerce
4647import Prelude
4748
@@ -660,6 +661,12 @@ lens lbl f r =
660661 fmap (\v -> set lbl v r) (f (get lbl r))
661662{-# INLINE lens #-}
662663
664+opticLens ::
665+ (Has l lts v, Set l lts v' ~ lts') => FldProxy l -> OL.Lens (Rec lts) (Rec lts') v v'
666+opticLens lbl =
667+ OL.lensVL $ lens lbl
668+{-# INLINE opticLens #-}
669+
663670class NoConstraint x
664671
665672instance NoConstraint x