lens-sop 0.2.0.3 → 0.3.0

raw patch · 5 files changed

+120/−116 lines, 5 filesdep +optics-coredep −fclabelsdep ~basedep ~transformersnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: optics-core

Dependencies removed: fclabels

Dependency ranges changed: base, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• lens-sop.cabal +13/−16
• src/Generics/SOP/Lens.hs +52/−54
• src/Generics/SOP/Lens/Computed.hs +39/−35
• src/Generics/SOP/Lens/Named.hs +9/−11

@@ -0,0 +1,7 @@+# Change log++## 0.3 - 2023-02-22++This release modernizes the library a bit (breaking backwards compatibility):+instead of providing interoperability with `fclabels`, it instead uses+`optics-core`, and instead of using arrows, it uses monads.

@@ -1,13 +1,11 @@ name:                lens-sop-version:             0.2.0.3+version:             0.3.0 synopsis:            Computing lenses generically using generics-sop description:-  This library contains a definition of generalized lenses that are built-  on top of the @<https://hackage.haskell.org/package/fclabels fclabels>@ package.-  .-  It also contains SOP-style generic functions (based on the-  @<https://hackage.haskell.org/package/generics-sop generics-sop>@ package) that-  compute lenses for a given record type. Generalized lenses for the+  This library contains a definition of generalized lenses, along with SOP-style+  generic functions (based on+  @<https://hackage.haskell.org/package/generics-sop generics-sop>@)+  that compute lenses for a given record type. Generalized lenses for the   SOP representation types are also provided.   .   Furthermore, a generic function is provided that computes a lens from@@ -20,7 +18,8 @@ category:            Generics build-type:          Simple cabal-version:       >=1.10-tested-with:         GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5+extra-source-files: CHANGELOG.md+tested-with:         GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.5 || ==9.4.4  source-repository head   type:                git@@ -30,15 +29,15 @@   exposed-modules:     Generics.SOP.Lens                        Generics.SOP.Lens.Named                        Generics.SOP.Lens.Computed-  build-depends:       base                 >= 4.6   && < 5,-                       generics-sop         >= 0.2.3 && < 0.6,-                       fclabels             >= 2.0   && < 2.1,-                       transformers         >= 0.3   && < 0.6+  build-depends:       base          >= 4.6   && < 4.18,+                       generics-sop  >= 0.2.3 && < 0.6,+                       optics-core   >= 0.4   && < 0.5,+                       transformers  >= 0.3   && < 0.7   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -Wall-  default-extensions:  CPP-                       ScopedTypeVariables+                       -Wredundant-constraints+  default-extensions:  ScopedTypeVariables                        TypeFamilies                        RankNTypes                        TypeOperators@@ -55,5 +54,3 @@                        KindSignatures                        DataKinds                        FunctionalDependencies-  if impl (ghc >= 7.8)-    default-extensions:  AutoDeriveTypeable

