optics-vl 0.2 → 0.2.1

raw patch · 3 files changed

+92/−21 lines, 3 filesdep ~optics-corePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: optics-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• optics-vl.cabal +3/−3
• src/Optics/VL.hs +86/−18

@@ -1,3 +1,6 @@+# optics-vl-0.2.1 (2020-04-15)+* Provide conversions from `Iso`/`Prism` to their VL representation+ # optics-vl-0.2 (2019-10-18) * Depend on new `indexed-profunctors` package 

@@ -1,12 +1,12 @@ name:          optics-vl-version:       0.2+version:       0.2.1 license:       BSD3 license-file:  LICENSE build-type:    Simple maintainer:    optics@well-typed.com author:        Andrzej Rybczak cabal-version: 1.24-tested-with:   ghc ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1, GHCJS ==8.4+tested-with:   ghc ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.3 || ==8.10.1, GHCJS ==8.4 synopsis:      Utilities for compatibility with van Laarhoven optics category:      Data, Optics, Lenses description:@@ -31,7 +31,7 @@    build-depends: base                   >= 4.9        && <5                , indexed-profunctors    >= 0.1        && <0.2-               , optics-core            >= 0.2        && <0.3+               , optics-core            >= 0.2        && <0.4                , profunctors            >= 5.0        && <6.0    ghc-options: -Wall

@@ -1,10 +1,11 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | -- Module: Optics.VL ----- This module provides compatibility layer for converting from van Laarhoven+-- This module provides compatibility layer for converting from/to van Laarhoven -- encoding of 'Iso's, 'Prism's, 'Lens'es, 'IxLens'es, 'AffineTraversal's, -- 'IxAffineTraversal's, 'Traversal's and 'IxTraversal's to their optics -- equivalents.@@ -14,63 +15,102 @@     IsoVL   , IsoVL'   , isoVL+  , toIsoVL+  , withIsoVL   -- * Prism   , PrismVL   , PrismVL'   , prismVL+  , toPrismVL+  , withPrismVL   -- * Lens   , LensVL   , LensVL'   , lensVL+  , toLensVL+  , withLensVL   -- * IxLens   , IxLensVL   , IxLensVL'   , ilensVL+  , toIxLensVL+  , withIxLensVL   -- * AffineTraversal   , AffineTraversalVL   , AffineTraversalVL'   , atraversalVL+  , atraverseOf   -- * IxAffineTraversal   , IxAffineTraversalVL   , IxAffineTraversalVL'   , iatraversalVL+  , iatraverseOf   -- * Traversal   , TraversalVL   , TraversalVL'   , traversalVL+  , traverseOf   -- * IxTraversal   , IxTraversalVL   , IxTraversalVL'   , itraversalVL+  , itraverseOf   ) where +import Data.Coerce import Data.Functor.Identity+import Data.Profunctor.Indexed ((.#), (#.)) import qualified Data.Profunctor as P--import Data.Profunctor.Indexed+import qualified Data.Profunctor.Indexed as IP  import Optics.Internal.Optic import Optics.Core -newtype WrappedProfunctor p i a b =-  WrapProfunctor { unwrapProfunctor :: p i a b }+newtype WrappedIxProfunctor p i a b =+  WrapIxProfunctor { unwrapIxProfunctor :: p i a b } -instance Profunctor p => P.Profunctor (WrappedProfunctor p i) where-  dimap f g (WrapProfunctor pab) = WrapProfunctor (dimap f g pab)-  lmap  f   (WrapProfunctor pab) = WrapProfunctor (lmap  f   pab)-  rmap    g (WrapProfunctor pab) = WrapProfunctor (rmap    g pab)+instance IP.Profunctor p => P.Profunctor (WrappedIxProfunctor p i) where+  dimap f g (WrapIxProfunctor piab) = WrapIxProfunctor (IP.dimap f g piab)+  lmap  f   (WrapIxProfunctor piab) = WrapIxProfunctor (IP.lmap  f   piab)+  rmap    g (WrapIxProfunctor piab) = WrapIxProfunctor (IP.rmap    g piab)   {-# INLINE dimap #-}   {-# INLINE lmap #-}   {-# INLINE rmap #-} -instance Choice p => P.Choice (WrappedProfunctor p i) where-  left'  (WrapProfunctor pab) = WrapProfunctor (left'  pab)-  right' (WrapProfunctor pab) = WrapProfunctor (right' pab)+instance IP.Choice p => P.Choice (WrappedIxProfunctor p i) where+  left'  (WrapIxProfunctor piab) = WrapIxProfunctor (IP.left'  piab)+  right' (WrapIxProfunctor piab) = WrapIxProfunctor (IP.right' piab)   {-# INLINE left' #-}   {-# INLINE right' #-}  ---------------------------------------- +newtype WrappedProfunctor p f i a b =+  WrapProfunctor { unwrapProfunctor :: p a (f b) }++instance (P.Profunctor p, Functor f) => IP.Profunctor (WrappedProfunctor p f) where+  dimap f g (WrapProfunctor pafb) = WrapProfunctor (P.dimap f (fmap g) pafb)+  lmap  f   (WrapProfunctor pafb) = WrapProfunctor (P.lmap  f          pafb)+  rmap    g (WrapProfunctor pafb) = WrapProfunctor (P.rmap    (fmap g) pafb)+  {-# INLINE dimap #-}+  {-# INLINE lmap #-}+  {-# INLINE rmap #-}++  lcoerce' = IP.lmap coerce+  rcoerce' = IP.rmap coerce+  {-# INLINE lcoerce' #-}+  {-# INLINE rcoerce' #-}++instance (P.Choice p, Applicative f) => IP.Choice (WrappedProfunctor p f) where+  left' (WrapProfunctor pafb) =+    WrapProfunctor (P.rmap (either (fmap Left) (pure . Right)) (P.left' pafb))+  right' (WrapProfunctor pafb) =+    WrapProfunctor (P.rmap (either (pure . Left) (fmap Right)) (P.right' pafb))+  {-# INLINE left' #-}+  {-# INLINE right' #-}++----------------------------------------+ -- | Type synonym for a type-modifying van Laarhoven iso. type IsoVL s t a b =   forall p f. (P.Profunctor p, Functor f) => p a (f b) -> p s (f t)@@ -80,11 +120,25 @@  -- | Build an 'Iso' from the van Laarhoven representation. isoVL :: forall s t a b. IsoVL s t a b -> Iso s t a b-isoVL f = Optic $ rcoerce @(Identity t) @t-                . (unwrapProfunctor #. f .# WrapProfunctor)-                . rcoerce @b @(Identity b)+isoVL f = Optic $ IP.rcoerce @(Identity t) @t+                . (unwrapIxProfunctor #. f .# WrapIxProfunctor)+                . IP.rcoerce @b @(Identity b) {-# INLINE isoVL #-} +-- | Convert an 'Iso' to the van Laarhoven representation.+toIsoVL :: Is k An_Iso => Optic k is s t a b -> IsoVL s t a b+toIsoVL o = unwrapProfunctor #. getOptic (castOptic @An_Iso o) .# WrapProfunctor+{-# INLINE toIsoVL #-}++-- | Work with an 'Iso' in the van Laarhoven representation.+withIsoVL+  :: Is k An_Iso+  => Optic k is s t a b+  -> (IsoVL s t a b -> r)+  -> r+withIsoVL o k = k (toIsoVL o)+{-# INLINE withIsoVL #-}+ ----------------------------------------  -- | Type synonym for a type-modifying van Laarhoven prism.@@ -96,7 +150,21 @@  -- | Build a 'Prism' from the van Laarhoven representation. prismVL :: forall s t a b. PrismVL s t a b -> Prism s t a b-prismVL f = Optic $ rcoerce @(Identity t) @t-                  . (unwrapProfunctor #. f .# WrapProfunctor)-                  . rcoerce @b @(Identity b)+prismVL f = Optic $ IP.rcoerce @(Identity t) @t+                  . (unwrapIxProfunctor #. f .# WrapIxProfunctor)+                  . IP.rcoerce @b @(Identity b) {-# INLINE prismVL #-}++-- | Convert a 'Prism' to the van Laarhoven representation.+toPrismVL :: Is k A_Prism => Optic k is s t a b -> PrismVL s t a b+toPrismVL o = unwrapProfunctor #. getOptic (castOptic @A_Prism o) .# WrapProfunctor+{-# INLINE toPrismVL #-}++-- | Work with a 'Prism' in the van Laarhoven representation.+withPrismVL+  :: Is k A_Prism+  => Optic k is s t a b+  -> (PrismVL s t a b -> r)+  -> r+withPrismVL o k = k (toPrismVL o)+{-# INLINE withPrismVL #-}