diff --git a/fclabels.cabal b/fclabels.cabal --- a/fclabels.cabal +++ b/fclabels.cabal @@ -1,21 +1,23 @@ Name: fclabels -Version: 0.4.2.1 +Version: 0.9.0 Author: Sebastiaan Visser, Erik Hesselink, Chris Eidhof, Sjoerd Visscher. -Synopsis: First class accessor labels. +Synopsis: First class accessor labels implemented as lenses. Description: First class labels that act as bidirectional record fields. - The labels are fully composable and can be used to get, set - and modify parts of a datatype in a consistent way. The label - 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 take the following two example - datatypes (somehow Haddock removes the braces): + 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 @@ -29,18 +31,16 @@ > , _continent :: String > } . - Both are record datatypes with all record labels prefixed with + Both are record datatypes with all record labels prefixed by an underscore. This underscore is an indication for our - Template Haskell code to derive labels for these fields. - Deriving labels can be done with this simple one-liner: + Template Haskell code to derive lenses for these fields. + Deriving lenses can be done with this simple one-liner: . - > $(mkLabels [''Person, ''Place]) + > $(mkLenses [''Person, ''Place]) . - Label function will be generated, label type signatures will - not. This is actually not that bad, by writing the signatures - down yourself you will be able to give them documentation, - something that would be hard otherwise. So, lets give - functions a signature by hand: + Lens functions will be generated, lens type signatures will + not be generated. This is actually not that bad, by writing the signatures + Let's give the functions a signature by hand: . > name :: Person :-> String > age :: Person :-> Int @@ -52,24 +52,23 @@ . These type signatures look very similar to the function types for normal record labels, except that the additional colon - indicates a true first class label. These labels can be used + indicates a true first class lens. These lenses can be used to get, set and modify the value and are fully composable. . - Now let look at this example. This 71 old fellow, called Jan, + 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 @get@ function for labels to get the age out as an - integer: + 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 when can change the + 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 @@ -83,8 +82,8 @@ and hide the default @(.)@, @id@ and @mod@ 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. So it will probably + 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 @@ -96,15 +95,15 @@ . Because the applicative type class on its own is not very capable of expressing bidirectional relations, which we need - for our labels, the actual instance is defined for an internal + for our lenses, the actual instance is defined for an internal helper structure called @Point@. Points are a bit more general - than labels. As you can see above the @Label@ constructor has + 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 label in the applicative composition. + 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 label again), we can use the + data type (which is itself a lens again), we can use the @mod@ function to make Jan move to Amsterdam over exactly two years: . @@ -115,21 +114,30 @@ > Person "Jan" 73 True (Place "Amsterdam" "The Netherlands" "Europe") . This package also contains a lens data type that encodes - bidirectional functions. Just like labels lenses can be - composed to other lenses using the @Control.Category@ type - class. Lenses can be used to change the type of a label. The + 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 labels. For example, - when we want to threat the age of a person as a string we can + 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) `iso` age . - This library might look cryptic at first sight, but give it a - try it is not that hard. + A final note: this library might look cryptic at first sight, but give it a + try, it is not that hard. + . + . + > CHANGELOG + > 0.4.2 -> 1.0.0 + > - Added askM and localM for running lenses inside MonadReader. + > - Minor documentaion update. + > - Exported Point internals. + > - Renamed Lens to Bijection, which is more correct. + > - Renamed Label to Lens. -Maintainer: Sebastiaan Visser +Maintainer: Sebastiaan Visser License: BSD3 License-File: LICENCE Category: Data @@ -138,5 +146,7 @@ HS-Source-Dirs: src Exposed-Modules: Data.Record.Label Other-Modules: Data.Record.Label.TH -Build-Depends: base >= 3 && < 5, template-haskell >= 2.2 && < 2.5, monads-fd >=0.0 && < 0.2 +Build-Depends: base >= 3 && < 5 + , template-haskell >= 2.2 && < 2.5 + , monads-fd >= 0.0 && < 0.2 diff --git a/src/Data/Record/Label.hs b/src/Data/Record/Label.hs --- a/src/Data/Record/Label.hs +++ b/src/Data/Record/Label.hs @@ -1,78 +1,69 @@ {-# LANGUAGE TypeOperators, TypeSynonymInstances, TemplateHaskell #-} module Data.Record.Label ( - -- * Getter, setter and modifier types. - Getter - , Setter - , Modifier - - -- * Label type. - , Point - , (:->) (Label) - , label - , get, set, mod + -- * Lens types. + Point (Point) + , (:->) (Lens) + , lens + , getL, setL, modL , fmapL -- * Bidirectional functor. , (:<->:) (..) - , (<->) , Iso (..) , lmap , for - -- * State monadic label operations. - + -- * Monadic lens operations. , getM, setM, modM, (=:) + , askM, localM -- * Derive labels using Template Haskell. , module Data.Record.Label.TH ) where -import Prelude hiding ((.), id, mod) +import Prelude hiding ((.), id) import Control.Applicative import Control.Category -import Control.Monad.State hiding (get) +import Control.Monad.State +import Control.Monad.Reader import Data.Record.Label.TH -type Getter f o = f -> o -type Setter f i = i -> f -> f -type Modifier f i o = (o -> i) -> f -> f - data Point f i o = Point - { _get :: Getter f o - , _set :: Setter f i + { _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) = Label { unLabel :: Point f a a } +newtype (f :-> a) = Lens { unLens :: Point f a a } --- Create a label out of a getter and setter. +-- | Create a lens out of a getter and setter. -label :: Getter f a -> Setter f a -> f :-> a -label g s = Label (Point g s) +lens :: (f -> a) -> (a -> f -> f) -> f :-> a +lens g s = Lens (Point g s) --- | Get the getter function from a label. +-- | Get the getter function from a lens. -get :: (f :-> a) -> f -> a -get = _get . unLabel +getL :: (f :-> a) -> f -> a +getL = _get . unLens --- | Get the setter function from a label. +-- | Get the setter function from a lens. -set :: (f :-> a) -> a -> f -> f -set = _set . unLabel +setL :: (f :-> a) -> a -> f -> f +setL = _set . unLens --- | Get the modifier function from a label. +-- | Get the modifier function from a lens. -mod :: (f :-> a) -> (a -> a) -> f -> f -mod = _mod . unLabel +modL :: (f :-> a) -> (a -> a) -> f -> f +modL = _mod . unLens instance Category (:->) where - id = Label (Point id const) - (Label a) . (Label b) = Label (Point (_get a . _get b) (_mod b . _set a)) + 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) @@ -82,61 +73,56 @@ 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 = label (fmap (get l)) (\x f -> set l <$> x <*> f) +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 - iso :: a :<->: b -> f a -> f b - iso (Lens a b) = osi (b <-> a) - osi :: a :<->: b -> f b -> f a - osi (Lens a b) = iso (b <-> a) - --- | The lens datatype, a function that works in two directions. To bad there --- is no convenient way to do application for this. + (%) :: a :<->: b -> f a -> f b -data a :<->: b = Lens { fw :: a -> b, bw :: b -> a } +-- | The bijections datatype, a function that works in two directions. --- | Constructor for lenses. +infixr 7 :<->: +data a :<->: b = (:<->:) { fw :: a -> b, bw :: b -> a } -infixr 7 <-> -(<->) :: (a -> b) -> (b -> a) -> a :<->: b -a <-> b = Lens a b +-- | Constructor for bijections. instance Category (:<->:) where - id = Lens id id - (Lens a b) . (Lens c d) = Lens (a . c) (d . b) + id = id :<->: id + (a :<->: b) . (c :<->: d) = a . c :<->: d . b +infixr 8 % + instance Iso ((:->) i) where - iso l (Label a) = Label (Point (fw l . _get a) (_set a . bw l)) + l % Lens a = lens (fw l . _get a) (_set a . bw l) instance Iso ((:<->:) i) where - iso = (.) + (%) = (.) lmap :: Functor f => (a :<->: b) -> f a :<->: f b -lmap l = let (Lens a b) = l in fmap a <-> fmap 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 label 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. +-- | 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 (unLabel b) +for a b = dimap id a (unLens b) --- | Get a value out of state pointed to by the specified label. +-- | Get a value out of state pointed to by the specified lens. getM :: MonadState s m => s :-> b -> m b -getM = gets . get +getM = gets . getL --- | Set a value somewhere in state pointed to by the specified label. +-- | Set a value somewhere in state pointed to by the specified lens. setM :: MonadState s m => s :-> b -> b -> m () -setM l = modify . set l +setM l = modify . setL l -- | Alias for `setM' that reads like an assignment. @@ -145,8 +131,19 @@ (=:) = setM -- | Modify a value with a function somewhere in state pointed to by the --- specified label. +-- specified lens. modM :: MonadState s m => s :-> b -> (b -> b) -> m () -modM l = modify . mod l +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) diff --git a/src/Data/Record/Label/TH.hs b/src/Data/Record/Label/TH.hs --- a/src/Data/Record/Label/TH.hs +++ b/src/Data/Record/Label/TH.hs @@ -1,38 +1,63 @@ -module Data.Record.Label.TH (mkLabels) where +module Data.Record.Label.TH (mkLabels, mkLabelsNoTypes) where import Control.Monad import Data.Char import Language.Haskell.TH.Syntax --- | Derive labels for all the record selector in a datatype. +-- | Derive lenses including type signatures for all the record selectors in a datatype. mkLabels :: [Name] -> Q [Dec] -mkLabels = liftM concat . mapM mkLabels1 +mkLabels = liftM concat . mapM (mkLabels1 True) -mkLabels1 :: Name -> Q [Dec] -mkLabels1 n = do +-- | Derive lenses without type signatures for all the record selectors in a datatype. +mkLabelsNoTypes :: [Name] -> Q [Dec] +mkLabelsNoTypes = liftM concat . mapM (mkLabels1 False) + +-- Helpers. + +mkLabels1 :: Bool -> Name -> Q [Dec] +mkLabels1 sigs n = do i <- reify n - let -- only process data and newtype declarations - cs' = case i of - TyConI (DataD _ _ _ cs _) -> cs - TyConI (NewtypeD _ _ _ c _) -> [c] - _ -> [] - -- we're only interested in labels of record constructors + 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 (map mkLabel1 ls') + return (concatMap (mkLabel1 sigs n vars) ls') -mkLabel1 :: VarStrictType -> Dec -mkLabel1 (name, _, _) = - -- Generate a name for the label: - -- If the original selector starts with an _, remove it and make the next - -- character lowercase. Otherwise, add 'l', and make the next character - -- uppercase. - let n = mkName $ case nameBase name of +mkLabel1 :: Bool -> Name -> [TyVarBndr] -> VarStrictType -> [Dec] +mkLabel1 sigs typeName binders (name, _, t) = + let -- 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. + lensName = mkName $ case nameBase name of ('_' : c : rest) -> toLower c : rest (f : rest) -> 'l' : toUpper f : rest - _ -> "" - in FunD n [Clause [] (NormalB ( - AppE (AppE (VarE (mkName "label")) (VarE name)) -- getter - (LamE [VarP (mkName "b"), VarP (mkName "a")] -- setter - (RecUpdE (VarE (mkName "a")) [(name, VarE (mkName "b"))])) - )) []] + _ -> error "Invalid name" + -- The source type of a lens + source = foldl appTv (ConT typeName) binders + + -- The type of the lens + lensType = ForallT binders [] $ AppT (AppT (ConT $ mkName ":->") source) t + + in (if sigs then [SigD lensName lensType] else []) ++ [functionBody lensName name] + +appTv :: Type -> TyVarBndr -> Type +appTv t (PlainTV n) = AppT t (VarT n) +appTv _ v = error $ "Kinded type variable not supported: " ++ show v + + +functionBody :: Name -> Name -> Dec +functionBody lensName fieldName = + FunD lensName [ + Clause [] ( + NormalB ( + AppE (AppE (VarE (mkName "lens")) (VarE fieldName)) -- getter + (LamE [VarP (mkName "b"), VarP (mkName "a")] -- setter + (RecUpdE (VarE (mkName "a")) [(fieldName, VarE (mkName "b"))]) + ) + ) + ) [] ]