fclabels 0.11.2 → 1.0

raw patch · 12 files changed

+643/−378 lines, 12 filesdep +transformersdep ~basedep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependency ranges changed: base, mtl

API changes (from Hackage documentation)

Files

• fclabels.cabal +52/−139
• src/Data/Label.hs +152/−0
• src/Data/Label/Abstract.hs +108/−0
• src/Data/Label/Derive.hs +140/−0
• src/Data/Label/Maybe.hs +61/−0
• src/Data/Label/MaybeM.hs +31/−0
• src/Data/Label/Pure.hs +46/−0
• src/Data/Label/PureM.hs +53/−0
• src/Data/Record/Label.hs +0/−28
• src/Data/Record/Label/Core.hs +0/−90
• src/Data/Record/Label/Monadic.hs +0/−46
• src/Data/Record/Label/TH.hs +0/−75

@@ -1,144 +1,57 @@-Name:            fclabels-Version:         0.11.2-Author:          Sebastiaan Visser, Erik Hesselink, Chris Eidhof, Sjoerd Visscher.-Synopsis:        First class accessor labels implemented as lenses.--Description:     First class labels that act as bidirectional record fields.-                 .-                 The labels are implemented as lenses and are fully composable-                 and can be used to get, set and modify parts of a datatype in-                 a consistent way. The lens datatype, conveniently called-                 `:->', is an instance of the `Category' type class: meaning it-                 has a proper identity and composition. The library has support-                 for automatically deriving labels from record selectors that-                 start with an underscore. Labels can be used in a purely-                 functional setting or be applied to mutable state in some-                 state monad.-                 .-                 To illustrate this package, let's take the following two example-                 datatypes (somehow Haddock removes the curly braces):-                 .-                 > data Person = Person {-                 >     _name   :: String-                 >   , _age    :: Int-                 >   , _isMale :: Bool-                 >   , _place  :: Place-                 >   }-                 .-                 > data Place = Place {-                 >     _city-                 >   , _country-                 >   , _continent :: String-                 >   }-                 .-                 Both are record datatypes with all record labels prefixed by-                 an underscore.  This underscore is an indication for our-                 Template Haskell code to derive lenses for these fields.-                 Deriving lenses can be done with this simple one-liner:-                 .-                 > $(mkLabels [''Person, ''Place])-                 .-                 These lenses can be used to get, set and modify the value and-                 are fully composable.-                 .-                 Now let's look at this example. This 71 year old fellow, called Jan,-                 is my neighbour and didn't mind using him as an example:-                 .-                 > jan :: Person-                 > jan = Person "Jan" 71 True (Place "Utrecht" "The Netherlands" "Europe")-                 .-                 When we want to be sure Jan is really as old as he claims we-                 can use the @getL@ function to get the age out as an integer:-                 .-                 > hisAge :: Int-                 > hisAge = getL age jan-                 .-                 Consider he now wants to move to Amsterdam: what better place-                 to spend your old days. Using composition we can change the-                 city value deep inside the structure:-                 .-                 > moveToAmsterdam :: Person -> Person-                 > moveToAmsterdam = setL (city . place) "Amsterdam"-                 .-                 > moveToAmsterdam jan ==-                 >  Person "Jan" 71 True (Place "Amsterdam" "The Netherlands" "Europe")-                 .-                 Composition is done using the dot operator which is part of-                 the @Control.Category@ module. Make sure to import this module-                 and hide the default @(.)@, @id@ and @modL@ function from the-                 Prelude.-                 .-                 Now, because Jan is an old guy, moving to another city is not a-                 very easy task, this really takes a while. It will probably-                 take no less than two years before he will actually be-                 settled. To reflect this change it might be useful to have a-                 first class view on the @Person@ data type that only reveals-                 the age and city.  This can be done by using a neat-                 @Applicative@ functor instance:-                 .-                 > ageAndCity :: Person :-> (Int, String)-                 > ageAndCity = Lens $ (,) <$> fst `for` age <*> snd `for` (city . place)-                 .-                 Because the applicative type class on its own is not very-                 capable of expressing bidirectional relations, which we need-                 for our lenses, the actual instance is defined for an internal-                 helper structure called @Point@. Points are a bit more general-                 than lenses. As you can see above, the @Label@ constructor has-                 to be used to convert a @Point@ back into a @Label@. The @for@-                 function must be used to indicate which partial destructor to-                 use for which lens in the applicative composition.-                 .-                 Now that we have an appropriate age+city view on the @Person@-                 data type (which is itself a lens again), we can use the-                 @modL@ function to make Jan move to Amsterdam over exactly two-                 years:-                 .-                 > moveToAmsterdamOverTwoYears :: Person -> Person-                 > moveToAmsterdamOverTwoYears = modL ageAndCity (\(a, b) -> (a+2, "Amsterdam"))-                 .-                 > moveToAmsterdamOverTwoYears jan ==-                 >  Person "Jan" 73 True (Place "Amsterdam" "The Netherlands" "Europe")-                 .-                 This package also contains a lens data type that encodes-                 bidirectional functions. Just like lenses, lenses can be-                 composed with other lenses using the @Control.Category@ type-                 class. Lenses can be used to change the type of a lens. The-                 @Iso@ type class, which can be seen as a bidirectional-                 functor, can be used to apply lenses to lenses. For example,-                 when we want to treat the age of a person as a string we can-                 do the following:-                 .-                 > ageAsString :: Person :-> String-                 > ageAsString :: (show :<->: read) % age-                 .-                 A final note: this library might look cryptic at first sight, but give it a-                 try, it is not that hard.-                 .-                 .-                 > CHANGELOG-                 >   0.11.1.1 -> 0.11.2-                 >   - Relaxed template haskell dependency constraint-                 >     for GHC 7.2-                 >   - Removed redundant import warnings.--Maintainer:      Sebastiaan Visser <haskell@fvisser.nl>-License:         BSD3-License-File:    LICENCE-Category:        Data-Cabal-Version:   >= 1.6-Build-Type:      Simple+Name:          fclabels+Version:       1.0+Author:        Sebastiaan Visser, Erik Hesselink, Chris Eidhof, Sjoerd Visscher.+Synopsis:      First class accessor labels.+Description:   This package provides first class labels that can act as+               bidirectional record fields. The labels can be derived+               automatically using Template Haskell which means you don't have+               to write any boilerplate yourself. The labels are implemented as+               lenses and are fully composable. Labels can be used to /get/,+               /set/ and /modify/ parts of a datatype in a consistent way.+               .+               See "Data.Label" for an introductory explanation.+               .+               Internally lenses are not tied to Haskell functions directly,+               but are implemented as arrows. Arrows allow the lenses to be run+               in custom computational contexts. This approach allows us to+               make partial lenses that point to fields of multi-constructor+               datatypes in an elegant way.+               .+               See the "Data.Label.Maybe" module for the use of partial labels.+               .+               > 0.11.2 -> 1.0+               >   - Added abstract arrow based core module.+               >   - Allow both pure and failing labels to be derived.+               >   - Major API and documentation cleanup.+               >   - Renamed lots of exposed function names.+Maintainer:    Sebastiaan Visser <code@fvisser.nl>+License:       BSD3+License-File:  LICENCE+Category:      Data+Cabal-Version: >= 1.6+Build-Type:    Simple  Library   HS-Source-Dirs:  src-  Exposed-Modules: Data.Record.Label-                   Data.Record.Label.Core-                   Data.Record.Label.Monadic-  Other-Modules:   Data.Record.Label.TH-  Build-Depends:   base >= 3 && < 5-                 , template-haskell >= 2.2 && < 2.7-                 , mtl >= 1.1 && <= 2.1-  GHC-Options:     -Wall +  Other-Modules:+    Data.Label.Derive+  Exposed-Modules:+    Data.Label+    Data.Label.Abstract+    Data.Label.Maybe+    Data.Label.MaybeM+    Data.Label.Pure+    Data.Label.PureM++  GHC-Options: -Wall+  Build-Depends:+      base                       < 5+    , template-haskell >= 2.2 && < 2.7+    , mtl              >= 1.0 && < 2.2+    , transformers     >= 0.2 && < 0.3+ Source-Repository head-  Type:            git-  Location:        git://github.com/sebastiaanvisser/fclabels.git+  Type:     git+  Location: git://github.com/sebastiaanvisser/fclabels.git+

