diff --git a/data-accessor.cabal b/data-accessor.cabal --- a/data-accessor.cabal +++ b/data-accessor.cabal @@ -1,14 +1,15 @@ Name: data-accessor -Version: 0.1.2 +Version: 0.1.3 License: GPL License-File: LICENSE Author: Henning Thielemann , Luke Palmer Maintainer: Henning Thielemann -Homepage: http://code.haskell.org/data-accessor/ +Homepage: http://www.haskell.org/haskellwiki/Record_access +Package-URL: http://code.haskell.org/data-accessor/ Category: Data -- Portability: Haskell98, not quite because of MTL dependency Build-Type: Simple -Build-Depends: base>=1.0, mtl +Build-Depends: base>=1.0, array, containers, mtl Synopsis: Utilities for accessing and manipulating fields of records Description: In Haskell 98 the name of a record field @@ -56,6 +57,7 @@ Exposed-Modules: Data.Accessor Data.Accessor.Basic + Data.Accessor.Container Data.Accessor.Show Data.Accessor.Tuple Data.Accessor.BinaryRead diff --git a/src/Data/Accessor/Basic.hs b/src/Data/Accessor/Basic.hs --- a/src/Data/Accessor/Basic.hs +++ b/src/Data/Accessor/Basic.hs @@ -4,6 +4,7 @@ -} module Data.Accessor.Basic ( T, fromSetGet, fromLens, + self, null, set, (^=), compose, get, (^.), modify, (^:), @@ -11,6 +12,11 @@ ($%), ) where +import Prelude hiding (null) + + +-- * Define and construct accessors + {- | The access functions we propose, look very similar to those needed for List.mapAccumL (but parameter order is swapped) and State monad. @@ -27,8 +33,22 @@ fromLens lens = Cons $ \ x r -> let (y,f) = lens r in (y, f x) -{- * Access helper functions similar to State methods -} +{- | +Simple accessor: Access the record itself +-} +self :: T r r +self = fromSetGet const id + +{- | +Simple accessor: Access a (non-existing) element of type @()@ +-} +null :: T r () +null = fromSetGet (flip const) (const ()) + + +-- * Apply accessors, similar to State methods + {- | Set the value of a field. -} set :: T r a -> a -> r -> r set f x = snd . decons f x @@ -71,7 +91,7 @@ get :: T r a -> r -> a get f = fst . decons f undefined -infixl 9 ^. +infixl 8 ^. {- | 'get' as infix operator. @@ -106,6 +126,7 @@ ($%) = flip ($) +-- * Accessor combinators infixl 9 .> @@ -120,7 +141,9 @@ (cOld, bNew) = decons g cNew bOld in (cOld, aNew) + infixr 9 <. + {- | Accessor composition the other direction. diff --git a/src/Data/Accessor/Container.hs b/src/Data/Accessor/Container.hs new file mode 100644 --- /dev/null +++ b/src/Data/Accessor/Container.hs @@ -0,0 +1,38 @@ +{- | +This module allows to access elements of arrays and finite maps +like elements of records. +This is especially useful for working with nested structures +consisting of arrays, maps and records. +-} +module Data.Accessor.Container + (array, mapDefault, mapMaybe, ) where + +import qualified Data.Accessor.Basic as Accessor + +import qualified Data.Array as Array +import qualified Data.Map as Map + +import Prelude hiding (map) + + +array :: Array.Ix i => i -> Accessor.T (Array.Array i e) e +array i = Accessor.fromSetGet (\e a -> a Array.// [(i,e)]) (Array.! i) + +{- | +Treats a finite map like an infinite map, +where all undefined elements are replaced by a default value. +-} +mapDefault :: Ord key => elem -> key -> Accessor.T (Map.Map key elem) elem +mapDefault deflt key = + Accessor.fromSetGet (Map.insert key) (Map.findWithDefault deflt key) + +{- | +Treats a finite map like an infinite map, +where all undefined elements are 'Nothing' +and defined elements are 'Just'. +-} +mapMaybe :: Ord key => key -> Accessor.T (Map.Map key elem) (Maybe elem) +mapMaybe key = + Accessor.fromSetGet + (\e m -> maybe (Map.delete key m) (flip (Map.insert key) m) e) + (Map.lookup key) diff --git a/src/Data/Accessor/Example.hs b/src/Data/Accessor/Example.hs --- a/src/Data/Accessor/Example.hs +++ b/src/Data/Accessor/Example.hs @@ -3,14 +3,18 @@ import Data.Accessor.Basic ((.>), ($%), (^.), (^:), (^=), ) import Data.Accessor.Tuple (first, second, ) -import qualified Data.Accessor.Basic as Accessor +import qualified Data.Accessor.Container as Container import qualified Data.Accessor.BinaryRead as Read import qualified Data.Accessor.Show as Show +import qualified Data.Accessor.Basic as Accessor +import qualified Data.Array as Array +import qualified Data.Map as Map + import Data.Accessor.MonadState ((%=), (%:), ) import qualified Data.Accessor.MonadState as AState import Control.Monad.State (State) -import Data.Char (ord, ) +import Data.Char (ord, toUpper, ) import Prelude hiding (init) @@ -96,3 +100,35 @@ show1 :: String show1 = showsPair 5 ('d',8) "" + + +self :: Char +self = Accessor.self ^: succ $ 'a' + +null :: Char +null = Accessor.null ^= () $ 'a' + + +array :: Array.Array Int Char +array = + Container.array 7 ^: toUpper $ + Container.array 2 ^= 'z' $ + Array.listArray (0,9) ['a'..] + +mapDefault :: Map.Map Int Char +mapDefault = + Container.mapDefault ' ' 1 ^= '-' $ + Container.mapDefault ' ' 3 ^= 'z' $ + Container.mapDefault ' ' 5 ^: toUpper $ + Container.mapDefault ' ' 9 ^: toUpper $ + Map.fromList $ zip (map (^(2::Int)) [0..7]) ['a'..] + +mapMaybe :: Map.Map Int Char +mapMaybe = + Container.mapMaybe 1 ^= Just '-' $ + Container.mapMaybe 2 ^= Nothing $ + Container.mapMaybe 3 ^= Just 'z' $ + Container.mapMaybe 4 ^= Nothing $ + Container.mapMaybe 5 ^: fmap toUpper $ + Container.mapMaybe 9 ^: fmap toUpper $ + Map.fromList $ zip (map (^(2::Int)) [0..7]) ['a'..] diff --git a/src/Data/Accessor/MonadState.hs b/src/Data/Accessor/MonadState.hs --- a/src/Data/Accessor/MonadState.hs +++ b/src/Data/Accessor/MonadState.hs @@ -14,6 +14,24 @@ modify :: MonadState r m => Accessor.T r a -> (a -> a) -> m () modify f g = State.modify (Accessor.modify f g) +{- | +Modify a record element and return its old value. +-} +getAndModify :: MonadState r m => Accessor.T r a -> (a -> a) -> m a +getAndModify f g = + do x <- get f + modify f g + return x + +{- | +Modify a record element and return its new value. +-} +modifyAndGet :: MonadState r m => Accessor.T r a -> (a -> a) -> m a +modifyAndGet f g = + do modify f g + get f + + infix 1 %=, %: