yall (empty) → 0.1
raw patch · 6 files changed
+802/−0 lines, 6 filesdep +basedep +categoriesdep +transformerssetup-changed
Dependencies added: base, categories, transformers
Files
- Data/Yall.hs +39/−0
- Data/Yall/Iso.hs +277/−0
- Data/Yall/Lens.hs +390/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- yall.cabal +64/−0
+ Data/Yall.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TypeOperators #-}+module Data.Yall (+ {- | + This is a subset of 'Data.Yall.Lens', exporting only the basic API.+ Furthermore, 'get', 'lensM', getM, setM, and modifyM are exported with+ more restrictive types than are found in Data.Yall.Lens, for simplicity.++ You should either import this module, or 'Data.Yall.Lens'.+ -}+ -- * Pure lenses+ (:->)+ , lens, get, set, modify+ -- * Partial lenses+ , (:~>)+ , lensM, getM, setM, modifyM+ ) where++import Data.Yall.Lens hiding (get, lensM, getM, setM, modifyM)+import qualified Data.Yall.Lens as L++-- | Run the getter function of a pure lens+get :: (a L.:-> b) -> a -> b+get = L.get++-- | Create a partial lens from a getter and setter+lensM :: (a -> Maybe b) -> (a -> Maybe (b -> a)) -> (a L.:~> b)+lensM = L.lensM++-- | Try to run the getter function on a value +getM :: (a L.:~> b) -> a -> Maybe b+getM = L.getM++-- | try to run the setter function on an outer and new inner value+setM :: (a L.:~> b) -> b -> a -> Maybe a+setM = L.setM ++-- | try to modify the inner type of a value+modifyM :: (a L.:~> b) -> (b -> b) -> a -> Maybe a+modifyM = L.modifyM
+ Data/Yall/Iso.hs view
@@ -0,0 +1,277 @@+{-# LANGUAGE TypeOperators , MultiParamTypeClasses , FlexibleInstances, FlexibleContexts, GeneralizedNewtypeDeriving , TypeFamilies #-}+module Data.Yall.Iso (+ {- |+ Iso is similar but more flexible than Lens in that they have no dependency on+ context. This flexibility affords a number of nice class instances that we+ don't get with Lens, so these can be quite useful in combination. See 'isoL'+ for converting to 'Lens'.++ A less imprecise name for the code here might be @Bijection@ but no one wants+ to type that.+ -}+ Iso(..)+ , inverseI+ -- * Convenient Iso types+ -- ** Pure isomorphisms+ , (:<->)+ , iso+ , ($-), (-$)+ -- *** Wrapped pure Iso+ , IsoPure(..), ifmap, fromPure+ -- *** Pre-defined isomorphisms+ {- | Note: while all of these are pure and could be expressed as '(:<->)', we+ define them polymorphically in @Monad@ for maximum flexibility in+ composing with other @Lens@ or @Iso@.++ Also note that for most of these @apply i . unapply i@ is not strictly+ @id@, e.g. @zipI@ obviously truncates lists of differing length, etc.+ This is officially not something I'm concerned about.+ -}+ , wordsI, showI, linesI, curryI, enumI, integerI, rationalI, zipI+ , incrementI, incrementByI, consI+ , distributeI, factorI++ -- ** Partial isomorphisms+ , (:<~>)+ ) where++++import Prelude hiding ((.),id)+import Control.Category+import Data.Functor.Identity+import Control.Monad++-- from 'categories':+import qualified Control.Categorical.Functor as C+import Control.Categorical.Bifunctor+import Control.Category.Associative+import Control.Category.Braided+import Control.Category.Monoidal+import Control.Category.Distributive+++-- | An Isomorphism or one-to-one mapping between types. These are very similar+-- to a 'Lens', but are not dependent on context, making them more flexible. The+-- functions also alow a Monadic context, supporting partial isomorphisms, and +-- other interesting functionality.+data Iso w m a b = Iso { apply :: a -> m b+ , unapply :: b -> w a }++instance (Monad m, Monad w)=> Category (Iso w m) where+ id = iso id id+ g . f = Iso (apply f >=> apply g) (unapply g >=> unapply f)++-- | A wrapper for a more @(->)@-like Functor instances+newtype IsoPure a b = IsoPure { isoPure :: Iso Identity Identity a b }+ deriving (Category) ++-- ghetto deriving:+pureWrapped :: (Iso Identity Identity a1 b1 -> Iso Identity Identity a b)+ -> IsoPure a1 b1+ -> IsoPure a b+pureWrapped2 :: (Iso Identity Identity a1 b1+ -> Iso Identity Identity a2 b2+ -> Iso Identity Identity a b)+ -> IsoPure a1 b1+ -> IsoPure a2 b2+ -> IsoPure a b+pureWrapped2 f a b = IsoPure $ f (isoPure a) (isoPure b)+pureWrapped f = IsoPure . f . isoPure++instance PFunctor (,) IsoPure IsoPure where+ first = pureWrapped first+instance QFunctor (,) IsoPure IsoPure where+ second = pureWrapped second+instance Bifunctor (,) IsoPure IsoPure IsoPure where+ bimap = pureWrapped2 bimap+instance PFunctor Either IsoPure IsoPure where+ first = pureWrapped first+instance QFunctor Either IsoPure IsoPure where+ second = pureWrapped second+instance Bifunctor Either IsoPure IsoPure IsoPure where+ bimap = pureWrapped2 bimap++instance Associative IsoPure (,) where+ associate = IsoPure associate+instance Associative IsoPure Either where+ associate = IsoPure associate+instance Disassociative IsoPure (,) where+ disassociate = IsoPure disassociate+instance Disassociative IsoPure Either where+ disassociate = IsoPure disassociate++instance Braided IsoPure (,) where+ braid = IsoPure braid+instance Braided IsoPure Either where+ braid = IsoPure braid+instance Symmetric IsoPure Either where+instance Symmetric IsoPure (,) where++type instance Id IsoPure (,) = ()+instance Monoidal IsoPure (,) where+ idl = IsoPure idl+ idr = IsoPure idr+instance Comonoidal IsoPure (,) where+ coidl = IsoPure coidl+ coidr = IsoPure coidr+++-- | A more categorical 'fmap', with wrapping / unwrapping for convenience. See+-- also the 'C.Functor' instances for 'Iso'.+--+-- > ifmap = fromPure . C.fmap . IsoPure+ifmap :: (Monad w, Monad m, C.Functor f IsoPure IsoPure)=> Iso Identity Identity a b -> Iso w m (f a) (f b)+ifmap = fromPure . C.fmap . IsoPure++-- | Unwrap and make polymorphic an 'IsoPure'+fromPure :: (Monad w, Monad m)=> IsoPure a b -> Iso w m a b+fromPure (IsoPure (Iso f g)) = iso (fmap runIdentity f) (fmap runIdentity g)+++-- Control.Categorical.Functor+instance (Functor f)=> C.Functor f IsoPure IsoPure where+ fmap (IsoPure (Iso f g)) = + IsoPure $ iso (fmap $ fmap runIdentity f) (fmap $ fmap runIdentity g)++instance (Monad m)=> C.Functor m (Iso m m) (Iso Identity Identity) where+ fmap (Iso f g) = iso (>>= f) (>>= g)++++-- Control.Categorical.Bifunctor+instance (Monad m, Monad w)=> PFunctor (,) (Iso w m) (Iso w m) where+ first = firstDefault+instance (Monad m, Monad w)=> QFunctor (,) (Iso w m) (Iso w m) where+ second = secondDefault++instance (Monad m, Monad w)=> Bifunctor (,) (Iso w m) (Iso w m) (Iso w m) where+ bimap (Iso f g) (Iso f' g') = Iso (bimapM f f') (bimapM' g g')+ -- WHY DOES TypeFamilies CAUSE PROBLEMS WITH THIS?:+ where bimapM x = fmap extractJoinT . bimap x+ bimapM' x = fmap extractJoinT . bimap x++instance (Monad m, Monad w)=> PFunctor Either (Iso w m) (Iso w m) where+ first = firstDefault+instance (Monad m, Monad w)=> QFunctor Either (Iso w m) (Iso w m) where+ second = secondDefault++instance (Monad m, Monad w)=> Bifunctor Either (Iso w m) (Iso w m) (Iso w m) where+ bimap (Iso f g) (Iso f' g') = Iso (bimapM f f') (bimapM' g g')+ where bimapM x = fmap extractJoinE . bimap x+ bimapM' x = fmap extractJoinE . bimap x+++-- Does this already exist in Categories? +-- :: k (m a) (m b) -> m (k a b)+-- For k = Either / (,)+-- m = any Monad+extractJoinE :: (Monad m)=> Either (m a) (m b) -> m (Either a b)+extractJoinE = either (liftM Left) (liftM Right)+extractJoinT :: (Monad m)=> (m a, m b) -> m (a,b)+extractJoinT = uncurry $ liftM2 (,)++-- Control.Category.Associative+instance (Monad m, Monad w)=> Associative (Iso w m) (,) where+ associate = iso associate disassociate++instance (Monad m, Monad w)=> Associative (Iso w m) Either where+ associate = iso associate disassociate+ +instance (Monad m, Monad w)=> Disassociative (Iso w m) (,) where+ disassociate = iso disassociate associate++instance (Monad m, Monad w)=> Disassociative (Iso w m) Either where+ disassociate = iso disassociate associate++-- Control.Category.Braided+instance (Monad m, Monad w)=> Braided (Iso w m) (,) where+ braid = iso braid braid++instance (Monad m, Monad w)=> Braided (Iso w m) Either where+ braid = iso braid braid++instance (Monad m, Monad w)=> Symmetric (Iso w m) (,) where+instance (Monad m, Monad w)=> Symmetric (Iso w m) Either where++distributeI :: (Monad m, Monad w)=> Iso w m (a, Either b c) (Either (a,b) (a,c))+distributeI = iso distribute factor++factorI :: (Monad m, Monad w)=> Iso w m (Either (a,b) (a,c)) (a, Either b c)+factorI = iso factor distribute++-- Control.Category.Monoidal+type instance Id (Iso w m) (,) = ()++instance (Monad m, Monad w)=> Monoidal (Iso w m) (,) where+ idl = iso idl coidl + idr = iso idr coidr++instance (Monad m, Monad w)=> Comonoidal (Iso w m) (,) where+ coidl = iso coidl idl + coidr = iso coidr idr +++-- | See also an Iso wrapped in 'Dual'+inverseI :: (Monad m, Monad w)=> Iso w m a b -> Iso m w b a+inverseI (Iso f g) = Iso g f++-- | a partial Isomorphism+type a :<~> b = Iso Maybe Maybe a b++-- | pure Iso+type a :<-> b = Iso Identity Identity a b++iso :: (Monad m, Monad w)=> (a -> b) -> (b -> a) -> Iso w m a b+iso f g = Iso (fmap return f) (fmap return g)++-- | apply the forward function+-- +-- > i $- a = runIdentity $ apply i a+($-) :: (a :<-> b) -> a -> b+i $- a = runIdentity $ apply i a++-- | apply the backward function+-- +-- > i -$ b = runIdentity $ unapply i b+(-$) :: (a :<-> b) -> b -> a+i -$ b = runIdentity $ unapply i b+++------------- +wordsI :: (Monad m, Monad w)=> Iso w m String [String]+wordsI = iso words unwords++linesI :: (Monad m, Monad w)=> Iso w m String [String]+linesI = iso lines unlines++showI :: (Read s, Show s, Monad w, Monad m)=> Iso w m s String+showI = iso show read++-- TODO or leave this as the instance above???+curryI :: (Monad m, Monad w)=> Iso w m ((a,b) -> c) (a -> b -> c)+curryI = iso curry uncurry++enumI :: (Enum a, Monad m, Monad w)=> Iso w m Int a+enumI = iso toEnum fromEnum++integerI :: (Integral a, Monad m, Monad w)=> Iso w m a Integer+integerI = iso toInteger fromInteger++rationalI :: (Real a, Fractional a, Monad m, Monad w)=> Iso w m a Rational+rationalI = iso toRational fromRational++zipI :: (Monad m, Monad w)=> Iso w m ([a],[b]) [(a,b)]+zipI = iso (uncurry zip) unzip++incrementI :: (Monad m, Monad w, Num a)=> Iso w m a a+incrementI = incrementByI 1++incrementByI :: (Monad m, Monad w, Num a)=> a -> Iso w m a a+incrementByI n = iso (+n) (subtract n)++-- | Calls 'fail' on the empty list.+consI :: (Monad m, Monad w)=> Iso w m (a,[a]) [a]+consI = Iso (\(a,as)-> return (a:as)) unconsI+ where unconsI [] = fail "empty list"+ unconsI (a:as) = return (a,as)
+ Data/Yall/Lens.hs view
@@ -0,0 +1,390 @@+{-# LANGUAGE MultiParamTypeClasses, TypeOperators, TypeFamilies , FlexibleInstances #-}+module Data.Yall.Lens (+ {- | + The Lenses here are parameterized over two Monads (by convention @m@ and+ @w@), so that the \"extract\" and \"rebuild\" phases of a lens set operation+ each happen within their own environment. + + Concretely, a lens like (':->') with both environments set to the trivial+ 'Identity' Monad, gives us the usual pure lens, whereas something like+ (':~>'), where the @m@ environment is @Maybe@ gives one possibility for a+ partial lens. These would be suitable for multi-constructor data types.+ + One might also like to use a lens as an interface to a type, capable of performing+ validation (beyond the capabilities of the typechecker). In that case the+ @w@ environment becomes useful, and you might have @:: Lens Maybe Identity+ PhoneNumber [Int]@.++ See \"Monadic API\" below for a concrete example.+ -}+ Lens(..)+ -- * Simple API+ -- ** Pure lenses+ , (:->)+ , lens, get, set, modify+ -- ** Partial lenses+ , (:~>)++ -- * Monadic API+ {- |+ In addition to defining lenses that can fail and perform validation, we+ have the ability to construct more abstract and expressive Lenses. Here is+ an example of a lens on the \"N-th\" element of a list, that returns its+ results in the [] monad:+ -}++-- |+-- > nth :: LensM [] [a] a+-- > nth = Lens $ foldr build []+-- > where build n l = (return . (: map snd l), n) : map (prepend n) l+-- > prepend = first . fmap . liftM . (:)+--+-- We can compose this with other lenses like the lens on the @snd@ of a+-- tuple, just as we would like:+--+-- >>> setM (sndL . nth) 0 [('a',1),('b',2),('c',3)]+-- [[('a',0),('b',2),('c',3)],[('a',1),('b',0),('c',3)],[('a',1),('b',2),('c',0)]]+++ -- ** Lenses with monadic getters+ , LensM+ , lensM+ , getM, setM, modifyM + -- ** Monadic variants+ {- | The setter continuation is embedded in the getter\'s Monadic+ environment, so we offer several ways of combining different types of+ getter environments(@m@) and setter environments (@w@), for Lenses+ with complex effects.+ -}+ , lensMW+ , setW, modifyW+ , setLiftM, setLiftW, setJoin+ -- *** Monoid setters+ , setEmpty, setEmptyM, setEmptyW++ -- * Composing Lenses+ {- |+ In addition to the usual 'Category' instance, we define instances for+ 'Lens' for a number of category-level abstractions from the "categories"+ package. Here are the various combinators and pre-defined lenses from these+ classes, with types shown for a simplified @Lens@ type.+ -}++-- |+-- > import Control.Categorical.Bifunctor+-- > first :: Lens a b -> Lens (a,x) (b,x)+-- > second :: Lens a b -> Lens (x,a) (x,b)+-- > bimap :: Lens a b -> Lens x y -> Lens (a,x) (b,y)+-- +-- > import Control.Categorical.Object+-- > terminate :: Lens a ()+-- +-- > import Control.Category.Associative+-- > associate :: Lens ((a,b),c) (a,(b,c))+-- > disassociate :: Lens (a,(b,c)) ((a,b),c)+-- +-- > import Control.Category.Braided+-- > braid :: Lens (a,b) (b,a)+-- +-- > import Control.Category.Monoidal+-- > idl :: Lens ((), a) a+-- > idr :: Lens (a,()) a+-- > coidl :: Lens a ((),a)+-- > coidr :: Lens a (a,())+-- +-- > import qualified Control.Categorical.Functor as C+-- > C.fmap :: (Monad m)=> Lens m m a b -> (m a :-> m b)++ {- |+ In addition the following combinators and pre-defined lenses are provided.+ -}+ , fstL, sndL+ , eitherL, (|||)+ , factorL, distributeL+ , isoL++ -- * Convenience operators+ {- | The little \"^\" hats are actually superscript \"L\"s (for "Lens") that have fallen over.+ -}+ + , (^$), (^>>=)+ ) where++-- TODO+-- - for GHC 7.2, EK has switched to using DefaultSignatures in e.g. Bifunctor. See:+-- https://github.com/ekmett/categories/commit/81857ce79d6c24be08d827f115109f1c6b8971ea+-- at some point we'll want to upgrade this, and make the appropriate changes+-- - look at some of the looping combinators we use in pez and include here, e.g. untilL :: (a -> Bool) -> Lens a a -> Lens a a+++import Data.Yall.Iso++import Prelude hiding (id,(.))+import Control.Category++-- from 'categories':+import Control.Categorical.Bifunctor+import qualified Control.Categorical.Functor as C+import Control.Category.Associative+import Control.Category.Braided+import Control.Category.Monoidal+import Control.Category.Distributive+import Control.Categorical.Object++-- from 'semigroups':+--import Data.Semigroup++import Control.Monad+import Control.Monad.Trans.Class+import Data.Functor.Identity+import Data.Monoid+++{-+ TODO initial release+ template haskell library+-}++-- constrain these 'm's to Monad?+newtype Lens w m a b = Lens { runLens :: a -> m (b -> w a, b) }++-- | A lens in which the setter returns its result in the trivial identity +-- monad. This is appropriate e.g. for traditional partial lenses, where there is+-- a potential that the lens could fail only on the /outer/ constructor.+type LensM = Lens Identity++-- | Create a monadic lens from a getter and setter+lensM :: (Monad m)=> (a -> m b) -> (a -> m (b -> a)) -> LensM m a b+lensM g = lensMW g . fmap (liftM $ fmap return)++-- | get, returning the result in a Monadic environment. This is appropriate+-- e.g. for traditional partial lenses on multi-constructor types. See also+-- 'setM'+getM :: (Monad m)=> Lens w m a b -> a -> m b+getM (Lens f) = liftM snd . f++-- | set, returning the result in the getter\'s Monadic environment, running +-- the setter\'s trivial Identity monad. +setM :: (Monad m)=> LensM m a b -> b -> a -> m a+setM (Lens f) b = liftM (runIdentity . ($ b) . fst) . f++-- | modify the inner value within the getter\'s Monadic environment +modifyM :: (Monad m)=> LensM m a b -> (b -> b) -> a -> m a+modifyM (Lens f) g a = do+ (bWa, b) <- f a+ return (runIdentity $ bWa $ g b)++modifyW :: (Monad w)=> Lens w Identity a b -> (b -> b) -> a -> w a+modifyW (Lens f) g = uncurry ($) . second g . runIdentity . f++-- | Create a monadic Lens from a setter and getter.+--+-- > lensMW g s = Lens $ \a-> liftM2 (,) (s a) (g a)+lensMW :: (Monad m)=> (a -> m b) -> (a -> m (b -> w a)) -> Lens w m a b+lensMW g s = Lens $ \a-> liftM2 (,) (s a) (g a)++-- | set, with Monadic setter & pure getter+setW :: (Monad w)=> Lens w Identity a b -> b -> a -> w a+setW (Lens f) b = ($ b) . fst . runIdentity . f ++-- | set, 'lift'ing the outer (getter\'s) Monadic environment to the type of+-- the setter monad transformer.+setLiftM :: (Monad (t m), MonadTrans t, Monad m)=> Lens (t m) m a b -> b -> a -> t m a +setLiftM (Lens f) b = join . liftM (($ b) . fst) . lift . f ++-- | set, like 'setLiftM' but we 'lift' the /inner/ setter\'s environment to+-- the outer getter monad transformer.+setLiftW :: (MonadTrans t, Monad (t w), Monad w)=> Lens w (t w) a b -> b -> a -> t w a+setLiftW (Lens f) b a = lift . ($ b) . fst =<< f a ++ ++-- | set, combining the effects of the identical setter and getter Monads with+-- 'join'.+setJoin :: (Monad m)=> Lens m m a b -> b -> a -> m a+setJoin (Lens f) b a = f a >>= ($ b) . fst++instance (Monad w, Monad m)=> Category (Lens w m) where+ id = Lens $ return . (,) return+ (Lens f) . (Lens g) = + Lens $ \a-> do + (bWa,b) <- g a+ (cMb,c) <- f b+ return (cMb >=> bWa, c)++-- BIFUNCTOR: --+instance (Monad w, Monad m)=> PFunctor (,) (Lens w m) (Lens w m) where+ --first :: Lens a b -> Lens (a,x) (b,x)+ first = firstDefault++instance (Monad w, Monad m)=> QFunctor (,) (Lens w m) (Lens w m) where+ second = secondDefault++instance (Monad w, Monad m)=> Bifunctor (,) (Lens w m) (Lens w m) (Lens w m) where+ bimap (Lens f) (Lens g) = + Lens $ \(a,c)-> do+ (bWa,b) <- f a + (dMc,d) <- g c+ let setCont (b',d') = liftM2 (,) (bWa b') (dMc d')+ return (setCont, (b,d))+++-- This lets us turn an effect-ful lens into a pure lens on Monad-wrapped+-- values. +-- TODO - useful to be able to go the other direction? e.g. :: (m a :-> m b) -> Lens m m a b+instance (Monad m)=>C.Functor m (Lens m m) (Lens Identity Identity) where+ fmap (Lens f) = Lens $ \ma ->+ let t = ma >>= f+ mb2Ima = return . join . ap (liftM fst t)+ in return (mb2Ima, liftM snd t)++++{- + - What is this for, and why isn't (->) an instance?+ - It is mentioned in the lib that (->) lacks an /initial/ object, but I+ - would guess the missing HasTerminalObject is an oversight+-}+instance (Monad w, Monad m)=> HasTerminalObject (Lens w m) where+ type Terminal (Lens w m) = ()+ --terminate :: Lens a ()+ terminate = Lens $ \a-> return (\()-> return a, ()) ++instance (Monad w, Monad m)=> Associative (Lens w m) (,) where+ --associate :: Lens ((a,b),c) (a,(b,c))+ associate = Lens $ \((a,b),c)-> return (\(a',(b',c'))-> return ((a',b'),c'), (a,(b,c)))++instance (Monad w, Monad m)=> Disassociative (Lens w m) (,) where+ --disassociate :: Lens (a,(b,c)) ((a,b),c)+ disassociate =Lens $ \(a,(b,c))-> return (\((a',b'),c') -> return (a',(b',c')), ((a,b),c))++instance (Monad w, Monad m)=> Braided (Lens w m) (,) where+ --braid :: Lens (a,b) (b,a)+ braid = Lens $ \(a,b) -> return (\(b',a')-> return (a',b') , (b,a))++instance (Monad w, Monad m)=> Symmetric (Lens w m) (,)++-- (CO)MONOIDAL ----------------------------------------++type instance Id (Lens w m) (,) = ()++-- THIS ABSTRACTS THE dropl/r FUNCTIONS FROM GArrow:+instance (Monad w, Monad m)=> Monoidal (Lens w m) (,) where + --idl :: Lens ((), a) a+ idl = Lens $ \((),a)-> return (\a'-> return ((),a'), a)+ idr = Lens $ \(a,())-> return (\a'-> return (a',()), a)++instance (Monad w, Monad m)=> Comonoidal (Lens w m) (,) where+ --coidl :: Lens a ((),a)+ coidl = Lens $ \a-> return (\((),a')-> return a', ((),a))+ coidr = Lens $ \a-> return (\(a',())-> return a', (a,()))++-- combinators from PreCartesian that preserve strict well-behavedness++fstL :: (Monad m, Monad w)=> Lens w m (a,b) a+fstL = Lens $ \(a,b)-> return (\a'-> return (a',b) , a)++sndL :: (Monad m, Monad w)=> Lens w m (a,b) b+sndL = Lens $ \(a,b)-> return (\b'-> return (a,b') , b)+++-- borrowed from PreCoCartesian that preserve strict well-behavedness++-- | codiag from Cartesian+--+-- > eitherL = id ||| id+eitherL :: (Monad m, Monad w)=> Lens w m (Either a a) a+eitherL = id ||| id -- (codiag) DEFAULT+++(|||) :: (Monad m, Monad w)=> Lens w m a c -> Lens w m b c -> Lens w m (Either a b) c+Lens f ||| Lens g = Lens $ either (handleL . f) (handleR . g) + where handleL = liftM $ first (liftM Left .)+ handleR = liftM $ first (liftM Right .)++++-- borrowed from Control.Categorical.Distributive :++--RULES+--"factor . distribute" factor . distribute = id+--"distribute . factor" distribute . factor = id++factorL :: (Monad m, Monad w)=>Lens w m (Either (a,b) (a,c)) (a, Either b c)+factorL = Lens $ either (\(a,b)-> return (s ,(a, Left b))) (\(a,c)-> return (s, (a, Right c)))+ where s (a, ebc) = return $ either (Left . (,) a) (Right . (,) a) ebc+--factor = second inl ||| second inr -- DEFAULT+++distributeL :: (Monad m, Monad w)=>Lens w m (a, Either b c) (Either (a,b) (a,c))+distributeL = Lens $ \(a,ebc)-> + return (return . factor, bimap ((,) a) ((,) a) ebc)++++-- | Convert an isomorphism to a 'Lens'+isoL :: (Monad m, Monad w)=> Iso m w a b -> Lens m w a b+isoL (Iso f g) = Lens $ fmap (liftM ((,) g)) f+++-- -------------------+-- Simple API++-- | a simple lens, suitable for single-constructor types+type (:->) = LensM Identity++-- | Create a pure Lens from a getter and setter+--+-- > lens g = lensM (fmap return g) . fmap (fmap return)+lens :: (a -> b) -> (a -> b -> a) -> (a :-> b)+lens g = lensM (fmap return g) . fmap return++-- | Run the getter function of a pure lens+--+-- > get l = runIdentity . getM l+get :: Lens w Identity a b -> a -> b+get l = runIdentity . getM l++-- | Run the getter function of a pure lens+--+-- > set l b = runIdentity . setM l b+set :: (a :-> b) -> b -> a -> a+set l b = runIdentity . setM l b++modify :: (a :-> b) -> (b -> b) -> a -> a+modify l b = runIdentity . modifyM l b++-- | a lens that can fail in the Maybe monad on the outer type. Suitable for a+-- normal lens on a multi-constructor type. The more general 'setM', 'getM', etc.+-- can be used with this type.+type (:~>) = LensM Maybe+++-- TODO: can we convert an Iso to this kind of type?? Is this more appropriate living in Iso??++-- | Set an inner value on an initially 'mempty' value.+--+-- > setZero l b = set l b mzero+setEmpty :: Monoid a => (a :-> b) -> b -> a+setEmpty l b = set l b mempty++-- | > setZeroM l b = setM l b mzero+setEmptyM :: (Monoid a, Monad m) => LensM m a b -> b -> m a+setEmptyM l b = setM l b mempty++-- | > setEmptyW l b = setW l b mempty+setEmptyW :: (Monoid a, Monad w) => Lens w Identity a b -> b -> w a+setEmptyW l b = setW l b mempty++--TODO: more set variations? getEmpty?+++-- OPERATORS: ------------------------++-- | > (^$) = get+(^$) :: Lens w Identity a b -> a -> b +(^$) = get++-- | > ma ^>>= l = ma >>= getM l+(^>>=) :: (Monad m)=> m a -> Lens w m a b -> m b+ma ^>>= l = ma >>= getM l
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Brandon Simmons++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Brandon Simmons nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ yall.cabal view
@@ -0,0 +1,64 @@+Name: yall++Version: 0.1++Synopsis: Lenses with a southern twang++Description: Why yet /another/ lens library? ++ First, none of the existing libraries for Lenses were+ adequate for my needs (specifically for my use of lenses+ in "pez"). And anyway, why not try to create something+ novel and better?+ .+ Distinguishing features:+ .+ - Lenses are parameterized over two Monads (by convention+ @m@ and @w@), and look like @a -> m (b -> w a, b)@. this+ lets us define lenses for sum types, that perform+ validation, that do IO (e.g. persist data to disk),+ etc., etc.+ .+ - a module "Data.Yall.Iso" that complements @Lens@ powerfully+ .+ - a rich set of category-level class instances (for now+ from "categories") for 'Lens' and 'Iso'. These along+ with the pre-defined primitive lenses and combinators+ give an interface comparable to Arrow+ .+ You should import either "Data.Yall" or "Data.Yall.Lens",+ and optionally "Data.Yall.Iso". "Data.Yall" is a simplified,+ but mostly-compatible, version of a subset of "Data.Yall.Lens".+ .+ TODOs:+ .+ - a module providing template haskell deriving of Lenses+++Homepage: http://brandon.si/code/yall/++License: BSD3++License-file: LICENSE++Author: Brandon Simmons++Maintainer: brandon.m.simmons@gmail.com++Category: Data++Build-type: Simple++Cabal-version: >=1.6++source-repository head + type: git+ location: https://github.com/jberryman/yall.git+ branch: master++Library+ Exposed-modules: Data.Yall, Data.Yall.Lens, Data.Yall.Iso+ + Build-depends: categories < 1.0+ , transformers+ , base < 5 && >= 4