Safe Haskell | None |
---|---|
Language | Haskell2010 |
Record types in Haskell can be made lazy through lazy pattern matching. This module offers functions for making them lazy generically.
Synopsis
- class Lazifiable a where
- lazify :: a -> a
- class GLazifiable a f where
- glazify :: f p -> f p
- genericLazify :: forall a. (Generic a, GLazifiable a (Rep a)) => a -> a
- ($~) :: forall rep a (b :: TYPE rep). Lazifiable a => (a -> b) -> a -> b
Documentation
class Lazifiable a where Source #
A class for types that can be lazified. A generic
default is provided for convenience. To lazify a type using
its generic representation, use genericLazify
.
Nothing
Lazily rewrap a record. Applying lazify
to a record and then
pattern matching on it strictly is equivalent to pattern matching
on it lazily.
strictFirst :: (a -> a') -> (a, b) -> (a', b) strictFirst f (a, b) = (f a, b) lazyFirst :: (a -> a') -> (a, b) -> (a', b) lazyFirst f = strictFirst f . lazify -- Equivalently lazyFirst f ~(a, b) = (f a, b)
Instances
class GLazifiable a f where Source #
A Generic
representation that can be lazified.
Instances
GLazifiable (a :: k1) (U1 :: k2 -> Type) Source # | |
(TypeError ((('Text "Can't lazify " :<>: 'ShowType a) :<>: 'Text ":") :$$: 'Text "It is a sum type.") :: Constraint) => GLazifiable (a :: k1) (f :+: g :: k2 -> Type) Source # | |
(GLazifiable a f, GLazifiable a g) => GLazifiable (a :: k1) (f :*: g :: k2 -> Type) Source # | |
GLazifiable (a :: k1) (K1 i c :: k2 -> Type) Source # | |
(TypeError ((('Text "Can't lazify " :<>: 'ShowType a) :<>: 'Text ":") :$$: 'Text "It has a strict (unpacked) field.") :: Constraint) => GLazifiable (a :: k1) (S1 ('MetaSel _p _q _r 'DecidedUnpack) f :: k2 -> Type) Source # | |
Defined in Data.Lazify.Internal glazify :: forall (p :: k). S1 ('MetaSel _p _q _r 'DecidedUnpack) f p -> S1 ('MetaSel _p _q _r 'DecidedUnpack) f p Source # | |
(TypeError ((('Text "Can't lazify " :<>: 'ShowType a) :<>: 'Text ":") :$$: 'Text "It has a strict field.") :: Constraint) => GLazifiable (a :: k1) (S1 ('MetaSel _p _q _r 'DecidedStrict) f :: k2 -> Type) Source # | |
Defined in Data.Lazify.Internal glazify :: forall (p :: k). S1 ('MetaSel _p _q _r 'DecidedStrict) f p -> S1 ('MetaSel _p _q _r 'DecidedStrict) f p Source # | |
GLazifiable a f => GLazifiable (a :: k1) (S1 ('MetaSel _p _q _r 'DecidedLazy) f :: k2 -> Type) Source # | |
Defined in Data.Lazify.Internal glazify :: forall (p :: k). S1 ('MetaSel _p _q _r 'DecidedLazy) f p -> S1 ('MetaSel _p _q _r 'DecidedLazy) f p Source # | |
GLazifiable a f => GLazifiable (a :: k1) (C1 c f :: k2 -> Type) Source # | |
GLazifiable a f => GLazifiable (a :: k1) (D1 ('MetaData x y z 'False) f :: k2 -> Type) Source # | |
Lazifiable c => GLazifiable (a :: k1) (D1 ('MetaData x y z 'True) (C1 _m (S1 _o (Rec0 c))) :: k2 -> Type) Source # | |
genericLazify :: forall a. (Generic a, GLazifiable a (Rep a)) => a -> a Source #
Lazify a record using its generic representation.
Note that newtypes are treated specially: a newtype is lazified
by lazifying its underlying type using its Lazifiable
instance.
($~) :: forall rep a (b :: TYPE rep). Lazifiable a => (a -> b) -> a -> b Source #
Apply a function to a lazified value.
Note to users of TypeApplications
: For GHC >= 9.0.1, the representation
is marked as inferred. Before that, doing so is impossible and the
representation must be passed as the first type argument. I'm sorry.