partial-lens (empty) → 0.0.1
raw patch · 5 files changed
+229/−0 lines, 5 filesdep +basedep +comonad-transformersdep +data-lenssetup-changed
Dependencies added: base, comonad-transformers, data-lens, transformers
Files
- Data/Lens/Partial/Common.hs +114/−0
- Data/Lens/Partial/Lazy.hs +66/−0
- LICENSE +20/−0
- Setup.lhs +4/−0
- partial-lens.cabal +25/−0
+ Data/Lens/Partial/Common.hs view
@@ -0,0 +1,114 @@+module Data.Lens.Partial.Common where++import Prelude hiding ((.), id, null)+import Control.Applicative+import Control.Category+import Data.Lens.Common (Lens(..))+import Control.Comonad.Trans.Store+import Data.Functor.Identity+import Data.Functor.Coproduct++newtype PartialLens a b = PLens (a -> Maybe (Store b a))++-- A partial lens is a coalgebra for the Coprodcut Identity (Store b) comonad.+runPLens :: PartialLens a b -> a -> (Coproduct Identity (Store b)) a+runPLens (PLens f) a = maybe (left (Identity a)) right (f a)++instance Category PartialLens where+ id = totalLens id+ PLens f . PLens g = PLens $ \a -> do+ (StoreT wba b) <- g a + (StoreT wcb c) <- f b+ return (StoreT ((.) <$> wba <*> wcb) c)++null :: PartialLens a b+null = PLens (const Nothing)++-- totalLens is a homomorphism of categories; ie a functor.+totalLens :: Lens a b -> PartialLens a b+totalLens (Lens f) = PLens (Just . f)++-- * Functional API++getPL :: PartialLens a b -> a -> Maybe b+getPL (PLens f) a = pos <$> f a++trySetPL :: PartialLens a b -> a -> Maybe (b -> a)+trySetPL (PLens f) a = flip peek <$> f a++-- If the PartialLens is null, then setPL returns the identity function.+setPL :: PartialLens a b -> b -> a -> a+setPL (PLens f) b a = maybe a (peek b) (f a)++-- If the PartialLens is null, then setPL returns the identity function.+modPL :: PartialLens a b -> (b -> b) -> a -> a+modPL (PLens f) g a = maybe a (peeks g) (f a)++-- * Operator API++infixr 0 ^$+(^$) = getPL++infixr 9 ^.+(^.) = flip getPL++infixr 4 ^=+(^=) :: PartialLens a b -> b -> a -> a+(^=) = setPL++infixr 4 ^%=+(^%=) :: PartialLens a b -> (b -> b) -> a -> a+(^%=) = modPL++-- * Pseudo-imperatives++infixr 4 ^+=, ^-=, ^*=+(^+=), (^-=), (^*=) :: Num b => PartialLens a b -> b -> a -> a+l ^+= n = l ^%= (+ n)+l ^-= n = l ^%= subtract n+l ^*= n = l ^%= (* n)++infixr 4 ^/=+(^/=) :: Fractional b => PartialLens a b -> b -> a -> a+l ^/= r = l ^%= (/ r)++-- * Stock partial lenses++maybeLens :: PartialLens (Maybe a) a+maybeLens = PLens $ \ma -> do+ a <- ma+ return (StoreT (pure Just) a) ++leftLens :: PartialLens (Either a b) a+leftLens = PLens $ either (Just . StoreT (pure Left)) (const Nothing)++rightLens :: PartialLens (Either a b) b+rightLens = PLens $ either (const Nothing) (Just . StoreT (pure Right))++headLens :: PartialLens [a] a+headLens = PLens f+ where+ f [] = Nothing+ f (h:t) = Just (StoreT (pure (:t)) h)++tailLens :: PartialLens [a] [a]+tailLens = PLens f+ where+ f [] = Nothing+ f (h:t) = Just (StoreT (pure (h:)) t)++{- Other Examples++nthLens :: Int -> PartialLens [a] a+nthLens n | n < 0 = null+ | n == 0 = headLens+ | otherwise = nthLens (n-1) . tailLens++-- setPL does not insert into a Map! it only modifies a value if the key already exists in the map+mapPLens :: Ord k => k -> PartialLens (Map.Map k v) v+mapPLens k = maybeLens . totalLens (mapLens k)++-- setPL does not insert into a IntMap! it only modifies a value if the key already exists in the map+intMapPLens :: Int -> PartialLens (IntMap v) v+intMapPLens k = maybeLens . totalLens (intMapLens k)+-}
+ Data/Lens/Partial/Lazy.hs view
@@ -0,0 +1,66 @@+module Data.Lens.Partial.Lazy where++import Control.Monad+import Control.Comonad.Trans.Store+import Control.Monad.Trans.State+import Data.Functor.Identity+import Data.Lens.Partial.Common++maybeZero :: MonadPlus m => Maybe a -> m a+maybeZero Nothing = mzero+maybeZero (Just a) = return a++joinMaybe :: MonadPlus m => m (Maybe a) -> m a+joinMaybe = (maybeZero =<<)++-- * State actions++-- | get the value of a partial lens into state+access :: Monad m => PartialLens a b -> StateT a m (Maybe b)+access pl = getPL pl `liftM` get++-- | returns mzero in case of a null reference+accessPlus :: MonadPlus m => PartialLens a b -> StateT a m b+accessPlus = joinMaybe . access++-- | set a value using a partial lens into state+-- returns 'Nothing' in case of a null reference+(~=) :: Monad m => PartialLens a b -> b -> StateT a m (Maybe b)+(PLens f) ~= b = StateT $ \a -> return $ case f a of+ Nothing -> (Nothing, a)+ Just st -> (Just b, peek b st)++-- | infix modification a value through a partial lens into state+-- returns 'Nothing' in case of a null reference+(%=) :: Monad m => PartialLens a b -> (b -> b) -> StateT a m (Maybe b)+(PLens f) %= g = StateT $ \a -> return $ case f a of+ Nothing -> (Nothing, a)+ Just (StoreT (Identity h) b) -> let b' = g b in+ (Just b', h b')++-- | infix modification of a value through a partial lens into state+-- with a supplemental response.+-- returns 'Nothing' in case of a null reference+(%%=) :: Monad m => PartialLens a b -> (b -> (c, b)) -> StateT a m (Maybe c)+PLens f %%= g = StateT $ \a -> return $ case f a of+ Nothing -> (Nothing, a)+ Just (StoreT (Identity h) b) -> let (c,b') = g b in+ (Just c, h b')++infixr 4 +=, -=, *=++(+=), (-=), (*=) :: (Monad m, Num b) => PartialLens a b -> b -> StateT a m (Maybe b)+f += b = f %= (+ b)+f -= b = f %= subtract b+f *= b = f %= (* b)++infixr 4 //=++(//=) :: (Monad m, Fractional b) => PartialLens a b -> b -> StateT a m (Maybe b)+f //= b = f %= (/ b)++infixr 4 &&=, ||=++(&&=), (||=) :: Monad m => PartialLens a Bool -> Bool -> StateT a m (Maybe Bool)+f &&= b = f %= (&& b)+f ||= b = f %= (|| b)
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2011+Russell O'Connor++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ partial-lens.cabal view
@@ -0,0 +1,25 @@+name: partial-lens+category: Control, Comonads+version: 0.0.1+license: MIT+cabal-version: >= 1.6+license-file: LICENSE+author: Russell O'Connor+maintainer: Russell O'Connor <roconnor@theorem.ca>+stability: provisional+synopsis: Haskell 98 Partial Lenses+description: Haskell 98 Partial Lenses+build-type: Simple++library+ build-depends:+ base >= 4 && < 5,+ comonad-transformers >= 2.0 && < 2.1,+ transformers >= 0.2.0 && < 0.3,+ data-lens >= 2.0 && < 2.1++ exposed-modules:+ Data.Lens.Partial.Common+ Data.Lens.Partial.Lazy++ ghc-options: -Wall