fclabels 1.1.4 → 1.1.4.1

raw patch · 3 files changed

+37/−27 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• fclabels.cabal +6/−3
• src/Data/Label/Abstract.hs +29/−22
• src/Data/Label/Derive.hs +2/−2

@@ -1,5 +1,5 @@ Name:          fclabels-Version:       1.1.4+Version:       1.1.4.1 Author:        Sebastiaan Visser, Erik Hesselink, Chris Eidhof, Sjoerd Visscher                with lots of help and feedback from others. Synopsis:      First class accessor labels.@@ -20,8 +20,11 @@                .                See the "Data.Label.Maybe" module for the use of partial labels.                .-               > 1.1.3 -> 1.1.4-               >   - Added function to derive labels for a single datatype.+               > 1.1.4 -> 1.1.4.1+               >   - Changed infix type variables to named type variables.+               >     This makes fclabels compile with GHC > 7.6.+               >   - Added the `osi` (flipped iso) again.+  Maintainer:    Sebastiaan Visser <code@fvisser.nl> License:       BSD3

@@ -24,55 +24,55 @@ -- | Abstract Point datatype. The getter and setter functions work in some -- arrow. -data Point (~>) f i o = Point-  { _get :: f ~> o-  , _set :: (i, f) ~> f+data Point arr f i o = Point+  { _get :: f `arr` o+  , _set :: (i, f) `arr` f   }  -- | Modification as a compositon of a getter and setter. Unfortunately, -- `ArrowApply' is needed for this composition. -_modify :: ArrowApply (~>) => Point (~>) f i o -> (o ~> i, f) ~> f+_modify :: ArrowApply arr => Point arr f i o -> (o `arr` i, f) `arr` f _modify l = proc (m, f) -> do i <- m . _get l -<< f; _set l -< (i, f)  -- | Abstract Lens datatype. The getter and setter functions work in some -- arrow. Arrows allow for effectful lenses, for example, lenses that might -- fail or use state. -newtype Lens (~>) f a = Lens { unLens :: Point (~>) f a a }+newtype Lens arr f a = Lens { unLens :: Point arr f a a }  -- | Create a lens out of a getter and setter. -lens :: (f ~> a) -> ((a, f) ~> f) -> Lens (~>) f a+lens :: (f `arr` a) -> ((a, f) `arr` f) -> Lens arr f a lens g s = Lens (Point g s)  -- | Get the getter arrow from a lens. -get :: Arrow (~>) => Lens (~>) f a -> f ~> a+get :: Arrow arr => Lens arr f a -> f `arr` a get = _get . unLens  -- | Get the setter arrow from a lens. -set :: Arrow (~>) => Lens (~>) f a -> (a, f) ~> f+set :: Arrow arr => Lens arr f a -> (a, f) `arr` f set = _set . unLens  -- | Get the modifier arrow from a lens. -modify :: ArrowApply (~>) => Lens (~>) f o -> (o ~> o, f) ~> f+modify :: ArrowApply arr => Lens arr f o -> (o `arr` o, f) `arr` f modify = _modify . unLens -instance ArrowApply (~>) => Category (Lens (~>)) where+instance ArrowApply arr => Category (Lens arr) where   id = lens id (arr fst)   Lens a . Lens b = lens (_get a . _get b) (_modify b . first (curryA (_set a)))     where curryA f = arr (\i -> f . arr (i,))   {-# INLINE id #-}   {-# INLINE (.) #-} -instance Arrow (~>) => Functor (Point (~>) f i) where+instance Arrow arr => Functor (Point arr f i) where   fmap f x = Point (arr f . _get x) (_set x)   {-# INLINE fmap #-} -instance Arrow (~>) => Applicative (Point (~>) f i) where+instance Arrow arr => Applicative (Point arr f i) where   pure a  = Point (arr (const a)) (arr snd)   a <*> b = Point (arr app . (_get a &&& _get b)) (_set b . (arr fst &&& _set a))   {-# INLINE pure #-}@@ -80,47 +80,54 @@  -- | Make a 'Point' diverge in two directions. -bimap :: Arrow (~>) => (o' ~> o) -> (i ~> i') -> Point (~>) f i' o' -> Point (~>) f i o+bimap :: Arrow arr => (o' `arr` o) -> (i `arr` i') -> Point arr f i' o' -> Point arr f i o bimap f g l = Point (f . _get l) (_set l . first g)  infix 8 `for` -for :: Arrow (~>) => (i ~> o) -> Lens (~>) f o -> Point (~>) f i o+for :: Arrow arr => (i `arr` o) -> Lens arr f o -> Point arr f i o for p = bimap id p . unLens  -- | The bijections datatype, an arrow that works in two directions.  -data Bijection (~>) a b = Bij { fw :: a ~> b, bw :: b ~> a }+infix 8 `Bij` +data Bijection arr a b = Bij { fw :: a `arr` b, bw :: b `arr` a }+ -- | Bijections as categories. -instance Category (~>) => Category (Bijection (~>)) where+instance Category arr => Category (Bijection arr) where   id = Bij id id-  Bij a b . Bij c d = Bij (a . c) (d . b)+  Bij a b . Bij c d = a . c `Bij` d . b   {-# INLINE id #-}   {-# INLINE (.) #-}  -- | Lifting 'Bijection's.  liftBij :: Functor f => Bijection (->) a b -> Bijection (->) (f a) (f b)-liftBij a = Bij (fmap (fw a)) (fmap (bw a))+liftBij a = fmap (fw a) `Bij` fmap (bw a)  -- | The isomorphism type class is like a `Functor' but works in two directions.  infixr 8 `iso` -class Iso (~>) f where-  iso :: Bijection (~>) a b -> f a ~> f b+class Iso arr f where+  iso :: Bijection arr a b -> f a `arr` f b +-- | Flipped isomorphism.++osi :: Iso arr f => Bijection arr b a -> f a `arr` f b+osi (Bij a b) = iso (Bij b a)+ -- | We can diverge 'Lens'es using an isomorphism. -instance Arrow (~>) => Iso (~>) (Lens (~>) f) where+instance Arrow arr => Iso arr (Lens arr f) where   iso bi = arr ((\a -> lens (fw bi . _get a) (_set a . first (bw bi))) . unLens)   {-# INLINE iso #-}  -- | We can diverge 'Bijection's using an isomorphism. -instance Arrow (~>) => Iso (~>) (Bijection (~>) a) where+instance Arrow arr => Iso arr (Bijection arr a) where   iso = arr . (.)   {-# INLINE iso #-} 

@@ -160,9 +160,9 @@     tvToVarT _            = fclError "No support for special-kinded type variables."      -- Prettify type variables.-    arrow          = varT (mkName "~>")+    arrow          = varT (mkName "arr")     prettyVars     = map prettyTyVar vars-    forallVars     = PlainTV (mkName "~>") : prettyVars+    forallVars     = PlainTV (mkName "arr") : prettyVars     prettyFieldtyp = prettyType fieldtyp      -- Q style record updating.