fclabels-1.1.4.3/0000755000000000000000000000000012022175113011611 5ustar0000000000000000fclabels-1.1.4.3/fclabels.cabal0000644000000000000000000000403712022175113014354 0ustar0000000000000000Name: fclabels Version: 1.1.4.3 Author: Sebastiaan Visser, Erik Hesselink, Chris Eidhof, Sjoerd Visscher with lots of help and feedback from others. 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. . > 1.1.4.2 -> 1.1.4.3 > - Make compilable against template haskell 2.8. > Thanks to mgsloan for the pull request. Maintainer: Sebastiaan Visser License: BSD3 License-File: LICENSE Category: Data Cabal-Version: >= 1.6 Build-Type: Simple Library HS-Source-Dirs: src 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.9 , mtl >= 1.0 && < 2.2 , transformers >= 0.2 && < 0.4 Source-Repository head Type: git Location: git://github.com/sebastiaanvisser/fclabels.git fclabels-1.1.4.3/LICENSE0000644000000000000000000000272412022175113012623 0ustar0000000000000000Copyright (c) Erik Hesselink & Sebastiaan Visser 2008 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. fclabels-1.1.4.3/Setup.lhs0000644000000000000000000000011612022175113013417 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain fclabels-1.1.4.3/src/0000755000000000000000000000000012022175113012400 5ustar0000000000000000fclabels-1.1.4.3/src/Data/0000755000000000000000000000000012022175113013251 5ustar0000000000000000fclabels-1.1.4.3/src/Data/Label.hs0000644000000000000000000001212112022175113014621 0ustar0000000000000000{-# 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. -} -- | -- >{-# LANGUAGE TemplateHaskell, TypeOperators #-} -- >import Control.Category -- >import Data.Label -- >import Prelude hiding ((.), id) -- > -- >data Person = Person -- > { _name :: String -- > , _age :: Int -- > , _isMale :: Bool -- > , _place :: Place -- > } deriving Show -- > -- >data Place = Place -- > { _city -- > , _country -- > , _continent :: String -- > } deriving Show {- | 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: >import Control.Applicative >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, _) -> (a+2, "Amsterdam")) >ghci> moveToAmsterdamOverTwoYears jan >Person "Jan" 73 True (Place "Amsterdam" "The Netherlands" "Europe") -} , Lens (Lens) -- * 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 `iso` 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 , mkLabel , mkLabelsWith , mkLabelsMono , mkLabelsNoTypes ) where import Data.Label.Abstract (Bijection(..), Iso(..), for, Lens(..)) import Data.Label.Pure import Data.Label.Derive fclabels-1.1.4.3/src/Data/Label/0000755000000000000000000000000012022175113014270 5ustar0000000000000000fclabels-1.1.4.3/src/Data/Label/Abstract.hs0000644000000000000000000000702512022175113016373 0ustar0000000000000000{-# LANGUAGE TypeOperators , Arrows , TupleSections , FlexibleInstances , MultiParamTypeClasses #-} module Data.Label.Abstract where import Control.Arrow import Prelude hiding ((.), id) import Control.Applicative import Control.Category {-# INLINE _modify #-} {-# INLINE lens #-} {-# INLINE get #-} {-# INLINE set #-} {-# INLINE modify #-} {-# INLINE bimap #-} {-# INLINE for #-} {-# INLINE liftBij #-} -- | Abstract Point datatype. The getter and setter functions work in some -- arrow. 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 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 arr f a = Lens { unLens :: Point arr f a a } -- | Create a lens out of a getter and setter. 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 arr => Lens arr f a -> f `arr` a get = _get . unLens -- | Get the setter arrow from a lens. set :: Arrow arr => Lens arr f a -> (a, f) `arr` f set = _set . unLens -- | Get the modifier arrow from a lens. modify :: ArrowApply arr => Lens arr f o -> (o `arr` o, f) `arr` f modify = _modify . unLens 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 arr => Functor (Point arr f i) where fmap f x = Point (arr f . _get x) (_set x) {-# INLINE fmap #-} 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 #-} {-# INLINE (<*>) #-} -- | Make a 'Point' diverge in two directions. 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 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. infix 8 `Bij` data Bijection arr a b = Bij { fw :: a `arr` b, bw :: b `arr` a } -- | Bijections as categories. instance Category arr => Category (Bijection arr) where id = Bij id id 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 = 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 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 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 arr => Iso arr (Bijection arr a) where iso = arr . (.) {-# INLINE iso #-} fclabels-1.1.4.3/src/Data/Label/Derive.hs0000644000000000000000000001741112022175113016046 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} {-# LANGUAGE TemplateHaskell , OverloadedStrings , FlexibleContexts , FlexibleInstances , TypeOperators , CPP #-} module Data.Label.Derive ( mkLabels , mkLabel , mkLabelsWith , mkLabelsMono , mkLabelsNoTypes ) where import Control.Arrow import Control.Category import Control.Monad import Data.Char import Data.Function (on) import Data.Label.Abstract import Data.Label.Pure ((:->)) import Data.Label.Maybe ((:~>)) 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 for a -- collection of datatypes. The types will be polymorphic and can be used in an -- arbitrary context. mkLabels :: [Name] -> Q [Dec] mkLabels = mkLabelsWith defaultMakeLabel -- | Derive lenses including type signatures for all the record selectors in a -- single datatype. The types will be polymorphic and can be used in an -- arbitrary context. mkLabel :: Name -> Q [Dec] mkLabel = mkLabels . return -- | Generate the label name from the record field name. -- For instance, @drop 1 . dropWhile (/='_')@ creates a label @val@ from a -- record @Rec { rec_val :: X }@. mkLabelsWith :: (String -> String) -> [Name] -> Q [Dec] mkLabelsWith makeLabel = liftM concat . mapM (derive1 makeLabel True False) -- | Derive lenses including type signatures for all the record selectors in a -- datatype. The signatures will be concrete and can only be used in the -- appropriate context. mkLabelsMono :: [Name] -> Q [Dec] mkLabelsMono = liftM concat . mapM (derive1 defaultMakeLabel True True) -- | Derive lenses without type signatures for all the record selectors in a -- datatype. mkLabelsNoTypes :: [Name] -> Q [Dec] mkLabelsNoTypes = liftM concat . mapM (derive1 defaultMakeLabel False False) -- Helpers to generate all labels for one datatype. derive1 :: (String -> String) -> Bool -> Bool -> Name -> Q [Dec] derive1 makeLabel signatures concrete 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 makeLabel signatures concrete 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. -- | 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. defaultMakeLabel :: String -> String defaultMakeLabel field = case field of '_' : c : rest -> toLower c : rest f : rest -> 'l' : toUpper f : rest n -> fclError ("Cannot derive label for record selector with name: " ++ n) derive :: (String -> String) -> Bool -> Bool -> Name -> [TyVarBndr] -> Int -> (VarStrictType, [Name]) -> Q [Dec] derive makeLabel signatures concrete tyname vars total ((field, _, fieldtyp), ctors) = do (sign, body) <- if length ctors == total then function derivePureLabel else function deriveMaybeLabel return $ if signatures then [sign, inline, body] else [inline, body] where -- Generate an inline declaration for the label. -- -- Type of InlineSpec removed in TH-2.8.0 (GHC 7.6) #if MIN_VERSION_template_haskell(2,8,0) inline = PragmaD (InlineP labelName Inline FunLike (FromPhase 0)) #else inline = PragmaD (InlineP labelName (InlineSpec True True (Just (True, 0)))) #endif labelName = mkName (makeLabel (nameBase field)) -- Build a single record label definition for labels that might fail. deriveMaybeLabel = (if concrete then mono else poly, body) where mono = forallT prettyVars (return []) [t| $(inputType) :~> $(return prettyFieldtyp) |] poly = forallT forallVars (return []) [t| (ArrowChoice $(arrow), ArrowZero $(arrow)) => Lens $(arrow) $(inputType) $(return prettyFieldtyp) |] body = [| lens (fromRight . $(getter)) (fromRight . $(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 field v ) |] bodyG p = [| Right $( varE field `appE` p ) |] -- Build a single record label definition for labels that cannot fail. derivePureLabel = (if concrete then mono else poly, body) where mono = forallT prettyVars (return []) [t| $(inputType) :-> $(return prettyFieldtyp) |] poly = forallT forallVars (return []) [t| Arrow $(arrow) => Lens $(arrow) $(inputType) $(return prettyFieldtyp) |] body = [| lens $(getter) $(setter) |] where getter = [| arr $(varE field) |] setter = [| arr (\(v, p) -> $(record [| p |] field [| v |])) |] -- Compute the type (including type variables of the record datatype. inputType = return $ foldr (flip AppT) (ConT tyname) (map tvToVarT (reverse prettyVars)) -- Convert a type variable binder to a regular type variable. tvToVarT (PlainTV tv ) = VarT tv tvToVarT (KindedTV tv kind) = SigT (VarT tv) kind -- Prettify type variables. arrow = varT (mkName "arr") prettyVars = map prettyTyVar vars forallVars = PlainTV (mkName "arr") : prettyVars prettyFieldtyp = prettyType fieldtyp -- Q style record updating. record rec fld val = val >>= \v -> recUpdE rec [return (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) [] ]) fromRight :: (ArrowChoice a, ArrowZero a) => a (Either b d) d fromRight = zeroArrow ||| returnA ------------------------------------------------------------------------------- -- Helper functions to prettify type variables. prettyName :: Name -> Name prettyName tv = mkName (takeWhile (/='_') (show tv)) prettyTyVar :: TyVarBndr -> TyVarBndr prettyTyVar (PlainTV tv ) = PlainTV (prettyName tv) prettyTyVar (KindedTV tv ki) = KindedTV (prettyName tv) ki prettyType :: Type -> Type prettyType (ForallT xs cx ty) = ForallT (map prettyTyVar xs) (map prettyPred cx) (prettyType ty) prettyType (VarT nm ) = VarT (prettyName nm) prettyType (AppT ty tx ) = AppT (prettyType ty) (prettyType tx) prettyType (SigT ty ki ) = SigT (prettyType ty) ki prettyType ty = ty prettyPred :: Pred -> Pred prettyPred (ClassP nm tys) = ClassP (prettyName nm) (map prettyType tys) prettyPred (EqualP ty tx ) = EqualP (prettyType ty) (prettyType tx) -- 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 fclabels-1.1.4.3/src/Data/Label/Maybe.hs0000644000000000000000000000411612022175113015663 0ustar0000000000000000{-# LANGUAGE TypeOperators, TupleSections #-} module Data.Label.Maybe ( (:~>) , lens , get , set , set' , modify , 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,)) -- | Like 'set' but return behaves like the identity function when the field -- could not be set. set' :: (f :~> a) -> a -> f -> f set' l v f = f `fromMaybe` set l v f -- | 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,)) -- | Like 'modify' but return behaves like the identity function when the field -- could not be set. modify' :: (f :~> a) -> (a -> a) -> f -> f modify' l m f = f `fromMaybe` modify l m f -- | 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))) fclabels-1.1.4.3/src/Data/Label/MaybeM.hs0000644000000000000000000000161012022175113015774 0ustar0000000000000000{-# 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) fclabels-1.1.4.3/src/Data/Label/Pure.hs0000644000000000000000000000142212022175113015536 0ustar0000000000000000{-# 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 fclabels-1.1.4.3/src/Data/Label/PureM.hs0000644000000000000000000000266512022175113015665 0ustar0000000000000000{-# 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 -- | 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 -- | Alias for `puts' that reads like an assignment. infixr 2 =: (=:) :: M.MonadState s m => s :-> a -> a -> m () (=:) = puts -- | Alias for `modify' that reads more or less like an assignment. infixr 2 =. (=.) :: M.MonadState s m => s :-> a -> (a -> a) -> m () (=.) = modify -- | 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)