@@ -0,0 +1,152 @@+{-# LANGUAGE TypeOperators #-}+{- |+This package provides first class labels that can act as bidirectional record+fields. The labels can be derived automatically using Template Haskell which+means you don't have to write any boilerplate yourself. The labels are+implemented as lenses and are fully composable. Labels can be used to /get/,+/set/ and /modify/ parts of a datatype in a consistent way.+-}++module Data.Label+(++-- * Working with @fclabels@.++{- |+The lens datatype, conveniently called `:->', is an instance of the+"Control.Category" type class: meaning it has a proper identity and+composition. The library has support for automatically deriving labels from+record selectors that start with an underscore.++To illustrate this package, let's take the following two example datatypes.++> import Data.Label+> import Prelude hiding ((.), id)+>+> data Person = Person+>   { _name   :: String+>   , _age    :: Int+>   , _isMale :: Bool+>   , _place  :: Place+>   }+>+> data Place = Place+>   { _city+>   , _country+>   , _continent :: String+>   }++Both datatypes are record types with all the labels prefixed with an+underscore. This underscore is an indication for our Template Haskell code to+derive lenses for these fields. Deriving lenses can be done with this simple+one-liner:++> $(mkLabels [''Person, ''Place])++For all labels a lens will created.++Now let's look at this example. This 71 year old fellow, my neighbour called+Jan, didn't mind using him as an example:++> jan :: Person+> jan = Person "Jan" 71 True (Place "Utrecht" "The Netherlands" "Europe")++When we want to be sure Jan is really as old as he claims we can use the `get`+function to get the age out as an integer:++> hisAge :: Int+> hisAge = get age jan++Consider he now wants to move to Amsterdam: what better place to spend your old+days. Using composition we can change the city value deep inside the structure:++> moveToAmsterdam :: Person -> Person+> moveToAmsterdam = set (city . place) "Amsterdam"++And now:++> ghci> moveToAmsterdam jan+> Person "Jan" 71 True (Place "Amsterdam" "The Netherlands" "Europe")++Composition is done using the @(`.`)@ operator which is part of the+"Control.Category" module. Make sure to import this module and hide the default+@(`.`)@, `id` function from the Haskell "Prelude".++-}++-- * Pure lenses.++  (:->)+, lens+, get+, set+, modify++-- * Views using @Applicative@.++{- |++Now, because Jan is an old guy, moving to another city is not a very easy task,+this really takes a while. It will probably take no less than two years before+he will actually be settled. To reflect this change it might be useful to have+a first class view on the `Person` datatype that only reveals the age and+city.  This can be done by using a neat `Applicative` functor instance:++> ageAndCity :: Person :-> (Int, String)+> ageAndCity = Lens $ (,) <$> fst `for` age <*> snd `for` city . place++Because the applicative type class on its own is not very capable of expressing+bidirectional relations, which we need for our lenses, the actual instance is+defined for an internal helper structure called `Point`. Points are a bit more+general than lenses. As you can see above, the `Label` constructor has to be+used to convert a `Point` back into a `Label`. The `for` function must be used+to indicate which partial destructor to use for which lens in the applicative+composition.++Now that we have an appropriate age+city view on the `Person` datatype (which+is itself a lens again), we can use the `modify` function to make Jan move to+Amsterdam over exactly two years:++> moveToAmsterdamOverTwoYears :: Person -> Person+> moveToAmsterdamOverTwoYears = modify ageAndCity (\(a, b) -> (a+2, "Amsterdam"))++> ghci> moveToAmsterdamOverTwoYears jan+> Person "Jan" 73 True (Place "Amsterdam" "The Netherlands" "Europe")++-}++-- * Working with bijections and isomorphisms.+-- +-- | This package contains a bijection datatype that encodes bidirectional+-- functions. Just like lenses, bijections can be composed using the+-- "Control.Category" type class. Bijections can be used to change the type of+-- a lens. The `Iso` type class, which can be seen as a bidirectional functor,+-- can be used to apply lenses to lenses.+-- +-- For example, when we want to treat the age of a person as a string we can do+-- the following:+-- +-- > ageAsString :: Person :-> String+-- > ageAsString :: Bij show read % age++, Bijection (..)+, Iso (..)+, for++-- * Derive labels using Template Haskell.+--+-- | We can either derive labels with or without type signatures. In the case+-- of multi-constructor datatypes some fields might not always be available and+-- the derived labels will be partial. Partial labels are provided with an+-- additional type context that forces them to be only usable using the+-- functions from "Data.Label.Maybe".++, mkLabels+, mkLabelsNoTypes+)+where++import Data.Label.Abstract (Bijection(..), Iso(..), for)+import Data.Label.Pure+import Data.Label.Derive+

@@ -0,0 +1,108 @@+{-# LANGUAGE+    TypeOperators+  , Arrows+  , TupleSections+  , FlexibleInstances+  , MultiParamTypeClasses+  #-}+module Data.Label.Abstract where++import Control.Arrow+import Prelude hiding ((.), id)+import Control.Applicative+import Control.Category++-- | 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+  }++-- | 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 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 }++-- | Create a lens out of a getter and setter.++lens :: (f ~> a) -> ((a, f) ~> f) -> Lens (~>) f a+lens g s = Lens (Point g s)++-- | Get the getter arrow from a lens.++get :: Arrow (~>) => Lens (~>) f a -> f ~> a+get = _get . unLens++-- | Get the setter arrow from a lens.++set :: Arrow (~>) => Lens (~>) f a -> (a, f) ~> f+set = _set . unLens++-- | Get the modifier arrow from a lens.++modify :: ArrowApply (~>) => Lens (~>) f o -> (o ~> o, f) ~> f+modify = _modify . unLens++instance ArrowApply (~>) => Category (Lens (~>)) where+  id = lens id (arr snd)+  Lens a . Lens b = lens (_get a . _get b) (_modify b . first (curryA (_set a)))+    where curryA f = arr (\i -> f . arr (i,))++instance Arrow (~>) => Functor (Point (~>) f i) where+  fmap f x = Point (arr f . _get x) (_set x)++instance Arrow (~>) => Applicative (Point (~>) 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))++-- | Make a 'Point' diverge in two directions.++bimap :: Arrow (~>) => (o' ~> o) -> (i ~> i') -> Point (~>) f i' o' -> Point (~>) 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 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 }++-- | Bijections as categories.++instance Category (~>) => Category (Bijection (~>)) where+  id = Bij id id+  Bij a b . Bij c d = Bij (a . c) (d . b)++-- | Lifting 'Bijection's.++liftBij :: Functor f => Bijection (->) a b -> Bijection (->) (f a) (f b)+liftBij a = Bij (fmap (fw a)) (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++-- | We can diverge 'Lens'es using an isomorphism.++instance Arrow (~>) => Iso (~>) (Lens (~>) f) where+  iso bi = arr ((\a -> lens (fw bi . _get a) (_set a . first (bw bi))) . unLens)++-- | We can diverge 'Bijection's using an isomorphism.++instance Arrow (~>) => Iso (~>) (Bijection (~>) a) where+  iso = arr . (.)+

@@ -0,0 +1,140 @@+{-# OPTIONS -fno-warn-orphans #-}+{-# LANGUAGE+    TemplateHaskell+  , OverloadedStrings+  , FlexibleInstances+  #-}+module Data.Label.Derive+( mkLabels+, mkLabelsNoTypes+) where++import Control.Arrow+import Control.Category+import Control.Monad+import Data.Char+import Data.Function (on)+import Data.Label.Abstract+import Data.List+import Data.Ord+import Data.String+import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Prelude hiding ((.), id)++-- Throw a fclabels specific error.++fclError :: String -> a+fclError err = error ("Data.Label.Derive: " ++ err)++-- | Derive lenses including type signatures for all the record selectors in a+-- datatype.++mkLabels :: [Name] -> Q [Dec]+mkLabels = liftM concat . mapM (derive1 True)++-- | Derive lenses without type signatures for all the record selectors in a+-- datatype.++mkLabelsNoTypes :: [Name] -> Q [Dec]+mkLabelsNoTypes = liftM concat . mapM (derive1 False)++-- Helpers to generate all labels.++derive1 :: Bool -> Name -> Q [Dec]+derive1 signatures datatype =+ do i <- reify datatype+    let -- Only process data and newtype declarations, filter out all+        -- constructors and the type variables.+        (tyname, cons, vars) =+          case i of+            TyConI (DataD    _ n vs cs _) -> (n, cs,  vs)+            TyConI (NewtypeD _ n vs c  _) -> (n, [c], vs)+            _                             -> fclError "Can only derive labels for datatypes and newtypes."++        -- We are only interested in lenses of record constructors.+        recordOnly = groupByCtor [ (f, n) | RecC n fs <- cons, f <- fs ]++    concat `liftM` mapM (derive signatures tyname vars (length cons)) recordOnly++    where groupByCtor = map (\xs -> (fst (head xs), map snd xs))+                      . groupBy ((==) `on` (fst3 . fst))+                      . sortBy (comparing (fst3 . fst))+                      where fst3 (a, _, _) = a++-- Generate the code for the labels.++derive :: Bool -> Name -> [TyVarBndr] -> Int -> (VarStrictType, [Name]) -> Q [Dec]+derive signatures tyname vars total ((field, _, fieldtyp), ctors) =++  do (sign, body) <-+       if length ctors == total+       then function derivePureLabel+       else function deriveMaybeLabel++     return $+       if signatures+       then [sign, body]+       else [body]++  where++    -- Build a single record label definition for labels that might fail.+    deriveMaybeLabel = (sign, body)+      where+        sign = forallT vars (return []) [t| (ArrowChoice (~>), ArrowZero (~>)) => Lens (~>) $(inputType) $(return fieldtyp) |]+        body = [| let c = zeroArrow ||| returnA in lens (c . $(getter)) (c . $(setter)) |]+          where+            getter    = [| arr (\    p  -> $(caseE [|p|] (cases (bodyG [|p|]      ) ++ wild))) |]+            setter    = [| arr (\(v, p) -> $(caseE [|p|] (cases (bodyS [|p|] [|v|]) ++ wild))) |]+            cases b   = map (\ctor -> match (recP ctor []) (normalB b) []) ctors+            wild      = [match wildP (normalB [| Left () |]) []]+            bodyS p v = [| Right $( record p fieldName v ) |]+            bodyG p   = [| Right $( fromString fieldName `appE` p ) |]++    -- Build a single record label definition for labels that cannot fail.+    derivePureLabel = (sign, body)+      where+        sign = forallT vars (return []) [t| Arrow (~>) => Lens (~>) $(inputType) $(return fieldtyp) |]+        body = [| lens $(getter) $(setter) |]+          where+            getter = [| arr $(fromString fieldName) |]+            setter = [| arr (\(v, p) -> $(record [| p |] fieldName [| v |])) |]++    -- Generate a name for the label. If the original selector starts with an+    -- underscore, remove it and make the next character lowercase. Otherwise,+    -- add 'l', and make the next character uppercase.+    fieldName = nameBase field+    labelName = mkName $+      case nameBase field of+        '_' : c : rest -> toLower c : rest+        f : rest       -> 'l' : toUpper f : rest+        n              -> fclError ("Cannot derive label for record selector with name: " ++ n)+++    -- Compute the type (including type variables of the record datatype.+    inputType = return $ foldr (flip AppT) (ConT tyname) (map tvToVarT (reverse vars))++    -- Convert a type variable binder to a regular type variable.+    tvToVarT (PlainTV tv) = VarT tv+    tvToVarT _            = fclError "No support for special-kinded type variables."++    -- Q style record updating.+    record rec fld val = val >>= \v -> recUpdE rec [return (mkName fld, v)]++    -- Build a function declaration with both a type signature and body.+    function (s, b) = liftM2 (,) +        (sigD labelName s)+        (funD labelName [ clause [] (normalB b) [] ])++-- IsString instances for TH types.++instance IsString Exp where+  fromString = VarE . mkName++instance IsString (Q Pat) where+  fromString = varP . mkName++instance IsString (Q Exp) where+  fromString = varE . mkName+

@@ -0,0 +1,61 @@+{-# LANGUAGE TypeOperators, TupleSections #-}+module Data.Label.Maybe+( (:~>)+, lens+, get+, set+, modify+, embed+)+where++import Control.Arrow+import Control.Category+import Control.Monad.Identity+import Control.Monad.Trans.Maybe+import Data.Maybe+import Prelude hiding ((.), id)+import qualified Data.Label.Abstract as A++type MaybeLens f a = A.Lens (Kleisli (MaybeT Identity)) f a++-- | Lens type for situations in which the accessor functions can fail. This is+-- useful, for example, when accessing fields in datatypes with multiple+-- constructors.++type f :~> a = MaybeLens f a++run :: Kleisli (MaybeT Identity) f a -> f -> Maybe a+run l = runIdentity . runMaybeT . runKleisli l++-- | Create a lens that can fail from a getter and a setter that can themselves+-- potentially fail.++lens :: (f -> Maybe a) -> (a -> f -> Maybe f) -> f :~> a+lens g s = A.lens (kl g) (kl (uncurry s))+  where kl a = Kleisli (MaybeT . Identity . a)++-- | Getter for a lens that can fail. When the field to which the lens points+-- is not accessible the getter returns 'Nothing'.++get :: (f :~> a) -> f -> Maybe a+get l = run (A.get l)++-- | Setter for a lens that can fail. When the field to which the lens points+-- is not accessible this function returns 'Nothing'.++set :: f :~> a -> a -> f -> Maybe f+set l v = run (A.set l . arr (v,))++-- | Modifier for a lens that can fail. When the field to which the lens points+-- is not accessible this function returns 'Nothing'.++modify :: (f :~> a) -> (a -> a) -> f -> Maybe f+modify l m = run (A.modify l . arr (arr m,))++-- | Embed a pure lens that points to a `Maybe` field into+-- a lens that might fail.++embed :: A.Lens (->) f (Maybe a) -> f :~> a+embed l = lens (A.get l) (\a f -> Just (A.set l (Just a, f)))+

@@ -0,0 +1,31 @@+{-# LANGUAGE TypeOperators #-}+module Data.Label.MaybeM+(+-- * 'MonadState' lens operations.+  gets++-- * 'MonadReader' lens operations.+, asks+)+where++import Control.Monad+import Data.Label.Maybe ((:~>))+import qualified Control.Monad.Reader as M+import qualified Control.Monad.State  as M+import qualified Data.Label.Maybe     as L++-- | Get a value out of state, pointed to by the specified lens that might+-- fail.  When the lens getter fails this computation will fall back to+-- `mzero'.++gets :: (M.MonadState f m, MonadPlus m) => (f :~> a) -> m a+gets l = (L.get l `liftM` M.get) >>= (mzero `maybe` return)++-- | Fetch a value, pointed to by a lens that might fail, out of a reader+-- environment. When the lens getter fails this computation will fall back to+-- `mzero'.++asks :: (M.MonadReader f m, MonadPlus m) => (f :~> a) -> m a+asks l = (L.get l `liftM` M.ask) >>= (mzero `maybe` return)+

@@ -0,0 +1,46 @@+{-# LANGUAGE TypeOperators #-}+module Data.Label.Pure+( (:->)+, lens+, get+, set+, modify+)+where++import qualified Data.Label.Abstract as A++type PureLens f a = A.Lens (->) f a++-- | Pure lens type specialized for pure accessor functions.++type (f :-> a) = PureLens f a++-- | Create a pure lens from a getter and a setter.+--+-- We expect the following law to hold:+--+-- > get l (set l a f) == a+--+-- Or, equivalently:+--+-- > set l (get l f) f == f++lens :: (f -> a) -> (a -> f -> f) -> f :-> a+lens g s = A.lens g (uncurry s)++-- | Getter for a pure lens.++get :: (f :-> a) -> f -> a+get = A.get++-- | Setter for a pure lens.++set :: (f :-> a) -> a -> f -> f+set = curry . A.set++-- | Modifier for a pure lens.++modify :: (f :-> a) -> (a -> a) -> f -> f+modify = curry . A.modify+

@@ -0,0 +1,53 @@+{-# LANGUAGE TypeOperators  #-}+module Data.Label.PureM+(+-- * 'MonadState' lens operations.+  gets+, puts+, modify+, (=:)++-- * 'MonadReader' lens operations.+, asks+, local+)+where++import Data.Label.Pure ((:->))+import qualified Control.Monad.Reader as M+import qualified Control.Monad.State  as M+import qualified Data.Label.Pure      as L++-- | Get a value out of the state, pointed to by the specified lens.++gets :: M.MonadState s m => s :-> a -> m a+gets = M.gets . L.get++-- | Set a value somewhere in the state, pointed to by the specified lens.++puts :: M.MonadState s m => s :-> a -> a -> m ()+puts l = M.modify . L.set l++-- | Alias for `puts' that reads like an assignment.++infixr 7 =:+(=:) :: M.MonadState s m => s :-> a -> a -> m ()+(=:) = puts++-- | Modify a value with a function somewhere in the state, pointed to by the+-- specified lens.++modify :: M.MonadState s m => s :-> a -> (a -> a) -> m ()+modify l = M.modify . L.modify l++-- | Fetch a value pointed to by a lens out of a reader environment.++asks :: M.MonadReader r m => (r :-> a) -> m a+asks = M.asks . L.get++-- | Execute a computation in a modified environment. The lens is used to+-- point out the part to modify.++local :: M.MonadReader r m => (r :-> b) -> (b -> b) -> m a -> m a+local l f = M.local (L.modify l f)+

@@ -1,28 +0,0 @@-module Data.Record.Label-(--- * Lens types.-  Point (Point)-, (:->) (Lens)-, lens-, getL, setL, modL--, fmapL---- * Bidirectional functor.-, (:<->:) (..)-, Iso (..)-, lmap-, for---- * Monadic lens operations.-, getM, setM, modM, (=:)-, askM, localM---- * Derive labels using Template Haskell.-, module Data.Record.Label.TH-)-where--import Data.Record.Label.Core-import Data.Record.Label.Monadic-import Data.Record.Label.TH

@@ -1,90 +0,0 @@-{-# LANGUAGE TypeOperators #-}-module Data.Record.Label.Core where--import Prelude hiding ((.), id)-import Control.Applicative-import Control.Category--data Point f i o = Point-  { _get :: f -> o-  , _set :: i -> f -> f-  }--_mod :: Point f i o -> (o -> i) -> f -> f-_mod l f a = _set l (f (_get l a)) a--newtype (f :-> a) = Lens { unLens :: Point f a a }---- | Create a lens out of a getter and setter.--lens :: (f -> a) -> (a -> f -> f) -> f :-> a-lens g s = Lens (Point g s)---- | Get the getter function from a lens.--getL :: (f :-> a) -> f -> a-getL = _get . unLens---- | Get the setter function from a lens.--setL :: (f :-> a) -> a -> f -> f-setL = _set . unLens---- | Get the modifier function from a lens.--modL :: (f :-> a) -> (a -> a) -> f -> f-modL = _mod . unLens--instance Category (:->) where-  id = lens id const-  Lens a . Lens b = lens (_get a . _get b) (_mod b . _set a)--instance Functor (Point f i) where-  fmap f x = Point (f . _get x) (_set x)--instance Applicative (Point f i) where-  pure a = Point (const a) (const id)-  a <*> b = Point (_get a <*> _get b) (\r -> _set b r . _set a r)--fmapL :: Applicative f => (a :-> b) -> f a :-> f b-fmapL l = lens (fmap (getL l)) (\x f -> setL l <$> x <*> f)---- | This isomorphism type class is like a `Functor' but works in two directions.--class Iso f where-  (%) :: a :<->: b -> f a -> f b---- | The bijections datatype, a function that works in two directions. --infixr 7 :<->:-data a :<->: b = (:<->:) { fw :: a -> b, bw :: b -> a }---- | Constructor for bijections.--instance Category (:<->:) where-  id = id :<->: id-  (a :<->: b) . (c :<->: d) = a . c :<->: d . b--infixr 8 %--instance Iso ((:->) i) where-  l % Lens a = lens (fw l . _get a) (_set a . bw l)--instance Iso ((:<->:) i) where-  (%) = (.)--lmap :: Functor f => (a :<->: b) -> f a :<->: f b -lmap l = let a :<->: b = l in fmap a :<->: fmap b--dimap :: (o' -> o) -> (i -> i') -> Point f i' o' -> Point f i o-dimap f g l = Point (f . _get l) (_set l . g)---- | Combine a partial destructor with a lens into something easily used in the--- applicative instance for the hidden `Point' datatype. Internally uses the--- covariant in getter, contravariant in setter bi-functioral-map function.--- (Please refer to the example because this function is just not explainable--- on its own.)--for :: (i -> o) -> (f :-> o) -> Point f i o-for a b = dimap id a (unLens b)-

@@ -1,46 +0,0 @@-{-# LANGUAGE TypeOperators, TypeSynonymInstances, TemplateHaskell #-}-module Data.Record.Label.Monadic-(--- * Monadic lens operations.-  getM, setM, modM, (=:)-, askM, localM-)-where--import Control.Monad.State-import Control.Monad.Reader-import Data.Record.Label.Core---- | Get a value out of state pointed to by the specified lens.--getM :: MonadState s m => s :-> b -> m b-getM = gets . getL---- | Set a value somewhere in state pointed to by the specified lens.--setM :: MonadState s m => s :-> b -> b -> m ()-setM l = modify . setL l---- | Alias for `setM' that reads like an assignment.--infixr 7 =:-(=:) :: MonadState s m => s :-> b -> b -> m ()-(=:) = setM---- | Modify a value with a function somewhere in state pointed to by the--- specified lens.--modM :: MonadState s m => s :-> b -> (b -> b) -> m ()-modM l = modify . modL l---- | Fetch a value pointed to by a lens out of a reader environment.--askM :: MonadReader r m => (r :-> b) -> m b-askM = asks . getL---- | Execute a computation in a modified environment. The lens is used to--- point out the part to modify.--localM :: MonadReader r m => (r :-> b) -> (b -> b) -> m a -> m a-localM l f = local (modL l f)-

@@ -1,75 +0,0 @@-module Data.Record.Label.TH-( mkLabels-, mkLabelsNoTypes-) where--import Control.Monad-import Data.Char-import Data.List (nub)-import Language.Haskell.TH.Syntax---- | Derive lenses including type signatures for all the record selectors in a--- datatype.--mkLabels :: [Name] -> Q [Dec]-mkLabels = liftM concat . mapM (labels True)---- | Derive lenses without type signatures for all the record selectors in a--- datatype.--mkLabelsNoTypes :: [Name] -> Q [Dec]-mkLabelsNoTypes = liftM concat . mapM (labels False)---- Helpers to generate all labels.--labels :: Bool -> Name -> Q [Dec]-labels sigs n =- do i <- reify n-    let -- Only process data and newtype declarations, filter out all-        -- constructors and the type variables.-        (cs',vars) =-          case i of-            TyConI (DataD    _ _ vs cs _) -> (cs , vs)-            TyConI (NewtypeD _ _ vs c  _) -> ([c], vs)-            _                             -> ([], undefined)--        -- We are only interested in lenses of record constructors.-        ls' = [ l | RecC _ ls <- cs', l <- ls ]--    return (concatMap (label sigs n vars) (nub ls'))---- Helpers to generate a single labels.--label :: Bool -> Name -> [TyVarBndr] -> VarStrictType -> [Dec]-label withType typeName binders (field, _, typ) =-  if withType-    then [signature, body]-    else [body]--  where-    appTv w (PlainTV n) = AppT w (VarT n)-    appTv _ v           = error ("Kinded type variable not supported: " ++ show v)--    -- Generate a name for the lens. If the original selector starts with an _,-    -- remove it and make the next character lowercase. Otherwise, add 'l', and-    -- make the next character uppercase.-    name = mkName $-            case nameBase field of-              '_' : c : rest -> toLower c : rest-              f : rest       -> 'l' : toUpper f : rest-              _              -> error "Invalid name"--    -- The source type of a lens.-    source = foldl appTv (ConT typeName) binders--    -- Construct the lens type.-    signature = SigD name (ForallT binders [] (ConT (mkName ":->") `AppT` source `AppT` typ))--    -- Construct the lens body.-    body = -      let getter = VarE field -          setter = [VarP (mkName "b"), VarP (mkName "a")]-                     `LamE` RecUpdE (VarE (mkName "a")) [(field, VarE (mkName "b"))]-          lens   = VarE (mkName "lens") `AppE` getter `AppE` setter-      in FunD name [ Clause [] (NormalB lens) [] ]-