@@ -26,98 +26,96 @@   , i   ) where -import Prelude hiding (id, (.), curry, uncurry, const, head, tail)-import Control.Arrow-import Control.Category-import Data.Label.Mono (Lens)-import Data.Label.Point (Iso(..))-import qualified Data.Label.Mono as Lens+import Prelude hiding (id, (.), head, tail) +import Control.Category+import Control.Monad+import Data.Functor.Identity+import Data.Kind import Generics.SOP+import Optics.Core (Optic', Is, A_Getter, A_Setter) +import qualified Optics.Core as Optics+ {-------------------------------------------------------------------------------   Generalized lens using two categories -------------------------------------------------------------------------------} --- | GLens generalizes a monomorphic lens by allowing for different categories+-- | GLens generalizes a monomorphic lens by allowing for different monads -- for the getter and modifier-data GLens r w a b = GLens (r a b) (w (w b b, a) a)+data GLens (r :: Type -> Type) (w :: Type -> Type) a b =+    GLens (a -> r b) ((b -> w b) -> (a -> w a)) -instance (Category r, ArrowApply w) => Category (GLens r w) where-  id = GLens id app-  (GLens f m) . (GLens g n) = GLens (f . g) (uncurry (curry n . curry m))+instance Monad r => Category (GLens r w) where+  id = GLens pure id+  (GLens f m) . (GLens g n) = GLens (f <=< g) (n . m) -lens :: r a b -> w (w b b, a) a -> GLens r w a b+lens :: (a -> r b) -> ((b -> w b) -> a -> w a) -> GLens r w a b lens = GLens -get :: GLens r w a b -> r a b+get :: GLens r w a b -> a -> r b get (GLens f _) = f -modify :: GLens r w a b -> w (w b b, a) a+modify :: GLens r w a b -> (b -> w b) -> a -> w a modify (GLens _ g) = g -set :: Arrow w => GLens r w a b -> w (b, a) a-set l = modify l . first (arr const)+set :: Monad w => GLens r w a b -> b -> a -> w a+set l = modify l . const . pure  {-------------------------------------------------------------------------------   Conversion -------------------------------------------------------------------------------} -fromLens :: (Arrow r, ArrowApply w) => Lens (->) a b -> GLens r w a b-fromLens l =-  GLens (arr (Lens.get l))-        (uncurry $ \h -> arr (Lens.set l) . (h . arr (Lens.get l) &&& id))+fromOptics ::+     (Is k A_Getter, Is k A_Setter, Monad r, Monad w)+  => Optic' k is a b -> GLens r w a b+fromOptics l =+    GLens+      (return . Optics.view l)+      (\f a -> (\b -> Optics.set l b a) <$> f (Optics.view l a)) -fromIso :: (Arrow r, ArrowApply w) => Iso (->) a b -> GLens r w a b-fromIso (Iso f g) = GLens (arr f) (uncurry $ \h -> arr g . h . arr f)+fromLens :: (Monad r, Monad w) => Optics.Lens' a b -> GLens r w a b+fromLens = fromOptics -toLens :: GLens cat cat a b -> Lens cat a b-toLens (GLens f g) = Lens.lens f g+fromIso :: (Monad r, Monad w) => Optics.Iso' a b -> GLens r w a b+fromIso = fromOptics +toLens :: GLens Identity Identity a b -> Optics.Lens' a b+toLens l = Optics.lens (runIdentity . get l) (\a b -> runIdentity $ set l b a)+ {-------------------------------------------------------------------------------   Generic computation of all lenses for a record type -------------------------------------------------------------------------------} -glenses :: forall r w a xs. (Generic a, Code a ~ '[xs], Arrow r, ArrowApply w) => NP (GLens r w a) xs-glenses = case sList :: SList (Code a) of-            SCons -> hliftA (\l -> l . sop . rep) np-#if __GLASGOW_HASKELL__ < 800-            _     -> error "inaccessible"-#endif+glenses :: forall r w a xs.+     (Generic a, Code a ~ '[xs], Monad r, Monad w)+  => NP (GLens r w a) xs+glenses =+    case sList :: SList (Code a) of+      SCons -> hliftA (\l -> l . sop . rep) np  {-------------------------------------------------------------------------------   Generalized lenses for representation types -------------------------------------------------------------------------------} -np :: forall r w xs. (Arrow r, ArrowApply w, SListI xs) => NP (GLens r w (NP I xs)) xs+np :: forall r w xs.+     (Monad r, Monad w, SListI xs)+  => NP (GLens r w (NP I xs)) xs np = case sList :: SList xs of       SNil  -> Nil       SCons -> i . head :* hliftA (. tail) np -rep :: (Arrow r, ArrowApply w, Generic a) => GLens r w a (Rep a)-rep = fromIso $ Iso from to--sop :: (Arrow r, ArrowApply w) => GLens r w (SOP f '[xs]) (NP f xs)-sop = fromIso $ Iso (\(SOP (Z x)) -> x) (SOP . Z)--head :: (Arrow r, ArrowApply w) => GLens r w (NP f (x ': xs)) (f x)-head = fromLens $ Lens.lens (\(x :* _) -> x) (\(f, x :* xs) -> (f x :* xs))--tail :: (Arrow r, ArrowApply w) => GLens r w (NP f (x ': xs)) (NP f xs)-tail = fromLens $ Lens.lens (\(_ :* xs) -> xs) (\(f, x :* xs) -> (x :* f xs))--i :: (Arrow r, ArrowApply w) => GLens r w (I a) a-i = fromIso $ Iso unI I+rep :: (Monad r, Monad w, Generic a) => GLens r w a (Rep a)+rep = fromIso $ Optics.iso from to -{--------------------------------------------------------------------------------  Auxiliary--------------------------------------------------------------------------------}+sop :: (Monad r, Monad w) => GLens r w (SOP f '[xs]) (NP f xs)+sop = fromIso $ Optics.iso (unZ . unSOP) (SOP . Z) -const :: Arrow arr => c -> arr b c-const a = arr (\_ -> a)+head :: (Monad r, Monad w) => GLens r w (NP f (x ': xs)) (f x)+head = fromLens $ Optics.lens (\(x :* _) -> x) (\(_ :* xs) x -> x :* xs) -curry :: Arrow cat => cat (a, b) c -> (a -> cat b c)-curry m a = m . (const a &&& id)+tail :: (Monad r, Monad w) => GLens r w (NP f (x ': xs)) (NP f xs)+tail = fromLens $ Optics.lens (\(_ :* xs) -> xs) (\(x :* _) xs -> (x :* xs)) -uncurry :: ArrowApply cat => (a -> cat b c) -> cat (a, b) c-uncurry a = app . arr (first a)+i :: (Monad r, Monad w) => GLens r w (I a) a+i = fromIso $ Optics.iso unI I

