data-accessor 0.2.1.2 → 0.2.3.1
raw patch · 12 files changed
Files
- data-accessor.cabal +40/−15
- src-3/Data/Accessor/Private.hs +15/−11
- src-4/Data/Accessor/Private.hs +15/−10
- src-fail/before-4.13/Data/Accessor/ByteSource.hs +35/−0
- src-fail/from-4.13/Data/Accessor/ByteSource.hs +34/−0
- src/Data/Accessor.hs +4/−3
- src/Data/Accessor/Basic.hs +42/−12
- src/Data/Accessor/BinaryRead.hs +13/−29
- src/Data/Accessor/Container.hs +16/−3
- src/Data/Accessor/Example.hs +26/−1
- src/Data/Accessor/MonadState.hs +2/−68
- src/Data/Accessor/MonadStatePrivate.hs +69/−0
data-accessor.cabal view
@@ -1,12 +1,16 @@ Name: data-accessor-Version: 0.2.1.2+Version: 0.2.3.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>, Luke Palmer <lrpalmer@gmail.com> Maintainer: Henning Thielemann <haskell@henning-thielemann.de> Homepage: http://www.haskell.org/haskellwiki/Record_access-Package-URL: http://code.haskell.org/data-accessor/ Category: Data+Cabal-Version: >=1.10+Build-Type: Simple+Tested-With: GHC==6.4.1, GHC==6.8.2, GHC==6.10.4, GHC==6.12.3+Tested-With: GHC==7.0.1, GHC==7.2.1, GHC==7.4.1, GHC==7.6.3+Tested-With: JHC==0.7.3 Synopsis: Utilities for accessing and manipulating fields of records Description: In Haskell 98 the name of a record field@@ -24,8 +28,8 @@ However for setting or modifying a field value we need to use some syntactic sugar, which is often clumsy. .- modifyFirst :: (a -> a) -> (Pair a b -> Pair a b)- modifyFirst f r\@(Pair {first=a}) = r{first = f a}+ > modifyFirst :: (a -> a) -> (Pair a b -> Pair a b)+ > modifyFirst f r@(Pair{first=a}) = r{first = f a} . With this package you can define record field accessors which allow setting, getting and modifying values easily.@@ -48,6 +52,9 @@ rather than plain @get@ functions. For now, the package @data-accessor-template@ provides Template Haskell functions for automated generation of 'Data.Acesssor.Accessor's.+ See also the other @data-accessor@ packages+ that provide an Accessor interface to other data types.+ The package @enumset@ provides accessors to bit-packed records. . For similar packages see @lenses@ and @fclabel@. A related concept are editors@@ -58,20 +65,30 @@ whereas an accessor can only change a single function value, say, it can change @f 0 = 1@ to @f 0 = 2@. This way, editors can even change the type of a record or a function.- An Arrow instance can be define for editors,+ An Arrow instance can be defined for editors, but for accessors only a Category instance is possible ('(.)' method). The reason is the @arr@ method of the @Arrow@ class, that conflicts with the two-way nature (set and get) of accessors.--- Portability: Haskell98-Cabal-Version: >=1.2-Tested-With: GHC==6.10.4-Build-Type: Simple Extra-Source-Files: RegExp src-3/Data/Accessor/Private.hs src-4/Data/Accessor/Private.hs+ src-fail/before-4.13/Data/Accessor/ByteSource.hs+ src-fail/from-4.13/Data/Accessor/ByteSource.hs +Source-Repository this+ Tag: 0.2.3.1+ Type: darcs+ Location: http://code.haskell.org/data-accessor/core/++Source-Repository head+ Type: darcs+ Location: http://code.haskell.org/data-accessor/core/++Flag monadFail+ description: Check whether Monad class is split into Monad and MonadFail.+ Flag category description: Check whether Arrow class is split into Arrow and Category. @@ -80,25 +97,31 @@ Library Build-Depends:- transformers >=0.0.1 && <0.2+ transformers >=0.2 && <0.7 If flag(splitBase) Build-Depends:- array >=0.1 && <0.4,- containers >=0.1 && <0.4+ array >=0.1 && <0.6,+ containers >=0.1 && <0.7 If flag(category) Hs-Source-Dirs: src-4- Build-Depends: base >= 4 && <6+ If flag(monadFail)+ Hs-Source-Dirs: src-fail/from-4.13+ Build-Depends: base >=4.13 && <5+ Else+ Hs-Source-Dirs: src-fail/before-4.13+ Build-Depends: base >=4 && <4.13 Else Hs-Source-Dirs: src-3- Build-Depends: base >= 2 && <4+ Build-Depends: base >=2 && <4 Else Hs-Source-Dirs: src-3 Build-Depends: base >= 1 && <2 If impl(jhc) Build-Depends:- containers >=0.1 && <0.4+ containers >=0.1 && <0.7 + Default-Language: Haskell98 GHC-Options: -Wall Hs-Source-Dirs: src Exposed-Modules:@@ -110,5 +133,7 @@ Data.Accessor.BinaryRead Data.Accessor.MonadState Other-Modules:+ Data.Accessor.ByteSource Data.Accessor.Example Data.Accessor.Private+ Data.Accessor.MonadStatePrivate
src-3/Data/Accessor/Private.hs view
@@ -1,19 +1,23 @@ module Data.Accessor.Private where {- |-The access functions we propose, look very similar to those-needed for List.mapAccumL (but parameter order is swapped) and State monad.-They get the new value of the field and the record-and return the old value of the field and the record with the updated field.+The accessor function we use,+has a record value as first argument+and returns the content of a specific record field+and a function that allows to overwrite that field with a new value.++In former version of a package+we used a function that resembled the state monad.+However this required to use an 'undefined'+in the implementation of the @get@ function. -}-newtype T r a = Cons {decons :: a -> r -> (a, r)}+newtype T r a = Cons {decons :: r -> (a, a -> r)} compose :: T a b -> T b c -> T a c-compose f g = Cons $ \ cNew aOld ->- let (bOld, aNew) = decons f bNew aOld- (cOld, bNew) = decons g cNew bOld- in (cOld, aNew)+compose f g = Cons $ \ aOld ->+ let (bOld, aSetB) = decons f aOld+ (cOld, bSetC) = decons g bOld+ in (cOld, aSetB . bSetC) self :: T r r-self = Cons $ \ai ri -> (ri, ai)-+self = Cons $ \r -> (r, id)
src-4/Data/Accessor/Private.hs view
@@ -4,21 +4,26 @@ {- |-The access functions we propose, look very similar to those-needed for List.mapAccumL (but parameter order is swapped) and State monad.-They get the new value of the field and the record-and return the old value of the field and the record with the updated field.+The accessor function we use,+has a record value as first argument+and returns the content of a specific record field+and a function that allows to overwrite that field with a new value.++In former version of a package+we used a function that resembled the state monad.+However this required to use an 'undefined'+in the implementation of the @get@ function. -}-newtype T r a = Cons {decons :: a -> r -> (a, r)}+newtype T r a = Cons {decons :: r -> (a, a -> r)} compose :: T a b -> T b c -> T a c-compose f g = Cons $ \ cNew aOld ->- let (bOld, aNew) = decons f bNew aOld- (cOld, bNew) = decons g cNew bOld- in (cOld, aNew)+compose f g = Cons $ \ aOld ->+ let (bOld, aSetB) = decons f aOld+ (cOld, bSetC) = decons g bOld+ in (cOld, aSetB . bSetC) self :: T r r-self = Cons $ \ai ri -> (ri, ai)+self = Cons $ \r -> (r, id) instance C.Category T where
+ src-fail/before-4.13/Data/Accessor/ByteSource.hs view
@@ -0,0 +1,35 @@+module Data.Accessor.ByteSource where++import qualified Control.Monad.Trans.State as State+import Control.Monad.Trans.State (StateT, )+import Control.Monad.Trans.Class (lift, )++import Data.Word (Word8, )+++class ByteCompatible byte where+ toByte :: byte -> Word8++instance ByteCompatible Word8 where+ toByte = id+++class ByteStream s where+ getWord8 :: Monad m => s -> m (Word8, s)++instance ByteCompatible byte => ByteStream [byte] where+ getWord8 xs =+ case xs of+ (c:cs) -> return (toByte c, cs)+ _ -> fail "ByteStream: no more byte available"+++class Monad source => ByteSource source where+ readWord8 :: source Word8++instance (ByteStream s, Monad m) => ByteSource (StateT s m) where+ readWord8 =+ do xs <- State.get+ (c,cs) <- lift (getWord8 xs)+ State.put cs+ return c
+ src-fail/from-4.13/Data/Accessor/ByteSource.hs view
@@ -0,0 +1,34 @@+module Data.Accessor.ByteSource where++import qualified Control.Monad.Trans.State as State+import Control.Monad.Trans.State (StateT, )+import Control.Monad.Trans.Class (lift, )+import Data.Word (Word8, )+++class ByteCompatible byte where+ toByte :: byte -> Word8++instance ByteCompatible Word8 where+ toByte = id+++class ByteStream s where+ getWord8 :: MonadFail m => s -> m (Word8, s)++instance ByteCompatible byte => ByteStream [byte] where+ getWord8 xs =+ case xs of+ (c:cs) -> return (toByte c, cs)+ _ -> fail "ByteStream: no more byte available"+++class Monad source => ByteSource source where+ readWord8 :: source Word8++instance (ByteStream s, MonadFail m) => ByteSource (StateT s m) where+ readWord8 =+ do xs <- State.get+ (c,cs) <- lift (getWord8 xs)+ State.put cs+ return c
src/Data/Accessor.hs view
@@ -1,7 +1,6 @@ {- | This module provides a simple abstract data type for-a piece of a data stucture that can be read from and-written to.+a piece of a data stucture that can be read from and written to. In contrast to "Data.Accessor.Basic" it is intended for unqualified import. -} module Data.Accessor@@ -13,7 +12,7 @@ where import qualified Data.Accessor.Basic as Accessor-import qualified Data.Accessor.MonadState as State+import qualified Data.Accessor.MonadStatePrivate as State import Control.Monad.Trans.State (StateT, ) -- |An @Accessor r a@ is an object that encodes how to@@ -68,6 +67,8 @@ Accessor composition the other direction. > (<.) = flip (.>)++You may also use the @(.)@ operator from Category class. -} (<.) :: Accessor b c -> Accessor a b -> Accessor a c (<.) = (Accessor.<.)
src/Data/Accessor/Basic.hs view
@@ -10,6 +10,7 @@ modify, (^:), (.>), (<.), ($%),+ merge, ) where import qualified Data.Accessor.Private as A@@ -21,11 +22,10 @@ fromSetGet :: (a -> r -> r) -> (r -> a) -> T r a fromSetGet setF getF =- Cons $ \x r -> (getF r, setF x r)+ Cons $ \r -> (getF r, flip setF r) fromLens :: (r -> (a, a -> r)) -> T r a-fromLens lens =- Cons $ \ x r -> let (y,f) = lens r in (y, f x)+fromLens = Cons {- | If an object is wrapped in a @newtype@,@@ -43,12 +43,15 @@ > > access :: Accessor.T A Int > access = fromWrapper A unA++We could also have called this function @fromBijection@,+since it must hold @wrap . unwrap = id@ and @unwrap . wrap = id@. -} fromWrapper :: (b -> a) -> (a -> b) -> T a b fromWrapper wrap unwrap = fromSetGet (const . wrap) unwrap -{-+{- test whether the example can be compiled newtype A = A {unA :: Int} access :: T A Int@@ -73,28 +76,29 @@ {- | @result a@ accesses the value of a function for argument @a@.+It is not very efficient to build a function+from setting all of its values using this accessor,+since every access to a function adds another @if-then-else@. Also see semantic editor combinators, that allow to modify all function values of a function at once. Cf. <http://conal.net/blog/posts/semantic-editor-combinators/> -}-result :: Eq a => a -> T (a -> r) r+result :: Eq a => a -> T (a -> b) b result ai =- fromSetGet (\r f a -> if a==ai then r else f a) ($ai)+ fromSetGet (\r f a -> if a==ai then r else f a) ($ ai) -- * 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+set f a r = snd (decons f r) a infixr 5 ^=, ^: -infixl 0 $% - {- | 'set' as infix operator. This lets us write @first ^= 2+3 $ second ^= 5+7 $ record@.@@ -125,7 +129,7 @@ {- | Get the value of a field. -} get :: T r a -> r -> a-get f = fst . decons f undefined+get f = fst . decons f infixl 8 ^. @@ -141,8 +145,8 @@ {- | Transform the value of a field by a function. -} modify :: T r a -> (a -> a) -> (r -> r) modify f g rOld =- let (a,rNew) = decons f (g a) rOld- in rNew+ let (a,rSetA) = decons f rOld+ in rSetA (g a) {- |@@ -155,9 +159,13 @@ (^:) :: T r a -> (a -> a) -> (r -> r) (^:) = modify ++infixl 0 $%+ {- | Flipped version of '($)'. -}+-- ToDo: could be re-exported from utility-ht ($%) :: a -> (a -> b) -> b ($%) = flip ($) @@ -185,6 +193,28 @@ Accessor composition the other direction. > (<.) = flip (.>)++You may also use the @(.)@ operator from Category class. -} (<.) :: T b c -> T a b -> T a c (<.) = flip A.compose+++{- |+Merge the accessors to two independent fields.++Independency means, it must hold:++> set (merge accA accB) (a,b) = set (merge accB accA) (b,a)++You may construct smart accessors+by composing a merged accessor with a @fromWrapper@ accessor.++This is a special case of the more general @Point@ concept+in the package @fclabels@.+-}+merge :: T a b -> T a c -> T a (b,c)+merge accB accC =+ fromSetGet+ (\(b,c) -> set accB b . set accC c)+ (\a -> (get accB a, get accC a))
src/Data/Accessor/BinaryRead.hs view
@@ -4,13 +4,22 @@ This is still only for demonstration and might be of not much use and you should not rely on the interface. -}-module Data.Accessor.BinaryRead where+module Data.Accessor.BinaryRead (+ Stream,+ C(any),+ ByteSource(readWord8),+ ByteStream(getWord8),+ ByteCompatible(toByte),+ Parser(Parser, runParser),+ field,+ record,+ ) where import qualified Data.Accessor.Basic as Accessor+import Data.Accessor.ByteSource+ (ByteSource(..), ByteStream(..), ByteCompatible(..)) import qualified Control.Monad.Trans.State as State-import Control.Monad.Trans.State (StateT, )-import Control.Monad.Trans (lift, ) import Control.Monad (liftM, ) import Data.Word (Word8, ) import Data.Char (chr, )@@ -23,31 +32,6 @@ class C a where any :: ByteSource source => source a -class Monad source => ByteSource source where- readWord8 :: source Word8--class ByteStream s where- getWord8 :: Monad m => s -> m (Word8, s)--instance ByteCompatible byte => ByteStream [byte] where- getWord8 xs =- case xs of- (c:cs) -> return (toByte c, cs)- _ -> fail "ByteStream: no more byte available"--class ByteCompatible byte where- toByte :: byte -> Word8--instance ByteCompatible Word8 where- toByte = id--instance (ByteStream s, Monad m) => ByteSource (StateT s m) where- readWord8 =- do xs <- State.get- (c,cs) <- lift (getWord8 xs)- State.put cs- return c- instance C Word8 where any = readWord8 @@ -80,4 +64,4 @@ record ps = Parser $ flip (foldl (>>=)) (map runParser ps) . Just --- TOOD: writer+-- TODO: writer
src/Data/Accessor/Container.hs view
@@ -1,11 +1,14 @@ {- |-This module allows to access elements of arrays and finite maps+This module allows to access elements of arrays, sets and finite maps like elements of records. This is especially useful for working with nested structures-consisting of arrays, maps and records.+consisting of arrays, sets, maps and records.++Maybe we should move it to a separate package,+then we would not need to import @array@ and @containers@ package. -} module Data.Accessor.Container- (array,+ (array, set, mapDefault, mapMaybe, intMapDefault, intMapMaybe, ) where@@ -14,6 +17,7 @@ import Data.Ix (Ix, ) import qualified Data.Array as Array+import qualified Data.Set as Set import qualified Data.Map as Map import qualified Data.IntMap as IntMap @@ -22,6 +26,15 @@ array :: Ix i => i -> Accessor.T (Array.Array i e) e array i = Accessor.fromSetGet (\e a -> a Array.// [(i,e)]) (Array.! i)++{- |+Treat a Set like a boolean array.+-}+set :: Ord a => a -> Accessor.T (Set.Set a) Bool+set a =+ Accessor.fromSetGet+ (\b -> if b then Set.insert a else Set.delete a)+ (Set.member a) {- | Treats a finite map like an infinite map,
src/Data/Accessor/Example.hs view
@@ -1,7 +1,7 @@ module Data.Accessor.Example where import Data.Accessor.Basic ((.>), ($%), (^.), (^:), (^=), )-import Data.Accessor.Tuple (first, second, )+import Data.Accessor.Tuple (first, second, first3, second3, ) import qualified Data.Accessor.Container as Container import qualified Data.Accessor.BinaryRead as Read@@ -9,6 +9,7 @@ import qualified Data.Accessor.Basic as Accessor import qualified Data.Array as Array+import qualified Data.Set as Set import qualified Data.Map as Map import Data.Char (ord, toUpper, )@@ -106,11 +107,35 @@ let f = (Accessor.result 0 ^: Accessor.result 0 ^= 1) div in map (uncurry f) [(4,2), (2,1), (0,0)] ++merge :: (Int, Char, Ordering)+merge =+ Accessor.merge first3 second3 ^= (42, 'c') $+ (23, 'a', GT)++accessHourMinute :: Accessor.T (Int, Int, Int) Int+accessHourMinute =+ Accessor.merge first3 second3 .>+ Accessor.fromWrapper (\h -> divMod h 60) (\(h,m) -> h*60+m)++mergeHourMinute :: (Int, Int, Int)+mergeHourMinute =+ accessHourMinute ^: (15+) $+ (12, 58, 13)++ array :: Array.Array Int Char array = Container.array 7 ^: toUpper $ Container.array 2 ^= 'z' $ Array.listArray (0,9) ['a'..]++set :: Set.Set Char+set =+ Container.set 'a' ^= False $+ Container.set 'd' ^: not $+ Container.set 'b' ^= True $+ Set.fromList ['a','c'] mapDefault :: Map.Map Int Char mapDefault =
src/Data/Accessor/MonadState.hs view
@@ -1,73 +1,7 @@ {- | Access helper functions in a State monad -} module Data.Accessor.MonadState {-# DEPRECATED "please use Data.Accessor.Monad.Trans.State from data-accessor-transformers" #-}+ (module Data.Accessor.MonadStatePrivate) where -import qualified Data.Accessor.Basic as Accessor-import qualified Control.Monad.Trans.State as State-import qualified Control.Monad.Trans as Trans-import Control.Monad.Trans.State (State, runState, StateT(runStateT), )-import Control.Monad.Trans (MonadTrans)---- * accessors in the form of actions in the state monad--set :: Monad m => Accessor.T r a -> a -> StateT r m ()-set f x = State.modify (Accessor.set f x)--get :: Monad m => Accessor.T r a -> StateT r m a-get f = State.gets (Accessor.get f)--modify :: Monad m => Accessor.T r a -> (a -> a) -> StateT r m ()-modify f g = State.modify (Accessor.modify f g)--{- |-Modify a record element and return its old value.--}-getAndModify :: Monad m => Accessor.T r a -> (a -> a) -> StateT r m a-getAndModify f g =- do x <- get f- modify f g- return x--{- |-Modify a record element and return its new value.--}-modifyAndGet :: Monad m => Accessor.T r a -> (a -> a) -> StateT r m a-modifyAndGet f g =- do modify f g- get f----infix 1 %=, %:--{- |-Infix variant of 'set'.--}-(%=) :: Monad m => Accessor.T r a -> a -> StateT r m ()-(%=) = set--{- |-Infix variant of 'modify'.--}-(%:) :: Monad m => Accessor.T r a -> (a -> a) -> StateT r m ()-(%:) = modify------ * lift a state monadic accessor to an accessor of a parent record--lift :: Monad m => Accessor.T r s -> State s a -> StateT r m a-lift f m =- do s0 <- get f- let (a,s1) = runState m s0- set f s1- return a--liftT :: (Monad m) =>- Accessor.T r s -> StateT s m a -> StateT r m a-liftT f m =- do s0 <- get f- (a,s1) <- Trans.lift $ runStateT m s0- set f s1- return a+import Data.Accessor.MonadStatePrivate
+ src/Data/Accessor/MonadStatePrivate.hs view
@@ -0,0 +1,69 @@+module Data.Accessor.MonadStatePrivate where++import qualified Data.Accessor.Basic as Accessor+import qualified Control.Monad.Trans.State as State+import qualified Control.Monad.Trans.Class as Trans+import Control.Monad.Trans.State (State, runState, StateT(runStateT), )++-- * accessors in the form of actions in the state monad++set :: Monad m => Accessor.T r a -> a -> StateT r m ()+set f x = State.modify (Accessor.set f x)++get :: Monad m => Accessor.T r a -> StateT r m a+get f = State.gets (Accessor.get f)++modify :: Monad m => Accessor.T r a -> (a -> a) -> StateT r m ()+modify f g = State.modify (Accessor.modify f g)++{- |+Modify a record element and return its old value.+-}+getAndModify :: Monad m => Accessor.T r a -> (a -> a) -> StateT r m a+getAndModify f g =+ do x <- get f+ modify f g+ return x++{- |+Modify a record element and return its new value.+-}+modifyAndGet :: Monad m => Accessor.T r a -> (a -> a) -> StateT r m a+modifyAndGet f g =+ do modify f g+ get f++++infix 1 %=, %:++{- |+Infix variant of 'set'.+-}+(%=) :: Monad m => Accessor.T r a -> a -> StateT r m ()+(%=) = set++{- |+Infix variant of 'modify'.+-}+(%:) :: Monad m => Accessor.T r a -> (a -> a) -> StateT r m ()+(%:) = modify++++-- * lift a state monadic accessor to an accessor of a parent record++lift :: Monad m => Accessor.T r s -> State s a -> StateT r m a+lift f m =+ do s0 <- get f+ let (a,s1) = runState m s0+ set f s1+ return a++liftT :: (Monad m) =>+ Accessor.T r s -> StateT s m a -> StateT r m a+liftT f m =+ do s0 <- get f+ (a,s1) <- Trans.lift $ runStateT m s0+ set f s1+ return a