data-accessor-0.2.3/0000755000000000000000000000000013471474745012433 5ustar0000000000000000data-accessor-0.2.3/data-accessor.cabal0000644000000000000000000001137413471474745016136 0ustar0000000000000000Name: data-accessor Version: 0.2.3 License: BSD3 License-File: LICENSE Author: Henning Thielemann , Luke Palmer Maintainer: Henning Thielemann Homepage: http://www.haskell.org/haskellwiki/Record_access Category: Data -- Default-Language: Haskell98 Cabal-Version: >=1.6 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 is automatically also the name of a function which gets the value of the according field. E.g. if we have . data Pair a b = Pair {first :: a, second :: b} . then . > first :: Pair a b -> a > second :: Pair a b -> b . 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} . With this package you can define record field accessors which allow setting, getting and modifying values easily. The package clearly demonstrates the power of the functional approach: You can combine accessors of a record and sub-records, to make the access look like the fields of the sub-record belong to the main record. . Example: . > *Data.Accessor.Example> (first^:second^=10) (('b',7),"hallo") > (('b',10),"hallo") . You can easily manipulate record fields in a 'Control.Monad.State.State' monad, you can easily code 'Show' instances that use the Accessor syntax and you can parse binary streams into records. See @Data.Accessor.Example@ for demonstration of all features. . It would be great if in revised Haskell versions the names of record fields are automatically 'Data.Accessor.Accessor's 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 . Editors only consist of a modify method (and @modify@ applied to a 'const' function is a @set@ function). This way, they can modify all function values of a function at once, 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 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. 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 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. Flag splitBase description: Choose the smaller, split-up base package from version 2 on. Library Build-Depends: transformers >=0.2 && <0.6 If flag(splitBase) Build-Depends: array >=0.1 && <0.6, containers >=0.1 && <0.7 If flag(category) Hs-Source-Dirs: src-4 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 Else Hs-Source-Dirs: src-3 Build-Depends: base >= 1 && <2 If impl(jhc) Build-Depends: containers >=0.1 && <0.7 GHC-Options: -Wall Hs-Source-Dirs: src Exposed-Modules: Data.Accessor Data.Accessor.Basic Data.Accessor.Container Data.Accessor.Show Data.Accessor.Tuple Data.Accessor.BinaryRead Data.Accessor.MonadState Other-Modules: Data.Accessor.ByteSource Data.Accessor.Example Data.Accessor.Private Data.Accessor.MonadStatePrivate data-accessor-0.2.3/Setup.lhs0000644000000000000000000000011513471474745014240 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain data-accessor-0.2.3/LICENSE0000644000000000000000000000261213471474745013441 0ustar0000000000000000Redistribution 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 the ; nor the names of its 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. data-accessor-0.2.3/RegExp0000644000000000000000000000077413471474745013560 0ustar0000000000000000Poor man's Template Haskell - Here are Regular expression for replacement in NEdit: Write data declaration like data T = Cons { fieldA_ :: String, fieldB_ :: Int } Copy the body of the 'data' declaration to where you want to define accessors. Remove comments at the end of each field. Use the first line as the pattern to find and the second line for the pattern to replace by. ^\s*(\w+)_( *):: (.+?),?\n \1 :: Accessor.T T \3\n\1 =\n Accessor.fromSetGet (\\x c -> c{\1_ = x}) \1_\n\n data-accessor-0.2.3/src-3/0000755000000000000000000000000013471474745013362 5ustar0000000000000000data-accessor-0.2.3/src-3/Data/0000755000000000000000000000000013471474745014233 5ustar0000000000000000data-accessor-0.2.3/src-3/Data/Accessor/0000755000000000000000000000000013471474745015775 5ustar0000000000000000data-accessor-0.2.3/src-3/Data/Accessor/Private.hs0000644000000000000000000000123413471474745017743 0ustar0000000000000000module Data.Accessor.Private where {- | 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 :: r -> (a, a -> r)} compose :: T a b -> T b c -> T a c 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 $ \r -> (r, id) data-accessor-0.2.3/src-fail/0000755000000000000000000000000013471474745014133 5ustar0000000000000000data-accessor-0.2.3/src-fail/before-4.13/0000755000000000000000000000000013471474745015760 5ustar0000000000000000data-accessor-0.2.3/src-fail/before-4.13/Data/0000755000000000000000000000000013471474745016631 5ustar0000000000000000data-accessor-0.2.3/src-fail/before-4.13/Data/Accessor/0000755000000000000000000000000013471474745020373 5ustar0000000000000000data-accessor-0.2.3/src-fail/before-4.13/Data/Accessor/ByteSource.hs0000644000000000000000000000150713471474745023016 0ustar0000000000000000module 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 data-accessor-0.2.3/src-fail/from-4.13/0000755000000000000000000000000013471474745015461 5ustar0000000000000000data-accessor-0.2.3/src-fail/from-4.13/Data/0000755000000000000000000000000013471474745016332 5ustar0000000000000000data-accessor-0.2.3/src-fail/from-4.13/Data/Accessor/0000755000000000000000000000000013471474745020074 5ustar0000000000000000data-accessor-0.2.3/src-fail/from-4.13/Data/Accessor/ByteSource.hs0000644000000000000000000000151613471474745022517 0ustar0000000000000000module 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 data-accessor-0.2.3/src/0000755000000000000000000000000013471474745013222 5ustar0000000000000000data-accessor-0.2.3/src/Data/0000755000000000000000000000000013471474745014073 5ustar0000000000000000data-accessor-0.2.3/src/Data/Accessor.hs0000644000000000000000000000572613471474745016203 0ustar0000000000000000{- | This module provides a simple abstract data type for 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 ( Accessor, accessor, setVal, (Accessor.^=), getVal, (Accessor.^.), (Accessor.^:), getA, putA, (=:), (State.%=), modA, (State.%:), (.>), (<.), ) where import qualified Data.Accessor.Basic as Accessor import qualified Data.Accessor.MonadStatePrivate as State import Control.Monad.Trans.State (StateT, ) -- |An @Accessor r a@ is an object that encodes how to -- get and put a subject of type @a@ out of/into an object -- of type @s@. -- -- In order for an instance of this data structure @a@ to be -- an 'Accessor', it must obey the following laws: -- -- > getVal a (setVal a x r) = x -- > setVal a (getVal a r) r = r type Accessor r a = Accessor.T r a -- |Construct an 'Accessor' from a @get@ and a @set@ method. -- accessor :: (r -> a) {- ^ get method -} -> (a -> r -> r) {- ^ set method -} -> Accessor r a accessor = flip Accessor.fromSetGet -- |Get a value from a record field that is specified by an Accessor getVal :: Accessor r a {- ^ record field -} -> r {- ^ record -} -> a {- ^ value of the field in the record -} getVal = Accessor.get -- |Set a value of a record field that is specified by an Accessor setVal :: Accessor r a {- ^ record field @f@ -} -> a {- ^ value @x@ to be set -} -> r {- ^ original record -} -> r {- ^ new record with field @f@ changed to @x@ -} setVal = Accessor.set infixl 9 .> {- | Accessor composition: Combine an accessor with an accessor to a sub-field. Speak \"stack\". -} (.>) :: Accessor a b -> Accessor b c -> Accessor a c (.>) = (Accessor..>) infixr 9 <. {- | 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.<.) infix 1 =: {-# DEPRECATED (=:) "use (Data.Accessor.Monad.Trans.State.%=) from data-accessor-transformers package" #-} {- | An \"assignment operator\" for state monads. > (=:) = putA -} (=:) :: Monad m => Accessor r a -> a -> StateT r m () (=:) = putA {-# DEPRECATED getA "Data.Accessor.Monad.Trans.State.get from data-accessor-transformers package" #-} -- | A structural dereference function for state monads. getA :: Monad m => Accessor r a -> StateT r m a getA = State.get {-# DEPRECATED putA "Data.Accessor.Monad.Trans.State.set from data-accessor-transformers package" #-} -- | A structural assignment function for state monads. putA :: Monad m => Accessor r a -> a -> StateT r m () putA = State.set {-# DEPRECATED modA "Data.Accessor.Monad.Trans.State.modify from data-accessor-transformers package" #-} -- | A structural modification function for state monads. modA :: Monad m => Accessor r a -> (a -> a) -> StateT r m () modA = State.modify data-accessor-0.2.3/src/Data/Accessor/0000755000000000000000000000000013471474745015635 5ustar0000000000000000data-accessor-0.2.3/src/Data/Accessor/Example.hs0000644000000000000000000000677213471474745017600 0ustar0000000000000000module Data.Accessor.Example where import Data.Accessor.Basic ((.>), ($%), (^.), (^:), (^=), ) import Data.Accessor.Tuple (first, second, first3, second3, ) 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.Set as Set import qualified Data.Map as Map import Data.Char (ord, toUpper, ) import Prelude hiding (init) {- * Example accesses -} {- | Example of using 'set', 'get', 'modify'. -} plain :: Int plain = Accessor.get second $ Accessor.modify second succ $ Accessor.set first 'a' $ ('b',7) init :: (Char,Int) init = Accessor.compose [Accessor.set first 'b', Accessor.modify first succ, Accessor.set second 7] (undefined,undefined) -- setMany [first 'b', second 7] (undefined,undefined) initInfix :: (Char,Int) initInfix = (undefined,undefined) $% first ^= 'b' $% first ^: succ $% second ^= 7 read :: Maybe ((Char,Int), Read.Stream) read = Read.runParser (Read.record [Read.field first, Read.field second]) ((undefined,undefined), fromIntegral (ord 'c') : 59 : 154 : 202 : 0 : []) infix0 :: Int infix0 = (('b',7),"hallo")^.first^.second infix1 :: ((Char, Int), String) infix1 = (('b',7),"hallo")$%first^:second^:(1+) infix2 :: ((Char, Int), String) infix2 = (('b',7),"hallo")$%first^:second^=10 infix3 :: Int infix3 = (('b',7),"hallo")^.(first.>second) infix4 :: ((Char, Int), String) infix4 = (('b',7),"hallo")$%(first.>second)^:(1+) showsPair :: Int -> (Char, Int) -> ShowS showsPair = Show.showsPrec [Show.field "first" first, Show.field "second" second] "init" init show0 :: String show0 = showsPair 11 init "" show1 :: String show1 = showsPair 5 ('d',8) "" self :: Char self = Accessor.self ^: succ $ 'a' null :: Char null = Accessor.null ^= () $ 'a' {- | Modify a value of the 'ord' function. -} result :: [Int] result = let f = (Accessor.result 'a' ^= 65) ord in map f "abcABC" {- | Modify a value of a curried function. -} result2 :: [Int] result2 = 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 = 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'..] data-accessor-0.2.3/src/Data/Accessor/Tuple.hs0000644000000000000000000000151013471474745017257 0ustar0000000000000000module Data.Accessor.Tuple where import qualified Data.Accessor.Basic as Accessor {- * Example accessors for the pair type -} {- | Access to the first value of a pair. -} first :: Accessor.T (a,b) a first = Accessor.fromSetGet (\x (_,y) -> (x,y)) fst {- | Access to the second value of a pair. -} second :: Accessor.T (a,b) b second = Accessor.fromSetGet (\y (x,_) -> (x,y)) snd {- | Access to the first value of a triple. -} first3 :: Accessor.T (a,b,c) a first3 = Accessor.fromLens $ \(xOld,y,z) -> (xOld, \xNew -> (xNew,y,z)) {- | Access to the second value of a triple. -} second3 :: Accessor.T (a,b,c) b second3 = Accessor.fromLens $ \(x,yOld,z) -> (yOld, \yNew -> (x,yNew,z)) {- | Access to the third value of a triple. -} third3 :: Accessor.T (a,b,c) c third3 = Accessor.fromLens $ \(x,y,zOld) -> (zOld, \zNew -> (x,y,zNew)) data-accessor-0.2.3/src/Data/Accessor/Basic.hs0000644000000000000000000001124013471474745017210 0ustar0000000000000000{- | This module defines the @Accessor@ type. It should be imported with qualification. -} module Data.Accessor.Basic ( T, fromSetGet, fromLens, fromWrapper, self, null, result, set, (^=), compose, get, (^.), modify, (^:), (.>), (<.), ($%), merge, ) where import qualified Data.Accessor.Private as A import Data.Accessor.Private (T(..), ) import Prelude hiding (null) -- * Define and construct accessors fromSetGet :: (a -> r -> r) -> (r -> a) -> T r a fromSetGet setF getF = Cons $ \r -> (getF r, flip setF r) fromLens :: (r -> (a, a -> r)) -> T r a fromLens = Cons {- | If an object is wrapped in a @newtype@, you can generate an @Accessor@ to the unwrapped data by providing a wrapper and an unwrapper function. The set function is simpler in this case, since no existing data must be kept. Since the information content of the wrapped and unwrapped data is equivalent, you can swap wrapper and unwrapper. This way you can construct an @Accessor@ that treats a record field containing an unwrapped object like a field containing a wrapped object. > newtype A = A {unA :: Int} > > 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 access = fromWrapper A unA -} -- Simple accessors {- | Access the record itself -} self :: T r r self = A.self -- self = fromSetGet const id {- | Access a (non-existing) element of type @()@ -} null :: T r () null = fromSetGet (flip const) (const ()) {- | @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. -} result :: Eq a => a -> T (a -> b) b result 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 a r = snd (decons f r) a infixr 5 ^=, ^: {- | 'set' as infix operator. This lets us write @first ^= 2+3 $ second ^= 5+7 $ record@. -} (^=) :: T r a -> a -> (r -> r) (^=) = set {- {- | Set many fields at once. This function could also be used for initialisation of record, if record value with undefined fields is provided. Drawback: Since all types in a list must have the same type, you can set only values of the same type. -} setMany :: [r -> (a, r)] -> r -> r setMany = flip (foldl (\x f -> snd (f x))) -} {- | This is a general function, but it is especially useful for setting many values of different type at once. -} compose :: [r -> r] -> r -> r compose = flip (foldl (flip id)) {- | Get the value of a field. -} get :: T r a -> r -> a get f = fst . decons f infixl 8 ^. {- | 'get' as infix operator. This lets us write @record^.field^.subfield@. This imitates Modula II syntax. -} (^.) :: r -> T r a -> a (^.) = flip get {- | Transform the value of a field by a function. -} modify :: T r a -> (a -> a) -> (r -> r) modify f g rOld = let (a,rSetA) = decons f rOld in rSetA (g a) {- | 'modify' as infix operator. This lets us write @field^:subfield^:(2*) $ record@, @record$%field^:subfield^:(2*)@ or @record$%field^:subfield^:(const 1)@. -} (^:) :: 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 ($) -- * Accessor combinators infixl 9 .> {- | Accessor composition: Combine an accessor with an accessor to a sub-field. Speak \"stack\". -} (.>) :: T a b -> T b c -> T a c (.>) = A.compose {- This could be used for a Category instance of T. -} infixr 9 <. {- | 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)) data-accessor-0.2.3/src/Data/Accessor/BinaryRead.hs0000644000000000000000000000265513471474745020221 0ustar0000000000000000{- | Reading records from streams 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 ( 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 (liftM, ) import Data.Word (Word8, ) import Data.Char (chr, ) import Prelude hiding (any) type Stream = [Word8] class C a where any :: ByteSource source => source a instance C Word8 where any = readWord8 instance C Char where any = liftM (chr . fromIntegral) readWord8 instance C Int where any = do c0 <- readWord8 c1 <- readWord8 c2 <- readWord8 c3 <- readWord8 return (foldl1 (\acc d -> acc*256+d) (map fromIntegral [c0,c1,c2,c3])) newtype Parser s r = Parser {runParser :: (r, s) -> Maybe (r, s)} field :: (ByteStream s, C a) => Accessor.T r a -> Parser s r field f = Parser $ uncurry (\r -> State.runStateT $ fmap (\x -> Accessor.set f x r) any) record :: [Parser s r] -> Parser s r record ps = Parser $ flip (foldl (>>=)) (map runParser ps) . Just -- TODO: writer data-accessor-0.2.3/src/Data/Accessor/MonadState.hs0000644000000000000000000000042113471474745020225 0ustar0000000000000000{- | 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 Data.Accessor.MonadStatePrivate data-accessor-0.2.3/src/Data/Accessor/Show.hs0000644000000000000000000000213213471474745017107 0ustar0000000000000000{- | Support for creating Show instances using the accessors. -} module Data.Accessor.Show (field, showsPrec) where import qualified Data.Accessor.Basic as Accessor import Data.Maybe (catMaybes) -- import qualified Text.Show as Show import qualified Prelude as Show import Prelude hiding (showsPrec) toMaybe :: Bool -> a -> Maybe a toMaybe False _ = Nothing toMaybe True x = Just x field :: (Show a, Eq a) => String -> Accessor.T r a -> r -> r -> Maybe ShowS field name acc deflt record = let x = Accessor.get acc record in toMaybe (x /= Accessor.get acc deflt) (showString name . showString " ^= " . Show.showsPrec 5 x) showsPrec :: [r -> r -> Maybe ShowS] -> String -> r -> Int -> r -> ShowS showsPrec fields defltName deflt p record = let calls = catMaybes $ map (\f -> f deflt record) $ fields in if null calls then showString defltName else showParen (p>0) (foldr (\acc s -> acc . showString " $ " . s) (showString defltName) calls) data-accessor-0.2.3/src/Data/Accessor/Container.hs0000644000000000000000000000373713471474745020125 0ustar0000000000000000{- | 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, 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, set, mapDefault, mapMaybe, intMapDefault, intMapMaybe, ) where import qualified Data.Accessor.Basic as Accessor 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 import Prelude hiding (map) 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, 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) intMapDefault :: elem -> Int -> Accessor.T (IntMap.IntMap elem) elem intMapDefault deflt key = Accessor.fromSetGet (IntMap.insert key) (IntMap.findWithDefault deflt key) intMapMaybe :: Int -> Accessor.T (IntMap.IntMap elem) (Maybe elem) intMapMaybe key = Accessor.fromSetGet (\e m -> maybe (IntMap.delete key m) (flip (IntMap.insert key) m) e) (IntMap.lookup key) data-accessor-0.2.3/src/Data/Accessor/MonadStatePrivate.hs0000644000000000000000000000314513471474745021566 0ustar0000000000000000module 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 data-accessor-0.2.3/src-4/0000755000000000000000000000000013471474745013363 5ustar0000000000000000data-accessor-0.2.3/src-4/Data/0000755000000000000000000000000013471474745014234 5ustar0000000000000000data-accessor-0.2.3/src-4/Data/Accessor/0000755000000000000000000000000013471474745015776 5ustar0000000000000000data-accessor-0.2.3/src-4/Data/Accessor/Private.hs0000644000000000000000000000140613471474745017745 0ustar0000000000000000module Data.Accessor.Private where import qualified Control.Category as C {- | 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 :: r -> (a, a -> r)} compose :: T a b -> T b c -> T a c 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 $ \r -> (r, id) instance C.Category T where id = self (.) = flip compose