@@ -22,7 +22,7 @@   ) where  import Prelude hiding (id, (.))-import Control.Arrow+ import Control.Category import Control.Monad import Data.Functor.Identity@@ -30,6 +30,7 @@  import Generics.SOP import Generics.SOP.Lens (GLens)+ import qualified Generics.SOP.Lens as GLens  {-------------------------------------------------------------------------------@@ -44,14 +45,15 @@   forall x. c x => AbstractLens (GLens r w a x)  -- | Identity abstract lens-abstractId :: (ArrowApply r, ArrowApply w, c a) => AbstractLens r w c a+abstractId :: (Monad r, c a) => AbstractLens r w c a abstractId = AbstractLens id  -- | Compose with a pointwise lens on the right-afterGLens :: (ArrowApply r, ArrowApply w)-           => AbstractLens r w c   a -- ^ @a -> x@-           -> GLens        r w   b a -- ^ @b -> a@-           -> AbstractLens r w c b   -- ^ @b -> x@+afterGLens ::+     Monad r+  => AbstractLens r w c   a -- ^ @a -> x@+  -> GLens        r w   b a -- ^ @b -> a@+  -> AbstractLens r w c b   -- ^ @b -> x@ afterGLens (AbstractLens l) l' = AbstractLens (l . l')  {-------------------------------------------------------------------------------@@ -61,37 +63,40 @@ -- | Getter for computed lenses -- -- > get l == runIdentity . getM l . Identity-get :: Category r => AbstractLens r w c a -> (forall x. c x => r a x -> b) -> b+get :: AbstractLens r w c a -> (forall x. c x => (a -> r x) -> b) -> b get l f = runIdentity $ getM l (Identity . f)  -- | Setter for computed lenses -- -- > set l == runIdentity . setM l . Identity-set :: Arrow w => AbstractLens r w c a -> (forall x. c x => x) -> w a a+set :: Monad w => AbstractLens r w c a -> (forall x. c x => x) -> a -> w a set l x = runIdentity $ setM l (Identity x)  -- | Modifier for computed lenses-modify :: Arrow w => AbstractLens r w c a -> (forall x. c x => w x x) -> w a a+modify :: AbstractLens r w c a -> (forall x. c x => x -> w x) -> a -> w a modify l f = runIdentity $ modifyM l (Identity f)  -- | Getter with possibility for "compile time" failure-getM :: (Monad m, Category r)-     => AbstractLens r w c a-     -> (forall x. c x => r a x -> m b)+getM :: AbstractLens r w c a+     -> (forall x. c x => (a -> r x) -> m b)      -> m b getM (AbstractLens l) k = k (GLens.get l)  -- | Setter with possibility for "compile time" failure-setM :: (Monad m, Arrow w)-     => AbstractLens r w c a -> (forall x. c x => m x) -> m (w a a)-setM (AbstractLens l) mx =-  mx >>= \x -> return $ GLens.set l . arr (\a -> (x, a))+setM ::+     (Monad w, Functor m)+  => AbstractLens r w c a+  -> (forall x. c x => m x)+  -> m (a -> w a)+setM (AbstractLens l) x = fmap (GLens.set l) x  -- | Modifier with possibility for "compile time" failure-modifyM :: (Monad m, Arrow w)-        => AbstractLens r w c a -> (forall x. c x => m (w x x)) -> m (w a a)-modifyM (AbstractLens l) mf =-  mf >>= \f -> return $ GLens.modify l . arr (\a -> (f, a))+modifyM ::+     Functor m+  => AbstractLens r w c a+  -> (forall x. c x => m (x -> w x))+  -> m (a -> w a)+modifyM (AbstractLens l) f = fmap (GLens.modify l) f  {-------------------------------------------------------------------------------   Paths@@ -124,17 +129,16 @@ -- However, the lenses returned by the generic computation are pure and total -- (as is evident from the type of glens). class CLens r w c a where-  default lens :: ( Generic a-                  , HasDatatypeInfo a-                  , ArrowApply r-                  , ArrowApply w+  lens :: LensOptions -> Path -> Either String (AbstractLens r w c a)++  default lens :: ( HasDatatypeInfo a+                  , Monad r+                  , Monad w                   , c a                   , Code a ~ '[xs]                   , All (CLens r w c) xs                   )                => LensOptions -> Path -> Either String (AbstractLens r w c a)--  lens :: LensOptions -> Path -> Either String (AbstractLens r w c a)   lens = glens  {-------------------------------------------------------------------------------@@ -151,8 +155,9 @@ -- Text, etc. -- -- > instance CLens c Int where lens = emptyPathOnly-emptyPathOnly :: (ArrowApply r, ArrowApply w, c a)-              => LensOptions -> Path -> Either String (AbstractLens r w c a)+emptyPathOnly ::+     (Monad r, c a)+  => LensOptions -> Path -> Either String (AbstractLens r w c a) emptyPathOnly _ [] = Right $ abstractId emptyPathOnly _ _  = Left "Trying to look inside abstract type" @@ -176,9 +181,8 @@ -------------------------------------------------------------------------------}  glens :: forall r w a c xs.-         ( ArrowApply r-         , ArrowApply w-         , Generic a+         ( Monad r+         , Monad w          , HasDatatypeInfo a          , c a          , Code a ~ '[xs]@@ -190,8 +194,8 @@                          . glens' opts p ps                          $ datatypeInfo (Proxy :: Proxy a) -glens' :: ( ArrowApply r-          , ArrowApply w+glens' :: ( Monad r+          , Monad w           , All (CLens r w c) xs           )        => LensOptions -> String -> Path@@ -201,8 +205,8 @@   glens'' opts ps (datatypeName d) p (hd (constructorInfo d))  glens'' :: forall r w c xs.-           ( ArrowApply r-           , ArrowApply w+           ( Monad r+           , Monad w            , All (CLens r w c) xs            )         => LensOptions -> Path

@@ -21,20 +21,20 @@  -- | Total abstract lens data NamedLens a ctxt = forall b. ctxt b => NamedLens {-    unNamedLens :: GLens (->) (->) a b+    unNamedLens :: GLens I I a b   }  instance Show (NamedLens a ctxt) where   show _ = "<<NamedLens>"  get :: NamedLens a ctxt -> (forall b. ctxt b => b -> c) -> a -> c-get (NamedLens l) k a = k (GLens.get l a)+get (NamedLens l) k = k . unI . GLens.get l  modify :: NamedLens a ctxt -> (forall b. ctxt b => b -> b) -> a -> a-modify (NamedLens l) f a = GLens.modify l (f, a)+modify (NamedLens l) f = unI . GLens.modify l (I . f)  set :: NamedLens a ctxt -> (forall b. ctxt b => b) -> a -> a-set (NamedLens l) f b = GLens.set l (f, b)+set (NamedLens l) b = unI . GLens.set l b  {-------------------------------------------------------------------------------   Construct named lenses@@ -43,17 +43,15 @@ -- | Construct named lenses for a record type -- -- NOTE: This will throw a runtime error for non-record types-gnamedLenses :: forall a ctxt xs. (Generic a, HasDatatypeInfo a, Code a ~ '[xs], All ctxt xs)-             => (DatatypeName -> ConstructorName -> LensName)-             -> [(String, NamedLens a ctxt)]+gnamedLenses :: forall a ctxt xs.+     (HasDatatypeInfo a, Code a ~ '[xs], All ctxt xs)+  => (DatatypeName -> ConstructorName -> LensName)+  -> [(String, NamedLens a ctxt)] gnamedLenses mkName = case sList :: SList (Code a) of     SCons -> zip (fieldNames mkName (datatypeInfo pa))                  (hcollapse $ hcliftA pc (K . NamedLens) totalLenses)-#if __GLASGOW_HASKELL__ < 800-    _     -> error "inaccessible"-#endif   where-    totalLenses :: NP (GLens (->) (->) a) xs+    totalLenses :: NP (GLens I I a) xs     totalLenses = GLens.glenses      pa :: Proxy a