uhc-util-0.1.6.6: UHC utilities

Safe HaskellNone
LanguageHaskell98

UHC.Util.Lens

Contents

Description

Minimal redefine + re-export of a lens package, fclabels currently. in addition providing some of the instances for datatypes defined in the remainder of the uhc-util package.

Synopsis

Documentation

type (:->) f o = Lens Total f o

Total monomorphic lens.

type Lens a b = a :-> b Source

Access

(^*) :: (a :-> b) -> (b :-> c) -> a :-> c infixl 9 Source

composition with a flipped reading

(^.) :: a -> (a :-> b) -> b infixl 8 Source

functional getter, which acts like a field accessor

(^=) :: (a :-> b) -> b -> a -> a infixr 4 Source

functional setter, which acts like a field assigner

(^$=) :: (a :-> b) -> (b -> b) -> a -> a infixr 4 Source

functional modify

(=.) :: MonadState f m => Lens (->) f o -> (o -> o) -> m () infixr 2

Alias for modify that reads more or less like an assignment.

(=:) :: MonadState f m => Lens (->) f o -> o -> m () infixr 2

Alias for puts that reads like an assignment.

(=$:) :: MonadState f m => (f :-> o) -> (o -> o) -> m () infixr 4 Source

monadic modify & set

modifyAndGet :: MonadState f m => Lens (->) f o -> (o -> (a, o)) -> m a

Modify a value with a function somewhere in the state, pointed to by the specified lens. Additionally return a separate value based on the modification.

getl :: MonadState f m => (f :-> o) -> m o Source

Alias for gets avoiding conflict with MonadState

Misc

focus :: (MonadState a m, MonadState b m) => (a :-> b) -> m c -> m c Source

Zoom state in on substructure. This regretfully does not really work, because of MonadState fundep.

mkLabel :: Name -> Q [Dec]

Derive labels including type signatures for all the record selectors in a single datatype. The types will be polymorphic and can be used in an arbitrary context.

Tuple accessors

fstl :: ArrowApply arr => Lens arr ((a, b) -> (o, b)) (a -> o) Source

sndl :: ArrowApply arr => Lens arr ((a, b) -> (a, o)) (b -> o) Source

fst3l :: ArrowApply arr => Lens arr ((a, b, c) -> (o, b, c)) (a -> o) Source

snd3l :: ArrowApply arr => Lens arr ((a, b, c) -> (a, o, c)) (b -> o) Source

trd3l :: ArrowApply arr => Lens arr ((a, b, c) -> (a, b, o)) (c -> o) Source

Wrappers

isoMb :: String -> (f :-> Maybe o) -> f :-> o Source

Wrapper around a Maybe with an embedded panic in case of Nothing, with a panic message

isoMbWithDefault :: o -> (f :-> Maybe o) -> f :-> o Source

Wrapper around a Maybe with a default in case of Nothing