diff --git a/Data/Record/Label.hs b/Data/Record/Label.hs --- a/Data/Record/Label.hs +++ b/Data/Record/Label.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeOperators, TypeSynonymInstances, TemplateHaskell #-} module Data.Record.Label ( -- * Getter, setter and modifier types. @@ -7,93 +7,124 @@ , Modifier -- * Label type. - , (:->) (..) - , mkModifier - , mkLabel - - -- * Identity and composition. - , idL - , (%) + , Point + , (:->) (Label) + , label + , get, set, mod -- * Bidirectional functor. - - , Lens (..) - , (%%) + , (:<->:) (..) + , (<->) + , Iso (..) + , for -- * State monadic label operations. , getM, setM, modM, (=:) - -- * Useful example labels. - , list - , maybeNull - -- * Derive labels using Template Haskell. , module Data.Record.Label.TH - - ) where + ) +where -import Prelude hiding ((.), id) +import Prelude hiding ((.), id, mod) +import Control.Applicative import Control.Category -import Control.Monad.State +import Control.Monad.State hiding (get) import Data.Record.Label.TH -type Getter a b = a -> b -type Setter a b = b -> a -> a -type Modifier a b = (b -> b) -> a -> a +type Getter f o = f -> o +type Setter f i = i -> f -> f +type Modifier f i o = (o -> i) -> f -> f -data a :-> b = Label - { lget :: Getter a b - , lset :: Setter a b - , lmod :: Modifier a b +data Point f i o = Point + { _get :: Getter f o + , _set :: Setter f i } --- | Create a modifier function out of a getter and a setter. +_mod :: Point f i o -> (o -> i) -> f -> f +_mod l f a = _set l (f (_get l a)) a -mkModifier :: Getter a b -> Setter a b -> Modifier a b -mkModifier gg ss f a = ss (f (gg a)) a +newtype (f :-> a) = Label { unLabel :: Point f a a } --- | Smart constructor for `Label's, the modifier will be computed based on --- getter and setter. +-- Create a label out of a getter and setter. -mkLabel :: Getter a b -> Setter a b -> a :-> b -mkLabel g s = Label g s (mkModifier g s) +label :: Getter f a -> Setter f a -> f :-> a +label g s = Label (Point g s) -idL :: a :-> a -idL = mkLabel id const +-- | Get the getter function from a label. -infixr 8 % -(%) :: (g :-> a) -> (f :-> g) -> (f :-> a) -a % b = Label (lget a . lget b) (lmod b . lset a) (lmod b . lmod a) +get :: (f :-> a) -> f -> a +get = _get . unLabel +-- | Get the setter function from a label. + +set :: (f :-> a) -> a -> f -> f +set = _set . unLabel + +-- | Get the modifier function from a label. + +mod :: (f :-> a) -> (a -> a) -> f -> f +mod = _mod . unLabel + instance Category (:->) where - id = idL - (.) = (%) + id = Label (Point id const) + (Label a) . (Label b) = Label (Point (_get a . _get b) (_mod b . _set a)) --- Apply custom `parser' and 'printer' function. This can be seen as a --- bidirectional functorial map. +instance Functor (Point f i) where + fmap f x = Point (f . _get x) (_set x) -class Lens f where - lmap :: (a -> b, b -> a) -> f a -> f b +instance Applicative (Point f i) where + pure a = Point (const a) (const id) + a <*> b = Point (\f -> _get a f (_get b f)) (\r -> _set b r . _set a r) -instance Lens ((:->) f) where - lmap (f, g) (Label a b c) = Label (f . a) (b . g) (c . (g.) . (.f)) +-- | This isomorphism type class is like a `Functor' but works in two directions. --- | Apply label to lifted value and join afterwards. +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) -infixr 8 %% -(%%) :: Functor f => a :-> b -> g :-> f a -> g :-> f b -(%%) a b = let (Label g s _) = a in (fmap g, fmap (\k -> s k (error "unused"))) `lmap` b +-- | The lens datatype, a function that works in two directions. To bad there +-- is no convenient way to do application for this. +data a :<->: b = Lens { fw :: a -> b, bw :: b -> a } + +-- | Constructor for lenses. + +infixr 7 <-> +(<->) :: (a -> b) -> (b -> a) -> a :<->: b +a <-> b = Lens a b + +instance Category (:<->:) where + id = Lens id id + (Lens a b) . (Lens c d) = Lens (a . c) (d . b) + +instance Iso ((:->) i) where + iso l (Label a) = Label (Point (fw l . _get a) (_set a . bw l)) + +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. +-- (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) + -- | Get a value out of state pointed to by the specified label. getM :: MonadState s m => s :-> b -> m b -getM = gets . lget +getM = gets . get -- | Set a value somewhere in state pointed to by the specified label. setM :: MonadState s m => s :-> b -> b -> m () -setM l = modify . lset l +setM l = modify . set l -- | Alias for `setM' that reads like an assignment. @@ -105,15 +136,5 @@ -- specified label. modM :: MonadState s m => s :-> b -> (b -> b) -> m () -modM l = modify . lmod l - --- Lift list indexing to a label. - -list :: Int -> [a] :-> a -list i = mkLabel (!! i) (\v a -> take i a ++ [v] ++ drop (i+1) a) - --- View null lists as Nothing. - -maybeNull :: [a] :-> Maybe [a] -maybeNull = (\x -> if null x then Nothing else Just x, maybe [] id) `lmap` id +modM l = modify . mod l diff --git a/Data/Record/Label/TH.hs b/Data/Record/Label/TH.hs --- a/Data/Record/Label/TH.hs +++ b/Data/Record/Label/TH.hs @@ -1,22 +1,10 @@ module Data.Record.Label.TH (mkLabels) where -import Control.Monad (liftM) -import Data.Char (toLower, toUpper) -import Language.Haskell.TH - ( Body (NormalB) - , Clause (Clause) - , Con (RecC) - , Dec (DataD, FunD) - , Exp (AppE, LamE, RecUpdE, VarE) - , Info (TyConI) - , Name - , Pat (VarP) - , Q - , mkName - , nameBase - , reify) -import Language.Haskell.TH.Syntax (VarStrictType) +import Control.Monad +import Data.Char +import Language.Haskell.TH.Syntax +-- | Derive labels for all the record selector in a datatype. mkLabels :: [Name] -> Q [Dec] mkLabels = liftM concat . mapM mkLabels1 @@ -40,13 +28,8 @@ (f : rest) -> 'l' : toUpper f : rest _ -> "" in FunD n [Clause [] (NormalB ( - AppE (AppE (VarE (mkName "mkLabel")) - (VarE name)) -- getter + AppE (AppE (VarE (mkName "label")) (VarE name)) -- getter (LamE [VarP (mkName "b"), VarP (mkName "a")] -- setter (RecUpdE (VarE (mkName "a")) [(name, VarE (mkName "b"))])) )) []] - -{-isRec :: Con -> Bool -isRec (RecC _ _) = True -isRec _ = False-} diff --git a/fclabels.cabal b/fclabels.cabal --- a/fclabels.cabal +++ b/fclabels.cabal @@ -1,15 +1,134 @@ Name: fclabels -Version: 0.3.0 -Author: Sebastiaan Visser, Erik Hesselink +Version: 0.4.0 +Author: Sebastiaan Visser, Erik Hesselink, Chris Eidhof, Sjoerd Visscher. Synopsis: First class accessor labels. + Description: First class labels that act as bidirectional records fields. The labels are fully composable and can be used to get, set and modify part of datatypes in a consistent way. The label datatype, conveniently called `:->', is an instance of the - `Category' type class, so is has a proper identity and + `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. + underscore. Labels can be used in a pure 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): + . + > 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 with + 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: + . + > $(mkLabels [''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: + . + > name :: Person :-> String + > age :: Person :-> Int + > isMale :: Person :-> Bool + > place :: Person :-> Place + > city :: Place :-> String + > country :: Place :-> String + > continent :: Place :-> String + . + 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 + to get, set and modify the value and are fully composable. + . + Now let look at this example. This 71 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: + . + > 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 + city value deep inside the structure: + . + > moveToAmsterdam :: Person -> Person + > moveToAmsterdam = set (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 @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 + 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 = Label $ (,) <$> 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 labels, 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 + 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. + . + Now that we have an appropriate age+city view on the @Person@ + data type (which is itself a label again), we can use the + @mod@ function to make Jan move to Amsterdam over exactly two + years: + . + > moveToAmsterdamOverTwoYears :: Person -> Person + > moveToAmsterdamOverTwoYears = mod 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 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 + @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 + 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. + Maintainer: Sebastiaan Visser License: BSD3 License-File: LICENCE