Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- site :: SiteM () -> IO ()
- siteWithGlobals :: Value -> SiteM () -> IO ()
- resourceLoader :: (String -> IO String) -> [GlobPattern] -> SiteM [Value]
- writeWith :: ToJSON a => (a -> SiteM String) -> [a] -> SiteM ()
- writeTemplate :: ToJSON a => FilePath -> [a] -> SiteM ()
- textWriter :: ToJSON a => [a] -> SiteM ()
- copyFiles :: [GlobPattern] -> SiteM [Value]
- copyFilesWith :: (FilePath -> FilePath) -> [GlobPattern] -> SiteM [Value]
- markdownReader :: String -> IO String
- textReader :: String -> PandocIO String
- mkPandocReader :: (ReaderOptions -> String -> PandocIO Pandoc) -> String -> IO String
- setExt :: String -> FilePath -> FilePath
- addPrefix :: String -> FilePath -> FilePath
- getTags :: (String -> String) -> [Value] -> [Value]
- module SitePipe.Types
- class (Functor t, Foldable t) => Traversable (t :: Type -> Type) where
- traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
- type FilePath = String
- newtype Const a (b :: k) :: forall k. Type -> k -> Type = Const {
- getConst :: a
- newtype Identity a = Identity {
- runIdentity :: a
- class Contravariant (f :: Type -> Type) where
- eitherDecodeFileStrict' :: FromJSON a => FilePath -> IO (Either String a)
- eitherDecodeStrict' :: FromJSON a => ByteString -> Either String a
- eitherDecode' :: FromJSON a => ByteString -> Either String a
- eitherDecodeFileStrict :: FromJSON a => FilePath -> IO (Either String a)
- eitherDecodeStrict :: FromJSON a => ByteString -> Either String a
- eitherDecode :: FromJSON a => ByteString -> Either String a
- decodeFileStrict' :: FromJSON a => FilePath -> IO (Maybe a)
- decodeStrict' :: FromJSON a => ByteString -> Maybe a
- decode' :: FromJSON a => ByteString -> Maybe a
- decodeFileStrict :: FromJSON a => FilePath -> IO (Maybe a)
- decodeStrict :: FromJSON a => ByteString -> Maybe a
- decode :: FromJSON a => ByteString -> Maybe a
- encodeFile :: ToJSON a => FilePath -> a -> IO ()
- encode :: ToJSON a => a -> ByteString
- foldable :: (Foldable t, ToJSON a) => t a -> Encoding
- type GToJSON = GToJSON Value
- type GToEncoding = GToJSON Encoding
- toEncoding2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Encoding
- toJSON2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Value
- toEncoding1 :: (ToJSON1 f, ToJSON a) => f a -> Encoding
- toJSON1 :: (ToJSON1 f, ToJSON a) => f a -> Value
- genericToJSONKey :: (Generic a, GToJSONKey (Rep a)) => JSONKeyOptions -> ToJSONKeyFunction a
- genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f)) => Options -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
- genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a)) => Options -> a -> Encoding
- genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f)) => Options -> (a -> Value) -> ([a] -> Value) -> f a -> Value
- genericToJSON :: (Generic a, GToJSON Value Zero (Rep a)) => Options -> a -> Value
- data ToArgs res arity a where
- class ToJSON a where
- toJSON :: a -> Value
- toEncoding :: a -> Encoding
- toJSONList :: [a] -> Value
- toEncodingList :: [a] -> Encoding
- class KeyValue kv where
- class ToJSONKey a where
- toJSONKey :: ToJSONKeyFunction a
- toJSONKeyList :: ToJSONKeyFunction [a]
- data ToJSONKeyFunction a
- = ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)
- | ToJSONKeyValue !(a -> Value) !(a -> Encoding)
- class GetConName f => GToJSONKey (f :: k -> Type)
- class ToJSON1 (f :: Type -> Type) where
- liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
- liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [f a] -> Value
- liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
- liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
- class ToJSON2 (f :: Type -> Type -> Type) where
- liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> f a b -> Value
- liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [f a b] -> Value
- liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> f a b -> Encoding
- liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [f a b] -> Encoding
- pairs :: Series -> Encoding
- fromEncoding :: Encoding' tag -> Builder
- type Encoding = Encoding' Value
- data Series
- (.!=) :: Parser (Maybe a) -> a -> Parser a
- (.:!) :: FromJSON a => Object -> Text -> Parser (Maybe a)
- (.:?) :: FromJSON a => Object -> Text -> Parser (Maybe a)
- (.:) :: FromJSON a => Object -> Text -> Parser a
- fromJSON :: FromJSON a => Value -> Result a
- withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
- withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
- withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
- withArray :: String -> (Array -> Parser a) -> Value -> Parser a
- withText :: String -> (Text -> Parser a) -> Value -> Parser a
- withObject :: String -> (Object -> Parser a) -> Value -> Parser a
- parseJSON2 :: (FromJSON2 f, FromJSON a, FromJSON b) => Value -> Parser (f a b)
- parseJSON1 :: (FromJSON1 f, FromJSON a) => Value -> Parser (f a)
- genericFromJSONKey :: (Generic a, GFromJSONKey (Rep a)) => JSONKeyOptions -> FromJSONKeyFunction a
- genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f)) => Options -> (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
- genericParseJSON :: (Generic a, GFromJSON Zero (Rep a)) => Options -> Value -> Parser a
- parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
- class GFromJSON arity (f :: Type -> Type) where
- gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (f a)
- data FromArgs arity a where
- class FromJSON a where
- class FromJSONKey a where
- data FromJSONKeyFunction a
- = FromJSONKeyCoerce !(CoerceText a)
- | FromJSONKeyText !(Text -> a)
- | FromJSONKeyTextParser !(Text -> Parser a)
- | FromJSONKeyValue !(Value -> Parser a)
- class (ConstructorNames f, SumFromString f) => GFromJSONKey (f :: Type -> Type)
- class FromJSON1 (f :: Type -> Type) where
- class FromJSON2 (f :: Type -> Type -> Type) where
- json' :: Parser Value
- json :: Parser Value
- camelTo2 :: Char -> String -> String
- defaultJSONKeyOptions :: JSONKeyOptions
- defaultTaggedObject :: SumEncoding
- defaultOptions :: Options
- (<?>) :: Parser a -> JSONPathElement -> Parser a
- object :: [Pair] -> Value
- type JSONPath = [JSONPathElement]
- data Result a
- type Object = HashMap Text Value
- type Array = Vector Value
- data Value
- newtype DotNetTime = DotNetTime {}
- data Options
- data SumEncoding
- data JSONKeyOptions
- data Zero
- data One
- class Bifunctor (p :: Type -> Type -> Type) where
- bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
- data (a :: k) :~: (b :: k) :: forall k. k -> k -> Type where
- (&) :: a -> (a -> b) -> b
- (<&>) :: Functor f => f a -> (a -> b) -> f b
- (</>) :: FilePath -> FilePath -> FilePath
- makeRelative :: FilePath -> FilePath -> FilePath
- dropTrailingPathSeparator :: FilePath -> FilePath
- normalise :: FilePath -> FilePath
- isAbsolute :: FilePath -> Bool
- isRelative :: FilePath -> Bool
- makeValid :: FilePath -> FilePath
- isValid :: FilePath -> Bool
- equalFilePath :: FilePath -> FilePath -> Bool
- joinPath :: [FilePath] -> FilePath
- splitDirectories :: FilePath -> [FilePath]
- splitPath :: FilePath -> [FilePath]
- combine :: FilePath -> FilePath -> FilePath
- replaceDirectory :: FilePath -> String -> FilePath
- takeDirectory :: FilePath -> FilePath
- addTrailingPathSeparator :: FilePath -> FilePath
- hasTrailingPathSeparator :: FilePath -> Bool
- replaceBaseName :: FilePath -> String -> FilePath
- takeBaseName :: FilePath -> String
- takeFileName :: FilePath -> FilePath
- dropFileName :: FilePath -> FilePath
- replaceFileName :: FilePath -> String -> FilePath
- splitFileName :: FilePath -> (String, String)
- isDrive :: FilePath -> Bool
- hasDrive :: FilePath -> Bool
- dropDrive :: FilePath -> FilePath
- takeDrive :: FilePath -> FilePath
- joinDrive :: FilePath -> FilePath -> FilePath
- splitDrive :: FilePath -> (FilePath, FilePath)
- replaceExtensions :: FilePath -> String -> FilePath
- takeExtensions :: FilePath -> String
- dropExtensions :: FilePath -> FilePath
- splitExtensions :: FilePath -> (FilePath, String)
- stripExtension :: String -> FilePath -> Maybe FilePath
- isExtensionOf :: String -> FilePath -> Bool
- hasExtension :: FilePath -> Bool
- addExtension :: FilePath -> String -> FilePath
- dropExtension :: FilePath -> FilePath
- (<.>) :: FilePath -> String -> FilePath
- replaceExtension :: FilePath -> String -> FilePath
- (-<.>) :: FilePath -> String -> FilePath
- takeExtension :: FilePath -> String
- splitExtension :: FilePath -> (String, String)
- getSearchPath :: IO [FilePath]
- splitSearchPath :: String -> [FilePath]
- isExtSeparator :: Char -> Bool
- extSeparator :: Char
- isSearchPathSeparator :: Char -> Bool
- searchPathSeparator :: Char
- isPathSeparator :: Char -> Bool
- pathSeparators :: [Char]
- pathSeparator :: Char
- class Profunctor (p :: Type -> Type -> Type) where
- defaultFieldRules :: LensRules
- makeFieldsNoPrefix :: Name -> DecsQ
- makeFields :: Name -> DecsQ
- abbreviatedNamer :: FieldNamer
- abbreviatedFields :: LensRules
- classUnderscoreNoPrefixNamer :: FieldNamer
- classUnderscoreNoPrefixFields :: LensRules
- camelCaseNamer :: FieldNamer
- camelCaseFields :: LensRules
- underscoreNamer :: FieldNamer
- underscoreFields :: LensRules
- makeWrapped :: Name -> DecsQ
- declareLensesWith :: LensRules -> DecsQ -> DecsQ
- declareFields :: DecsQ -> DecsQ
- declareWrapped :: DecsQ -> DecsQ
- declarePrisms :: DecsQ -> DecsQ
- declareClassyFor :: [(String, (String, String))] -> [(String, String)] -> DecsQ -> DecsQ
- declareClassy :: DecsQ -> DecsQ
- declareLensesFor :: [(String, String)] -> DecsQ -> DecsQ
- declareLenses :: DecsQ -> DecsQ
- makeLensesWith :: LensRules -> Name -> DecsQ
- makeClassyFor :: String -> String -> [(String, String)] -> Name -> DecsQ
- makeLensesFor :: [(String, String)] -> Name -> DecsQ
- makeClassy_ :: Name -> DecsQ
- makeClassy :: Name -> DecsQ
- makeLenses :: Name -> DecsQ
- classyRules_ :: LensRules
- classyRules :: LensRules
- mappingNamer :: (String -> [String]) -> FieldNamer
- lookingupNamer :: [(String, String)] -> FieldNamer
- lensRulesFor :: [(String, String)] -> LensRules
- underscoreNoPrefixNamer :: FieldNamer
- lensRules :: LensRules
- lensClass :: Lens' LensRules ClassyNamer
- lensField :: Lens' LensRules FieldNamer
- createClass :: Lens' LensRules Bool
- generateLazyPatterns :: Lens' LensRules Bool
- generateUpdateableOptics :: Lens' LensRules Bool
- generateSignatures :: Lens' LensRules Bool
- simpleLenses :: Lens' LensRules Bool
- data LensRules
- type FieldNamer = Name -> [Name] -> Name -> [DefName]
- data DefName
- type ClassyNamer = Name -> Maybe (Name, Name)
- makeClassyPrisms :: Name -> DecsQ
- makePrisms :: Name -> DecsQ
- iat :: At m => Index m -> IndexedLens' (Index m) m (Maybe (IxValue m))
- sans :: At m => Index m -> m -> m
- ixAt :: At m => Index m -> Traversal' m (IxValue m)
- iix :: Ixed m => Index m -> IndexedTraversal' (Index m) m (IxValue m)
- icontains :: Contains m => Index m -> IndexedLens' (Index m) m Bool
- type family Index s :: Type
- class Contains m where
- type family IxValue m :: Type
- class Ixed m where
- ix :: Index m -> Traversal' m (IxValue m)
- class Ixed m => At m where
- class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where
- gplate1 :: (Generic1 f, GPlated1 f (Rep1 f)) => Traversal' (f a) (f a)
- gplate :: (Generic a, GPlated a (Rep a)) => Traversal' a a
- parts :: Plated a => Lens' a [a]
- composOpFold :: Plated a => b -> (b -> b -> b) -> (a -> b) -> a -> b
- para :: Plated a => (a -> [r] -> r) -> a -> r
- paraOf :: Getting (Endo [a]) a a -> (a -> [r] -> r) -> a -> r
- holesOnOf :: Conjoined p => LensLike (Bazaar p r r) s t a b -> Over p (Bazaar p r r) a b r r -> s -> [Pretext p r r t]
- holesOn :: Conjoined p => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t]
- holes :: Plated a => a -> [Pretext ((->) :: Type -> Type -> Type) a a a]
- contextsOnOf :: ATraversal s t a a -> ATraversal' a a -> s -> [Context a a t]
- contextsOn :: Plated a => ATraversal s t a a -> s -> [Context a a t]
- contextsOf :: ATraversal' a a -> a -> [Context a a a]
- contexts :: Plated a => a -> [Context a a a]
- transformMOnOf :: Monad m => LensLike (WrappedMonad m) s t a b -> LensLike (WrappedMonad m) a b a b -> (b -> m b) -> s -> m t
- transformMOf :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
- transformMOn :: (Monad m, Plated a) => LensLike (WrappedMonad m) s t a a -> (a -> m a) -> s -> m t
- transformM :: (Monad m, Plated a) => (a -> m a) -> a -> m a
- transformOnOf :: ASetter s t a b -> ASetter a b a b -> (b -> b) -> s -> t
- transformOf :: ASetter a b a b -> (b -> b) -> a -> b
- transformOn :: Plated a => ASetter s t a a -> (a -> a) -> s -> t
- transform :: Plated a => (a -> a) -> a -> a
- cosmosOnOf :: (Applicative f, Contravariant f) => LensLike' f s a -> LensLike' f a a -> LensLike' f s a
- cosmosOn :: (Applicative f, Contravariant f, Plated a) => LensLike' f s a -> LensLike' f s a
- cosmosOf :: (Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a
- cosmos :: Plated a => Fold a a
- universeOnOf :: Getting [a] s a -> Getting [a] a a -> s -> [a]
- universeOn :: Plated a => Getting [a] s a -> s -> [a]
- universeOf :: Getting [a] a a -> a -> [a]
- universe :: Plated a => a -> [a]
- rewriteMOnOf :: Monad m => LensLike (WrappedMonad m) s t a b -> LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> s -> m t
- rewriteMOn :: (Monad m, Plated a) => LensLike (WrappedMonad m) s t a a -> (a -> m (Maybe a)) -> s -> m t
- rewriteMOf :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> a -> m b
- rewriteM :: (Monad m, Plated a) => (a -> m (Maybe a)) -> a -> m a
- rewriteOnOf :: ASetter s t a b -> ASetter a b a b -> (b -> Maybe a) -> s -> t
- rewriteOn :: Plated a => ASetter s t a a -> (a -> Maybe a) -> s -> t
- rewriteOf :: ASetter a b a b -> (b -> Maybe a) -> a -> b
- rewrite :: Plated a => (a -> Maybe a) -> a -> a
- children :: Plated a => a -> [a]
- deep :: (Conjoined p, Applicative f, Plated s) => Traversing p f s s a b -> Over p f s s a b
- (...) :: (Applicative f, Plated c) => LensLike f s t c c -> Over p f c c a b -> Over p f s t a b
- class Plated a where
- plate :: Traversal' a a
- class GPlated a (g :: k -> Type)
- class GPlated1 (f :: k -> Type) (g :: k -> Type)
- type family Zoomed (m :: Type -> Type) :: Type -> Type -> Type
- type family Magnified (m :: Type -> Type) :: Type -> Type -> Type
- class (MonadState s m, MonadState t n) => Zoom (m :: Type -> Type) (n :: Type -> Type) s t | m -> s, n -> t, m t -> n, n s -> m where
- class (Magnified m ~ Magnified n, MonadReader b m, MonadReader a n) => Magnify (m :: Type -> Type) (n :: Type -> Type) b a | m -> b, n -> a, m a -> n, n b -> m where
- alaf :: (Functor f, Functor g, Rewrapping s t) => (Unwrapped s -> s) -> (f t -> g s) -> f (Unwrapped t) -> g (Unwrapped s)
- ala :: (Functor f, Rewrapping s t) => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s)
- _Unwrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso (Unwrapped t) (Unwrapped s) t s
- _Wrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso s t (Unwrapped s) (Unwrapped t)
- _Unwrapping' :: Wrapped s => (Unwrapped s -> s) -> Iso' (Unwrapped s) s
- _Wrapping' :: Wrapped s => (Unwrapped s -> s) -> Iso' s (Unwrapped s)
- op :: Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
- _Unwrapped :: Rewrapping s t => Iso (Unwrapped t) (Unwrapped s) t s
- _Wrapped :: Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
- _Unwrapped' :: Wrapped s => Iso' (Unwrapped s) s
- _GWrapped' :: (Generic s, D1 d (C1 c (S1 s' (Rec0 a))) ~ Rep s, Unwrapped s ~ GUnwrapped (Rep s)) => Iso' s (Unwrapped s)
- pattern Wrapped :: forall s. Rewrapped s s => Unwrapped s -> s
- pattern Unwrapped :: forall t. Rewrapped t t => t -> Unwrapped t
- class Wrapped s where
- class Wrapped s => Rewrapped s t
- class (Rewrapped s t, Rewrapped t s) => Rewrapping s t
- unsnoc :: Snoc s s a a => s -> Maybe (s, a)
- snoc :: Snoc s s a a => s -> a -> s
- (|>) :: Snoc s s a a => s -> a -> s
- _last :: Snoc s s a a => Traversal' s a
- _init :: Snoc s s a a => Traversal' s s
- _tail :: Cons s s a a => Traversal' s s
- _head :: Cons s s a a => Traversal' s a
- uncons :: Cons s s a a => s -> Maybe (a, s)
- cons :: Cons s s a a => a -> s -> s
- (<|) :: Cons s s a a => a -> s -> s
- pattern (:<) :: forall b a. Cons b b a a => a -> b -> b
- pattern (:>) :: forall a b. Snoc a a b b => a -> b -> a
- class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where
- pattern Empty :: forall s. AsEmpty s => s
- class AsEmpty a where
- coerced :: (Coercible s a, Coercible t b) => Iso s t a b
- seconding :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f x s) (g y t) (f x a) (g y b)
- firsting :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f s x) (g t y) (f a x) (g b y)
- bimapping :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b')
- rmapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p x s) (q y t) (p x a) (q y b)
- lmapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p a x) (q b y) (p s x) (q t y)
- dimapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (p a s') (q b t') (p s a') (q t b')
- contramapping :: Contravariant f => AnIso s t a b -> Iso (f a) (f b) (f s) (f t)
- imagma :: Over (Indexed i) (Molten i a b) s t a b -> Iso s t' (Magma i t b a) (Magma j t' c c)
- magma :: LensLike (Mafic a b) s t a b -> Iso s u (Magma Int t b a) (Magma j u c c)
- involuted :: (a -> a) -> Iso' a a
- reversed :: Reversing a => Iso' a a
- lazy :: Strict lazy strict => Iso' strict lazy
- flipped :: Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
- uncurried :: Iso (a -> b -> c) (d -> e -> f) ((a, b) -> c) ((d, e) -> f)
- curried :: Iso ((a, b) -> c) ((d, e) -> f) (a -> b -> c) (d -> e -> f)
- anon :: a -> (a -> Bool) -> Iso' (Maybe a) a
- non' :: APrism' a () -> Iso' (Maybe a) a
- non :: Eq a => a -> Iso' (Maybe a) a
- mapping :: (Functor f, Functor g) => AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
- enum :: Enum a => Iso' Int a
- under :: AnIso s t a b -> (t -> s) -> b -> a
- xplatf :: Optic (Costar f) g s t a b -> (f a -> g b) -> f s -> g t
- xplat :: Optic (Costar ((->) s :: Type -> Type)) g s t a b -> ((s -> a) -> g b) -> g t
- auf :: (Functor f, Functor g) => AnIso s t a b -> (f t -> g s) -> f b -> g a
- au :: Functor f => AnIso s t a b -> ((b -> t) -> f s) -> f a
- cloneIso :: AnIso s t a b -> Iso s t a b
- withIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
- from :: AnIso s t a b -> Iso b a t s
- iso :: (s -> a) -> (b -> t) -> Iso s t a b
- pattern Strict :: forall s t. Strict s t => t -> s
- pattern Lazy :: forall t s. Strict t s => t -> s
- pattern Swapped :: forall (p :: Type -> Type -> Type) c d. Swapped p => p d c -> p c d
- pattern Reversed :: forall t. Reversing t => t -> t
- pattern List :: forall l. IsList l => [Item l] -> l
- type AnIso s t a b = Exchange a b a (Identity b) -> Exchange a b s (Identity t)
- type AnIso' s a = AnIso s s a a
- class Bifunctor p => Swapped (p :: Type -> Type -> Type) where
- class Strict lazy strict | lazy -> strict, strict -> lazy where
- withEquality :: AnEquality s t a b -> ((s :~: a) -> (b :~: t) -> r) -> r
- fromLeibniz' :: ((s :~: s) -> s :~: a) -> Equality' s a
- fromLeibniz :: (Identical a b a b -> Identical a b s t) -> Equality s t a b
- underEquality :: AnEquality s t a b -> p t s -> p b a
- overEquality :: AnEquality s t a b -> p a b -> p s t
- equality' :: (a :~: b) -> Equality' a b
- equality :: (s :~: a) -> (b :~: t) -> Equality s t a b
- cloneEquality :: AnEquality s t a b -> Equality s t a b
- simple :: Equality' a a
- simply :: (Optic' p f s a -> r) -> Optic' p f s a -> r
- fromEq :: AnEquality s t a b -> Equality b a t s
- mapEq :: AnEquality s t a b -> f s -> f a
- substEq :: AnEquality s t a b -> ((s ~ a) -> (t ~ b) -> r) -> r
- runEq :: AnEquality s t a b -> Identical s t a b
- data Identical (a :: k) (b :: k1) (s :: k) (t :: k1) :: forall k k1. k -> k1 -> k -> k1 -> Type where
- type AnEquality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = Identical a (Proxy b) a (Proxy b) -> Identical a (Proxy b) s (Proxy t)
- type AnEquality' (s :: k2) (a :: k2) = AnEquality s s a a
- itraverseByOf :: IndexedTraversal i s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> s -> f t
- itraverseBy :: TraversableWithIndex i t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> t a -> f (t b)
- ifoldMapByOf :: IndexedFold i t a -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r
- ifoldMapBy :: FoldableWithIndex i t => (r -> r -> r) -> r -> (i -> a -> r) -> t a -> r
- imapAccumL :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b)
- imapAccumR :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b)
- iforM :: (TraversableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m (t b)
- imapM :: (TraversableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m (t b)
- ifor :: (TraversableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f (t b)
- itoList :: FoldableWithIndex i f => f a -> [(i, a)]
- ifoldlM :: (FoldableWithIndex i f, Monad m) => (i -> b -> a -> m b) -> b -> f a -> m b
- ifoldrM :: (FoldableWithIndex i f, Monad m) => (i -> a -> b -> m b) -> b -> f a -> m b
- ifind :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Maybe (i, a)
- iconcatMap :: FoldableWithIndex i f => (i -> a -> [b]) -> f a -> [b]
- iforM_ :: (FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m ()
- imapM_ :: (FoldableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m ()
- ifor_ :: (FoldableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f ()
- itraverse_ :: (FoldableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f ()
- none :: Foldable f => (a -> Bool) -> f a -> Bool
- inone :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool
- iall :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool
- iany :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool
- index :: (Indexable i p, Eq i, Applicative f) => i -> Optical' p (Indexed i) f a a
- indices :: (Indexable i p, Applicative f) => (i -> Bool) -> Optical' p (Indexed i) f a a
- icompose :: Indexable p c => (i -> j -> p) -> (Indexed i s t -> r) -> (Indexed j a b -> s -> t) -> c a b -> r
- reindexed :: Indexable j p => (i -> j) -> (Indexed i a b -> r) -> p a b -> r
- selfIndex :: Indexable a p => p a fb -> a -> fb
- (.>) :: (st -> r) -> (kab -> st) -> kab -> r
- (<.) :: Indexable i p => (Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r
- class Functor f => FunctorWithIndex i (f :: Type -> Type) | f -> i where
- imap :: (i -> a -> b) -> f a -> f b
- imapped :: IndexedSetter i (f a) (f b) a b
- class Foldable f => FoldableWithIndex i (f :: Type -> Type) | f -> i where
- class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i (t :: Type -> Type) | t -> i where
- itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b)
- itraversed :: IndexedTraversal i (t a) (t b) a b
- newtype ReifiedLens s t a b = Lens {}
- type ReifiedLens' s a = ReifiedLens s s a a
- newtype ReifiedIndexedLens i s t a b = IndexedLens {
- runIndexedLens :: IndexedLens i s t a b
- type ReifiedIndexedLens' i s a = ReifiedIndexedLens i s s a a
- newtype ReifiedIndexedTraversal i s t a b = IndexedTraversal {
- runIndexedTraversal :: IndexedTraversal i s t a b
- type ReifiedIndexedTraversal' i s a = ReifiedIndexedTraversal i s s a a
- newtype ReifiedTraversal s t a b = Traversal {
- runTraversal :: Traversal s t a b
- type ReifiedTraversal' s a = ReifiedTraversal s s a a
- newtype ReifiedGetter s a = Getter {}
- newtype ReifiedIndexedGetter i s a = IndexedGetter {
- runIndexedGetter :: IndexedGetter i s a
- newtype ReifiedFold s a = Fold {}
- newtype ReifiedIndexedFold i s a = IndexedFold {
- runIndexedFold :: IndexedFold i s a
- newtype ReifiedSetter s t a b = Setter {}
- type ReifiedSetter' s a = ReifiedSetter s s a a
- newtype ReifiedIndexedSetter i s t a b = IndexedSetter {
- runIndexedSetter :: IndexedSetter i s t a b
- type ReifiedIndexedSetter' i s a = ReifiedIndexedSetter i s s a a
- newtype ReifiedIso s t a b = Iso {}
- type ReifiedIso' s a = ReifiedIso s s a a
- newtype ReifiedPrism s t a b = Prism {}
- type ReifiedPrism' s a = ReifiedPrism s s a a
- ilevels :: Applicative f => Traversing (Indexed i) f s t a b -> IndexedLensLike Int f s t (Level i a) (Level j b)
- levels :: Applicative f => Traversing ((->) :: Type -> Type -> Type) f s t a b -> IndexedLensLike Int f s t (Level () a) (Level () b)
- sequenceByOf :: Traversal s t (f b) b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> s -> f t
- traverseByOf :: Traversal s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t
- confusing :: Applicative f => LensLike (Curried (Yoneda f) (Yoneda f)) s t a b -> LensLike f s t a b
- deepOf :: (Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b
- failing :: (Conjoined p, Applicative f) => Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
- ifailover :: Alternative m => Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t
- failover :: Alternative m => LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t
- elements :: Traversable t => (Int -> Bool) -> IndexedTraversal' Int (t a) a
- elementsOf :: Applicative f => LensLike (Indexing f) s t a a -> (Int -> Bool) -> IndexedLensLike Int f s t a a
- element :: Traversable t => Int -> IndexedTraversal' Int (t a) a
- elementOf :: Applicative f => LensLike (Indexing f) s t a a -> Int -> IndexedLensLike Int f s t a a
- ignored :: Applicative f => pafb -> s -> f s
- traversed64 :: Traversable f => IndexedTraversal Int64 (f a) (f b) a b
- traversed1 :: Traversable1 f => IndexedTraversal1 Int (f a) (f b) a b
- traversed :: Traversable f => IndexedTraversal Int (f a) (f b) a b
- imapAccumLOf :: Over (Indexed i) (State acc) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- imapAccumROf :: Over (Indexed i) (Backwards (State acc)) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- iforMOf :: (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t) -> s -> (i -> a -> m b) -> m t
- imapMOf :: Over (Indexed i) (WrappedMonad m) s t a b -> (i -> a -> m b) -> s -> m t
- iforOf :: (Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t
- itraverseOf :: (Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
- cloneIndexedTraversal1 :: AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b
- cloneIndexPreservingTraversal1 :: ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b
- cloneTraversal1 :: ATraversal1 s t a b -> Traversal1 s t a b
- cloneIndexedTraversal :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b
- cloneIndexPreservingTraversal :: ATraversal s t a b -> IndexPreservingTraversal s t a b
- cloneTraversal :: ATraversal s t a b -> Traversal s t a b
- dropping :: (Conjoined p, Applicative f) => Int -> Over p (Indexing f) s t a a -> Over p f s t a a
- taking :: (Conjoined p, Applicative f) => Int -> Traversing p f s t a a -> Over p f s t a a
- beside :: (Representable q, Applicative (Rep q), Applicative f, Bitraversable r) => Optical p q f s t a b -> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b
- both1 :: Bitraversable1 r => Traversal1 (r a a) (r b b) a b
- both :: Bitraversable r => Traversal (r a a) (r b b) a b
- holes1Of :: Conjoined p => Over p (Bazaar1 p a a) s t a a -> s -> NonEmpty (Pretext p a a t)
- holesOf :: Conjoined p => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t]
- unsafeSingular :: (HasCallStack, Conjoined p, Functor f) => Traversing p f s t a b -> Over p f s t a b
- singular :: (HasCallStack, Conjoined p, Functor f) => Traversing p f s t a a -> Over p f s t a a
- iunsafePartsOf' :: Over (Indexed i) (Bazaar (Indexed i) a b) s t a b -> IndexedLens [i] s t [a] [b]
- unsafePartsOf' :: ATraversal s t a b -> Lens s t [a] [b]
- iunsafePartsOf :: (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a b -> Over p f s t [a] [b]
- unsafePartsOf :: Functor f => Traversing ((->) :: Type -> Type -> Type) f s t a b -> LensLike f s t [a] [b]
- ipartsOf' :: (Indexable [i] p, Functor f) => Over (Indexed i) (Bazaar' (Indexed i) a) s t a a -> Over p f s t [a] [a]
- partsOf' :: ATraversal s t a a -> Lens s t [a] [a]
- ipartsOf :: (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a a -> Over p f s t [a] [a]
- partsOf :: Functor f => Traversing ((->) :: Type -> Type -> Type) f s t a a -> LensLike f s t [a] [a]
- iloci :: IndexedTraversal i (Bazaar (Indexed i) a c s) (Bazaar (Indexed i) b c s) a b
- loci :: Traversal (Bazaar ((->) :: Type -> Type -> Type) a c s) (Bazaar ((->) :: Type -> Type -> Type) b c s) a b
- scanl1Of :: LensLike (State (Maybe a)) s t a a -> (a -> a -> a) -> s -> t
- scanr1Of :: LensLike (Backwards (State (Maybe a))) s t a a -> (a -> a -> a) -> s -> t
- mapAccumLOf :: LensLike (State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- mapAccumROf :: LensLike (Backwards (State acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- transposeOf :: LensLike ZipList s t [a] a -> s -> [t]
- sequenceOf :: LensLike (WrappedMonad m) s t (m b) b -> s -> m t
- forMOf :: LensLike (WrappedMonad m) s t a b -> s -> (a -> m b) -> m t
- mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
- sequenceAOf :: LensLike f s t (f b) b -> s -> f t
- forOf :: LensLike f s t a b -> s -> (a -> f b) -> f t
- traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t
- type ATraversal s t a b = LensLike (Bazaar ((->) :: Type -> Type -> Type) a b) s t a b
- type ATraversal' s a = ATraversal s s a a
- type ATraversal1 s t a b = LensLike (Bazaar1 ((->) :: Type -> Type -> Type) a b) s t a b
- type ATraversal1' s a = ATraversal1 s s a a
- type AnIndexedTraversal i s t a b = Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
- type AnIndexedTraversal1 i s t a b = Over (Indexed i) (Bazaar1 (Indexed i) a b) s t a b
- type AnIndexedTraversal' i s a = AnIndexedTraversal i s s a a
- type AnIndexedTraversal1' i s a = AnIndexedTraversal1 i s s a a
- type Traversing (p :: Type -> Type -> Type) (f :: Type -> Type) s t a b = Over p (BazaarT p f a b) s t a b
- type Traversing1 (p :: Type -> Type -> Type) (f :: Type -> Type) s t a b = Over p (BazaarT1 p f a b) s t a b
- type Traversing' (p :: Type -> Type -> Type) (f :: Type -> Type) s a = Traversing p f s s a a
- type Traversing1' (p :: Type -> Type -> Type) (f :: Type -> Type) s a = Traversing1 p f s s a a
- class Ord k => TraverseMin k (m :: Type -> Type) | m -> k where
- traverseMin :: IndexedTraversal' k (m v) v
- class Ord k => TraverseMax k (m :: Type -> Type) | m -> k where
- traverseMax :: IndexedTraversal' k (m v) v
- foldMapByOf :: Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r
- foldByOf :: Fold s a -> (a -> a -> a) -> a -> s -> a
- idroppingWhile :: (Indexable i p, Profunctor q, Applicative f) => (i -> a -> Bool) -> Optical (Indexed i) q (Compose (State Bool) f) s t a a -> Optical p q f s t a a
- itakingWhile :: (Indexable i p, Profunctor q, Contravariant f, Applicative f) => (i -> a -> Bool) -> Optical' (Indexed i) q (Const (Endo (f s)) :: Type -> Type) s a -> Optical' p q f s a
- ifiltered :: (Indexable i p, Applicative f) => (i -> a -> Bool) -> Optical' p (Indexed i) f a a
- findIndicesOf :: IndexedGetting i (Endo [i]) s a -> (a -> Bool) -> s -> [i]
- findIndexOf :: IndexedGetting i (First i) s a -> (a -> Bool) -> s -> Maybe i
- elemIndicesOf :: Eq a => IndexedGetting i (Endo [i]) s a -> a -> s -> [i]
- elemIndexOf :: Eq a => IndexedGetting i (First i) s a -> a -> s -> Maybe i
- (^@?!) :: HasCallStack => s -> IndexedGetting i (Endo (i, a)) s a -> (i, a)
- (^@?) :: s -> IndexedGetting i (Endo (Maybe (i, a))) s a -> Maybe (i, a)
- (^@..) :: s -> IndexedGetting i (Endo [(i, a)]) s a -> [(i, a)]
- itoListOf :: IndexedGetting i (Endo [(i, a)]) s a -> s -> [(i, a)]
- ifoldlMOf :: Monad m => IndexedGetting i (Endo (r -> m r)) s a -> (i -> r -> a -> m r) -> r -> s -> m r
- ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (r -> m r))) s a -> (i -> a -> r -> m r) -> r -> s -> m r
- ifoldlOf' :: IndexedGetting i (Endo (r -> r)) s a -> (i -> r -> a -> r) -> r -> s -> r
- ifoldrOf' :: IndexedGetting i (Dual (Endo (r -> r))) s a -> (i -> a -> r -> r) -> r -> s -> r
- ifindMOf :: Monad m => IndexedGetting i (Endo (m (Maybe a))) s a -> (i -> a -> m Bool) -> s -> m (Maybe a)
- ifindOf :: IndexedGetting i (Endo (Maybe a)) s a -> (i -> a -> Bool) -> s -> Maybe a
- iconcatMapOf :: IndexedGetting i [r] s a -> (i -> a -> [r]) -> s -> [r]
- iforMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> s -> (i -> a -> m r) -> m ()
- imapMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> (i -> a -> m r) -> s -> m ()
- iforOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> s -> (i -> a -> f r) -> f ()
- itraverseOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> (i -> a -> f r) -> s -> f ()
- inoneOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool
- iallOf :: IndexedGetting i All s a -> (i -> a -> Bool) -> s -> Bool
- ianyOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool
- ifoldlOf :: IndexedGetting i (Dual (Endo r)) s a -> (i -> r -> a -> r) -> r -> s -> r
- ifoldrOf :: IndexedGetting i (Endo r) s a -> (i -> a -> r -> r) -> r -> s -> r
- ifoldMapOf :: IndexedGetting i m s a -> (i -> a -> m) -> s -> m
- backwards :: (Profunctor p, Profunctor q) => Optical p q (Backwards f) s t a b -> Optical p q f s t a b
- ipreuses :: MonadState s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r)
- preuses :: MonadState s m => Getting (First r) s a -> (a -> r) -> m (Maybe r)
- ipreuse :: MonadState s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a))
- preuse :: MonadState s m => Getting (First a) s a -> m (Maybe a)
- ipreviews :: MonadReader s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r)
- previews :: MonadReader s m => Getting (First r) s a -> (a -> r) -> m (Maybe r)
- ipreview :: MonadReader s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a))
- preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a)
- ipre :: IndexedGetting i (First (i, a)) s a -> IndexPreservingGetter s (Maybe (i, a))
- pre :: Getting (First a) s a -> IndexPreservingGetter s (Maybe a)
- hasn't :: Getting All s a -> s -> Bool
- has :: Getting Any s a -> s -> Bool
- foldlMOf :: Monad m => Getting (Endo (r -> m r)) s a -> (r -> a -> m r) -> r -> s -> m r
- foldrMOf :: Monad m => Getting (Dual (Endo (r -> m r))) s a -> (a -> r -> m r) -> r -> s -> m r
- foldl1Of' :: HasCallStack => Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a
- foldr1Of' :: HasCallStack => Getting (Dual (Endo (Endo (Maybe a)))) s a -> (a -> a -> a) -> s -> a
- foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r
- foldrOf' :: Getting (Dual (Endo (Endo r))) s a -> (a -> r -> r) -> r -> s -> r
- foldl1Of :: HasCallStack => Getting (Dual (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a
- foldr1Of :: HasCallStack => Getting (Endo (Maybe a)) s a -> (a -> a -> a) -> s -> a
- lookupOf :: Eq k => Getting (Endo (Maybe v)) s (k, v) -> k -> s -> Maybe v
- findMOf :: Monad m => Getting (Endo (m (Maybe a))) s a -> (a -> m Bool) -> s -> m (Maybe a)
- findOf :: Getting (Endo (Maybe a)) s a -> (a -> Bool) -> s -> Maybe a
- minimumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a
- maximumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a
- minimum1Of :: Ord a => Getting (Min a) s a -> s -> a
- minimumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
- maximum1Of :: Ord a => Getting (Max a) s a -> s -> a
- maximumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
- notNullOf :: Getting Any s a -> s -> Bool
- nullOf :: Getting All s a -> s -> Bool
- last1Of :: Getting (Last a) s a -> s -> a
- lastOf :: Getting (Rightmost a) s a -> s -> Maybe a
- first1Of :: Getting (First a) s a -> s -> a
- firstOf :: Getting (Leftmost a) s a -> s -> Maybe a
- (^?!) :: HasCallStack => s -> Getting (Endo a) s a -> a
- (^?) :: s -> Getting (First a) s a -> Maybe a
- lengthOf :: Getting (Endo (Endo Int)) s a -> s -> Int
- concatOf :: Getting [r] s [r] -> s -> [r]
- concatMapOf :: Getting [r] s a -> (a -> [r]) -> s -> [r]
- notElemOf :: Eq a => Getting All s a -> a -> s -> Bool
- elemOf :: Eq a => Getting Any s a -> a -> s -> Bool
- msumOf :: MonadPlus m => Getting (Endo (m a)) s (m a) -> s -> m a
- asumOf :: Alternative f => Getting (Endo (f a)) s (f a) -> s -> f a
- sequenceOf_ :: Monad m => Getting (Sequenced a m) s (m a) -> s -> m ()
- forMOf_ :: Monad m => Getting (Sequenced r m) s a -> s -> (a -> m r) -> m ()
- mapMOf_ :: Monad m => Getting (Sequenced r m) s a -> (a -> m r) -> s -> m ()
- sequence1Of_ :: Functor f => Getting (TraversedF a f) s (f a) -> s -> f ()
- for1Of_ :: Functor f => Getting (TraversedF r f) s a -> s -> (a -> f r) -> f ()
- traverse1Of_ :: Functor f => Getting (TraversedF r f) s a -> (a -> f r) -> s -> f ()
- sequenceAOf_ :: Functor f => Getting (Traversed a f) s (f a) -> s -> f ()
- forOf_ :: Functor f => Getting (Traversed r f) s a -> s -> (a -> f r) -> f ()
- traverseOf_ :: Functor f => Getting (Traversed r f) s a -> (a -> f r) -> s -> f ()
- sumOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a
- productOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a
- noneOf :: Getting Any s a -> (a -> Bool) -> s -> Bool
- allOf :: Getting All s a -> (a -> Bool) -> s -> Bool
- anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool
- orOf :: Getting Any s Bool -> s -> Bool
- andOf :: Getting All s Bool -> s -> Bool
- (^..) :: s -> Getting (Endo [a]) s a -> [a]
- toNonEmptyOf :: Getting (NonEmptyDList a) s a -> s -> NonEmpty a
- toListOf :: Getting (Endo [a]) s a -> s -> [a]
- foldlOf :: Getting (Dual (Endo r)) s a -> (r -> a -> r) -> r -> s -> r
- foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
- foldOf :: Getting a s a -> s -> a
- foldMapOf :: Getting r s a -> (a -> r) -> s -> r
- lined :: Applicative f => IndexedLensLike' Int f String String
- worded :: Applicative f => IndexedLensLike' Int f String String
- droppingWhile :: (Conjoined p, Profunctor q, Applicative f) => (a -> Bool) -> Optical p q (Compose (State Bool) f) s t a a -> Optical p q f s t a a
- takingWhile :: (Conjoined p, Applicative f) => (a -> Bool) -> Over p (TakingWhile p f a a) s t a a -> Over p f s t a a
- filteredBy :: (Indexable i p, Applicative f) => Getting (First i) a i -> p a (f a) -> a -> f a
- filtered :: (Choice p, Applicative f) => (a -> Bool) -> Optic' p f a a
- iterated :: Apply f => (a -> a) -> LensLike' f a a
- unfolded :: (b -> Maybe (a, b)) -> Fold b a
- cycled :: Apply f => LensLike f s t a b -> LensLike f s t a b
- replicated :: Int -> Fold a a
- repeated :: Apply f => LensLike' f a a
- folded64 :: Foldable f => IndexedFold Int64 (f a) a
- folded :: Foldable f => IndexedFold Int (f a) a
- ifoldring :: (Indexable i p, Contravariant f, Applicative f) => ((i -> a -> f a -> f a) -> f a -> s -> f a) -> Over p f s t a b
- foldring :: (Contravariant f, Applicative f) => ((a -> f a -> f a) -> f a -> s -> f a) -> LensLike f s t a b
- ifolding :: (Foldable f, Indexable i p, Contravariant g, Applicative g) => (s -> f (i, a)) -> Over p g s t a b
- folding :: Foldable f => (s -> f a) -> Fold s a
- _Show :: (Read a, Show a) => Prism' String a
- nearly :: a -> (a -> Bool) -> Prism' a ()
- only :: Eq a => a -> Prism' a ()
- _Void :: Prism s s a Void
- _Nothing :: Prism' (Maybe a) ()
- _Just :: Prism (Maybe a) (Maybe b) a b
- _Right :: Prism (Either c a) (Either c b) a b
- _Left :: Prism (Either a c) (Either b c) a b
- matching :: APrism s t a b -> s -> Either t a
- isn't :: APrism s t a b -> s -> Bool
- below :: Traversable f => APrism' s a -> Prism' (f s) (f a)
- aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b)
- without :: APrism s t a b -> APrism u v c d -> Prism (Either s u) (Either t v) (Either a c) (Either b d)
- outside :: Representable p => APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r)
- prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b
- prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
- clonePrism :: APrism s t a b -> Prism s t a b
- withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
- type APrism s t a b = Market a b a (Identity b) -> Market a b s (Identity t)
- type APrism' s a = APrism s s a a
- reuses :: MonadState b m => AReview t b -> (t -> r) -> m r
- reuse :: MonadState b m => AReview t b -> m t
- reviews :: MonadReader b m => AReview t b -> (t -> r) -> m r
- (#) :: AReview t b -> b -> t
- review :: MonadReader b m => AReview t b -> m t
- re :: AReview t b -> Getter b t
- un :: (Profunctor p, Bifunctor p, Functor f) => Getting a s a -> Optic' p f a s
- unto :: (Profunctor p, Bifunctor p, Functor f) => (b -> t) -> Optic p f s t a b
- getting :: (Profunctor p, Profunctor q, Functor f, Contravariant f) => Optical p q f s t a b -> Optical' p q f s a
- (^@.) :: s -> IndexedGetting i (i, a) s a -> (i, a)
- iuses :: MonadState s m => IndexedGetting i r s a -> (i -> a -> r) -> m r
- iuse :: MonadState s m => IndexedGetting i (i, a) s a -> m (i, a)
- iviews :: MonadReader s m => IndexedGetting i r s a -> (i -> a -> r) -> m r
- iview :: MonadReader s m => IndexedGetting i (i, a) s a -> m (i, a)
- ilistenings :: MonadWriter w m => IndexedGetting i v w u -> (i -> u -> v) -> m a -> m (a, v)
- listenings :: MonadWriter w m => Getting v w u -> (u -> v) -> m a -> m (a, v)
- ilistening :: MonadWriter w m => IndexedGetting i (i, u) w u -> m a -> m (a, (i, u))
- listening :: MonadWriter w m => Getting u w u -> m a -> m (a, u)
- uses :: MonadState s m => LensLike' (Const r :: Type -> Type) s a -> (a -> r) -> m r
- use :: MonadState s m => Getting a s a -> m a
- (^.) :: s -> Getting a s a -> a
- views :: MonadReader s m => LensLike' (Const r :: Type -> Type) s a -> (a -> r) -> m r
- view :: MonadReader s m => Getting a s a -> m a
- ilike :: (Indexable i p, Contravariant f, Functor f) => i -> a -> Over' p f s a
- like :: (Profunctor p, Contravariant f, Functor f) => a -> Optic' p f s a
- ito :: (Indexable i p, Contravariant f) => (s -> (i, a)) -> Over' p f s a
- to :: (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a
- type Getting r s a = (a -> Const r a) -> s -> Const r s
- type IndexedGetting i m s a = Indexed i a (Const m a) -> s -> Const m s
- type Accessing (p :: Type -> Type -> Type) m s a = p a (Const m a) -> s -> Const m s
- _19' :: Field19 s t a b => Lens s t a b
- _18' :: Field18 s t a b => Lens s t a b
- _17' :: Field17 s t a b => Lens s t a b
- _16' :: Field16 s t a b => Lens s t a b
- _15' :: Field15 s t a b => Lens s t a b
- _14' :: Field14 s t a b => Lens s t a b
- _13' :: Field13 s t a b => Lens s t a b
- _12' :: Field12 s t a b => Lens s t a b
- _11' :: Field11 s t a b => Lens s t a b
- _10' :: Field10 s t a b => Lens s t a b
- _9' :: Field9 s t a b => Lens s t a b
- _8' :: Field8 s t a b => Lens s t a b
- _7' :: Field7 s t a b => Lens s t a b
- _6' :: Field6 s t a b => Lens s t a b
- _5' :: Field5 s t a b => Lens s t a b
- _4' :: Field4 s t a b => Lens s t a b
- _3' :: Field3 s t a b => Lens s t a b
- _2' :: Field2 s t a b => Lens s t a b
- _1' :: Field1 s t a b => Lens s t a b
- class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field6 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field7 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field8 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field9 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field10 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field11 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field12 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field13 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field14 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field15 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field16 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field17 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field18 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field19 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- fusing :: Functor f => LensLike (Yoneda f) s t a b -> LensLike f s t a b
- last1 :: Traversable1 t => Lens' (t a) a
- head1 :: Traversable1 t => Lens' (t a) a
- united :: Lens' a ()
- devoid :: Over p f Void Void a b
- (<#=) :: MonadState s m => ALens s s a b -> b -> m b
- (<#~) :: ALens s t a b -> b -> s -> (b, t)
- (#%%=) :: MonadState s m => ALens s s a b -> (a -> (r, b)) -> m r
- (<#%=) :: MonadState s m => ALens s s a b -> (a -> b) -> m b
- (<#%~) :: ALens s t a b -> (a -> b) -> s -> (b, t)
- (#%=) :: MonadState s m => ALens s s a b -> (a -> b) -> m ()
- (#=) :: MonadState s m => ALens s s a b -> b -> m ()
- (#%%~) :: Functor f => ALens s t a b -> (a -> f b) -> s -> f t
- (#%~) :: ALens s t a b -> (a -> b) -> s -> t
- (#~) :: ALens s t a b -> b -> s -> t
- storing :: ALens s t a b -> b -> s -> t
- (^#) :: s -> ALens s t a b -> a
- (<<%@=) :: MonadState s m => Over (Indexed i) ((,) a) s s a b -> (i -> a -> b) -> m a
- (<%@=) :: MonadState s m => Over (Indexed i) ((,) b) s s a b -> (i -> a -> b) -> m b
- (%%@=) :: MonadState s m => Over (Indexed i) ((,) r) s s a b -> (i -> a -> (r, b)) -> m r
- (%%@~) :: Over (Indexed i) f s t a b -> (i -> a -> f b) -> s -> f t
- (<<%@~) :: Over (Indexed i) ((,) a) s t a b -> (i -> a -> b) -> s -> (a, t)
- (<%@~) :: Over (Indexed i) ((,) b) s t a b -> (i -> a -> b) -> s -> (b, t)
- overA :: Arrow ar => LensLike (Context a b) s t a b -> ar a b -> ar s t
- (<<>=) :: (MonadState s m, Monoid r) => LensLike' ((,) r) s r -> r -> m r
- (<<>~) :: Monoid m => LensLike ((,) m) s t m m -> m -> s -> (m, t)
- (<<~) :: MonadState s m => ALens s s a b -> m b -> m b
- (<<<>=) :: (MonadState s m, Monoid r) => LensLike' ((,) r) s r -> r -> m r
- (<<&&=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool
- (<<||=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool
- (<<**=) :: (MonadState s m, Floating a) => LensLike' ((,) a) s a -> a -> m a
- (<<^^=) :: (MonadState s m, Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> m a
- (<<^=) :: (MonadState s m, Num a, Integral e) => LensLike' ((,) a) s a -> e -> m a
- (<<//=) :: (MonadState s m, Fractional a) => LensLike' ((,) a) s a -> a -> m a
- (<<*=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a
- (<<-=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a
- (<<+=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a
- (<<?=) :: MonadState s m => LensLike ((,) a) s s a (Maybe b) -> b -> m a
- (<<.=) :: MonadState s m => LensLike ((,) a) s s a b -> b -> m a
- (<<%=) :: (Strong p, MonadState s m) => Over p ((,) a) s s a b -> p a b -> m a
- (<&&=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool
- (<||=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool
- (<**=) :: (MonadState s m, Floating a) => LensLike' ((,) a) s a -> a -> m a
- (<^^=) :: (MonadState s m, Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> m a
- (<^=) :: (MonadState s m, Num a, Integral e) => LensLike' ((,) a) s a -> e -> m a
- (<//=) :: (MonadState s m, Fractional a) => LensLike' ((,) a) s a -> a -> m a
- (<*=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a
- (<-=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a
- (<+=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a
- (<%=) :: MonadState s m => LensLike ((,) b) s s a b -> (a -> b) -> m b
- (<<<>~) :: Monoid r => LensLike' ((,) r) s r -> r -> s -> (r, s)
- (<<&&~) :: LensLike' ((,) Bool) s Bool -> Bool -> s -> (Bool, s)
- (<<||~) :: LensLike' ((,) Bool) s Bool -> Bool -> s -> (Bool, s)
- (<<**~) :: Floating a => LensLike' ((,) a) s a -> a -> s -> (a, s)
- (<<^^~) :: (Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> s -> (a, s)
- (<<^~) :: (Num a, Integral e) => LensLike' ((,) a) s a -> e -> s -> (a, s)
- (<<//~) :: Fractional a => LensLike' ((,) a) s a -> a -> s -> (a, s)
- (<<*~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s)
- (<<-~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s)
- (<<+~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s)
- (<<?~) :: LensLike ((,) a) s t a (Maybe b) -> b -> s -> (a, t)
- (<<.~) :: LensLike ((,) a) s t a b -> b -> s -> (a, t)
- (<<%~) :: LensLike ((,) a) s t a b -> (a -> b) -> s -> (a, t)
- (<&&~) :: LensLike ((,) Bool) s t Bool Bool -> Bool -> s -> (Bool, t)
- (<||~) :: LensLike ((,) Bool) s t Bool Bool -> Bool -> s -> (Bool, t)
- (<**~) :: Floating a => LensLike ((,) a) s t a a -> a -> s -> (a, t)
- (<^^~) :: (Fractional a, Integral e) => LensLike ((,) a) s t a a -> e -> s -> (a, t)
- (<^~) :: (Num a, Integral e) => LensLike ((,) a) s t a a -> e -> s -> (a, t)
- (<//~) :: Fractional a => LensLike ((,) a) s t a a -> a -> s -> (a, t)
- (<*~) :: Num a => LensLike ((,) a) s t a a -> a -> s -> (a, t)
- (<-~) :: Num a => LensLike ((,) a) s t a a -> a -> s -> (a, t)
- (<+~) :: Num a => LensLike ((,) a) s t a a -> a -> s -> (a, t)
- (<%~) :: LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
- cloneIndexedLens :: AnIndexedLens i s t a b -> IndexedLens i s t a b
- cloneIndexPreservingLens :: ALens s t a b -> IndexPreservingLens s t a b
- cloneLens :: ALens s t a b -> Lens s t a b
- locus :: IndexedComonadStore p => Lens (p a c s) (p b c s) a b
- alongside :: LensLike (AlongsideLeft f b') s t a b -> LensLike (AlongsideRight f t) s' t' a' b' -> LensLike f (s, s') (t, t') (a, a') (b, b')
- chosen :: IndexPreservingLens (Either a a) (Either b b) a b
- choosing :: Functor f => LensLike f s t a b -> LensLike f s' t' a b -> LensLike f (Either s s') (Either t t') a b
- inside :: Corepresentable p => ALens s t a b -> Lens (p e s) (p e t) (p e a) (p e b)
- (??) :: Functor f => f (a -> b) -> a -> f b
- (%%=) :: MonadState s m => Over p ((,) r) s s a b -> p a (r, b) -> m r
- (%%~) :: LensLike f s t a b -> (a -> f b) -> s -> f t
- (&~) :: s -> State s a -> s
- ilens :: (s -> (i, a)) -> (s -> b -> t) -> IndexedLens i s t a b
- iplens :: (s -> a) -> (s -> b -> t) -> IndexPreservingLens s t a b
- withLens :: ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r
- lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
- type ALens s t a b = LensLike (Pretext ((->) :: Type -> Type -> Type) a b) s t a b
- type ALens' s a = ALens s s a a
- type AnIndexedLens i s t a b = Optical (Indexed i) ((->) :: Type -> Type -> Type) (Pretext (Indexed i) a b) s t a b
- type AnIndexedLens' i s a = AnIndexedLens i s s a a
- imapOf :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
- mapOf :: ASetter s t a b -> (a -> b) -> s -> t
- assignA :: Arrow p => ASetter s t a b -> p s b -> p s t
- (.@=) :: MonadState s m => AnIndexedSetter i s s a b -> (i -> b) -> m ()
- imodifying :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m ()
- (%@=) :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m ()
- (.@~) :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t
- (%@~) :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
- isets :: ((i -> a -> b) -> s -> t) -> IndexedSetter i s t a b
- iset :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t
- iover :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
- ilocally :: MonadReader s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m r -> m r
- locally :: MonadReader s m => ASetter s s a b -> (a -> b) -> m r -> m r
- icensoring :: MonadWriter w m => IndexedSetter i w w u v -> (i -> u -> v) -> m a -> m a
- censoring :: MonadWriter w m => Setter w w u v -> (u -> v) -> m a -> m a
- ipassing :: MonadWriter w m => IndexedSetter i w w u v -> m (a, i -> u -> v) -> m a
- passing :: MonadWriter w m => Setter w w u v -> m (a, u -> v) -> m a
- scribe :: (MonadWriter t m, Monoid s) => ASetter s t a b -> b -> m ()
- (<>=) :: (MonadState s m, Monoid a) => ASetter' s a -> a -> m ()
- (<>~) :: Monoid a => ASetter s t a a -> a -> s -> t
- (<?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m b
- (<.=) :: MonadState s m => ASetter s s a b -> b -> m b
- (<~) :: MonadState s m => ASetter s s a b -> m b -> m ()
- (||=) :: MonadState s m => ASetter' s Bool -> Bool -> m ()
- (&&=) :: MonadState s m => ASetter' s Bool -> Bool -> m ()
- (**=) :: (MonadState s m, Floating a) => ASetter' s a -> a -> m ()
- (^^=) :: (MonadState s m, Fractional a, Integral e) => ASetter' s a -> e -> m ()
- (^=) :: (MonadState s m, Num a, Integral e) => ASetter' s a -> e -> m ()
- (//=) :: (MonadState s m, Fractional a) => ASetter' s a -> a -> m ()
- (*=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m ()
- (-=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m ()
- (+=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m ()
- (?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m ()
- modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m ()
- (%=) :: MonadState s m => ASetter s s a b -> (a -> b) -> m ()
- assign :: MonadState s m => ASetter s s a b -> b -> m ()
- (&&~) :: ASetter s t Bool Bool -> Bool -> s -> t
- (||~) :: ASetter s t Bool Bool -> Bool -> s -> t
- (**~) :: Floating a => ASetter s t a a -> a -> s -> t
- (^^~) :: (Fractional a, Integral e) => ASetter s t a a -> e -> s -> t
- (^~) :: (Num a, Integral e) => ASetter s t a a -> e -> s -> t
- (//~) :: Fractional a => ASetter s t a a -> a -> s -> t
- (-~) :: Num a => ASetter s t a a -> a -> s -> t
- (*~) :: Num a => ASetter s t a a -> a -> s -> t
- (+~) :: Num a => ASetter s t a a -> a -> s -> t
- (<?~) :: ASetter s t a (Maybe b) -> b -> s -> (b, t)
- (<.~) :: ASetter s t a b -> b -> s -> (b, t)
- (?~) :: ASetter s t a (Maybe b) -> b -> s -> t
- (.~) :: ASetter s t a b -> b -> s -> t
- (%~) :: ASetter s t a b -> (a -> b) -> s -> t
- set' :: ASetter' s a -> a -> s -> s
- set :: ASetter s t a b -> b -> s -> t
- over :: ASetter s t a b -> (a -> b) -> s -> t
- cloneIndexedSetter :: AnIndexedSetter i s t a b -> IndexedSetter i s t a b
- cloneIndexPreservingSetter :: ASetter s t a b -> IndexPreservingSetter s t a b
- cloneSetter :: ASetter s t a b -> Setter s t a b
- sets :: (Profunctor p, Profunctor q, Settable f) => (p a b -> q s t) -> Optical p q f s t a b
- setting :: ((a -> b) -> s -> t) -> IndexPreservingSetter s t a b
- argument :: Profunctor p => Setter (p b r) (p a r) a b
- contramapped :: Contravariant f => Setter (f b) (f a) a b
- lifted :: Monad m => Setter (m a) (m b) a b
- mapped :: Functor f => Setter (f a) (f b) a b
- type ASetter s t a b = (a -> Identity b) -> s -> Identity t
- type ASetter' s a = ASetter s s a a
- type AnIndexedSetter i s t a b = Indexed i a (Identity b) -> s -> Identity t
- type AnIndexedSetter' i s a = AnIndexedSetter i s s a a
- type Setting (p :: Type -> Type -> Type) s t a b = p a (Identity b) -> s -> Identity t
- type Setting' (p :: Type -> Type -> Type) s a = Setting p s s a a
- type Lens s t a b = forall (f :: Type -> Type). Functor f => (a -> f b) -> s -> f t
- type Lens' s a = Lens s s a a
- type IndexedLens i s t a b = forall (f :: Type -> Type) (p :: Type -> Type -> Type). (Indexable i p, Functor f) => p a (f b) -> s -> f t
- type IndexedLens' i s a = IndexedLens i s s a a
- type IndexPreservingLens s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Functor f) => p a (f b) -> p s (f t)
- type IndexPreservingLens' s a = IndexPreservingLens s s a a
- type Traversal s t a b = forall (f :: Type -> Type). Applicative f => (a -> f b) -> s -> f t
- type Traversal' s a = Traversal s s a a
- type Traversal1 s t a b = forall (f :: Type -> Type). Apply f => (a -> f b) -> s -> f t
- type Traversal1' s a = Traversal1 s s a a
- type IndexedTraversal i s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Applicative f) => p a (f b) -> s -> f t
- type IndexedTraversal' i s a = IndexedTraversal i s s a a
- type IndexedTraversal1 i s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Apply f) => p a (f b) -> s -> f t
- type IndexedTraversal1' i s a = IndexedTraversal1 i s s a a
- type IndexPreservingTraversal s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Applicative f) => p a (f b) -> p s (f t)
- type IndexPreservingTraversal' s a = IndexPreservingTraversal s s a a
- type IndexPreservingTraversal1 s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Apply f) => p a (f b) -> p s (f t)
- type IndexPreservingTraversal1' s a = IndexPreservingTraversal1 s s a a
- type Setter s t a b = forall (f :: Type -> Type). Settable f => (a -> f b) -> s -> f t
- type Setter' s a = Setter s s a a
- type IndexedSetter i s t a b = forall (f :: Type -> Type) (p :: Type -> Type -> Type). (Indexable i p, Settable f) => p a (f b) -> s -> f t
- type IndexedSetter' i s a = IndexedSetter i s s a a
- type IndexPreservingSetter s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Settable f) => p a (f b) -> p s (f t)
- type IndexPreservingSetter' s a = IndexPreservingSetter s s a a
- type Iso s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Profunctor p, Functor f) => p a (f b) -> p s (f t)
- type Iso' s a = Iso s s a a
- type Review t b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Choice p, Bifunctor p, Settable f) => Optic' p f t b
- type AReview t b = Optic' (Tagged :: Type -> Type -> Type) Identity t b
- type Prism s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Choice p, Applicative f) => p a (f b) -> p s (f t)
- type Prism' s a = Prism s s a a
- type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall k3 (p :: k1 -> k3 -> Type) (f :: k2 -> k3). p a (f b) -> p s (f t)
- type Equality' (s :: k2) (a :: k2) = Equality s s a a
- type As (a :: k2) = Equality' a a
- type Getter s a = forall (f :: Type -> Type). (Contravariant f, Functor f) => (a -> f a) -> s -> f s
- type IndexedGetter i s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Contravariant f, Functor f) => p a (f a) -> s -> f s
- type IndexPreservingGetter s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Contravariant f, Functor f) => p a (f a) -> p s (f s)
- type Fold s a = forall (f :: Type -> Type). (Contravariant f, Applicative f) => (a -> f a) -> s -> f s
- type IndexedFold i s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Contravariant f, Applicative f) => p a (f a) -> s -> f s
- type IndexPreservingFold s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Contravariant f, Applicative f) => p a (f a) -> p s (f s)
- type Fold1 s a = forall (f :: Type -> Type). (Contravariant f, Apply f) => (a -> f a) -> s -> f s
- type IndexedFold1 i s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Contravariant f, Apply f) => p a (f a) -> s -> f s
- type IndexPreservingFold1 s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Contravariant f, Apply f) => p a (f a) -> p s (f s)
- type Simple (f :: k -> k -> k1 -> k1 -> k2) (s :: k) (a :: k1) = f s s a a
- type Optic (p :: k1 -> k -> Type) (f :: k2 -> k) (s :: k1) (t :: k2) (a :: k1) (b :: k2) = p a (f b) -> p s (f t)
- type Optic' (p :: k1 -> k -> Type) (f :: k1 -> k) (s :: k1) (a :: k1) = Optic p f s s a a
- type Optical (p :: k2 -> k -> Type) (q :: k1 -> k -> Type) (f :: k3 -> k) (s :: k1) (t :: k3) (a :: k2) (b :: k3) = p a (f b) -> q s (f t)
- type Optical' (p :: k1 -> k -> Type) (q :: k1 -> k -> Type) (f :: k1 -> k) (s :: k1) (a :: k1) = Optical p q f s s a a
- type LensLike (f :: k -> Type) s (t :: k) a (b :: k) = (a -> f b) -> s -> f t
- type LensLike' (f :: Type -> Type) s a = LensLike f s s a a
- type IndexedLensLike i (f :: k -> Type) s (t :: k) a (b :: k) = forall (p :: Type -> Type -> Type). Indexable i p => p a (f b) -> s -> f t
- type IndexedLensLike' i (f :: Type -> Type) s a = IndexedLensLike i f s s a a
- type Over (p :: k -> Type -> Type) (f :: k1 -> Type) s (t :: k1) (a :: k) (b :: k1) = p a (f b) -> s -> f t
- type Over' (p :: Type -> Type -> Type) (f :: Type -> Type) s a = Over p f s s a a
- class (Applicative f, Distributive f, Traversable f) => Settable (f :: Type -> Type)
- retagged :: (Profunctor p, Bifunctor p) => p a b -> p s b
- class (Profunctor p, Bifunctor p) => Reviewable (p :: Type -> Type -> Type)
- data Magma i t b a
- data Level i a
- class Reversing t where
- reversing :: t -> t
- newtype Bazaar (p :: Type -> Type -> Type) a b t = Bazaar {
- runBazaar :: forall (f :: Type -> Type). Applicative f => p a (f b) -> f t
- type Bazaar' (p :: Type -> Type -> Type) a = Bazaar p a a
- newtype Bazaar1 (p :: Type -> Type -> Type) a b t = Bazaar1 {
- runBazaar1 :: forall (f :: Type -> Type). Apply f => p a (f b) -> f t
- type Bazaar1' (p :: Type -> Type -> Type) a = Bazaar1 p a a
- data Context a b t = Context (b -> t) a
- type Context' a = Context a a
- asIndex :: (Indexable i p, Contravariant f, Functor f) => p i (f i) -> Indexed i s (f s)
- withIndex :: (Indexable i p, Functor f) => p (i, s) (f (j, t)) -> Indexed i s (f t)
- indexing64 :: Indexable Int64 p => ((a -> Indexing64 f b) -> s -> Indexing64 f t) -> p a (f b) -> s -> f t
- indexing :: Indexable Int p => ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
- class (Choice p, Corepresentable p, Comonad (Corep p), Traversable (Corep p), Strong p, Representable p, Monad (Rep p), MonadFix (Rep p), Distributive (Rep p), Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p, Closed p) => Conjoined (p :: Type -> Type -> Type) where
- class Conjoined p => Indexable i (p :: Type -> Type -> Type) where
- indexed :: p a b -> i -> a -> b
- newtype Indexed i a b = Indexed {
- runIndexed :: i -> a -> b
- data Traversed a (f :: Type -> Type)
- data Sequenced a (m :: Type -> Type)
- data Leftmost a
- data Rightmost a
- class (Foldable1 t, Traversable t) => Traversable1 (t :: Type -> Type) where
- foldBy :: Foldable t => (a -> a -> a) -> a -> t a -> a
- foldMapBy :: Foldable t => (r -> r -> r) -> r -> (a -> r) -> t a -> r
- traverseBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b)
- sequenceBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a)
- class Profunctor p => Choice (p :: Type -> Type -> Type) where
- _JSON' :: (AsJSON t, FromJSON a, ToJSON a) => Prism' t a
- values :: AsValue t => IndexedTraversal' Int t Value
- nth :: AsValue t => Int -> Traversal' t Value
- members :: AsValue t => IndexedTraversal' Text t Value
- key :: AsValue t => Text -> Traversal' t Value
- nonNull :: Prism' Value Value
- _Integral :: (AsNumber t, Integral a) => Prism' t a
- pattern JSON :: forall a t. (FromJSON a, ToJSON a, AsJSON t) => a -> t
- pattern Value_ :: forall a. (FromJSON a, ToJSON a) => a -> Value
- pattern Number_ :: forall t. AsNumber t => Scientific -> t
- pattern Double :: forall t. AsNumber t => Double -> t
- pattern Integer :: forall t. AsNumber t => Integer -> t
- pattern Integral :: forall t a. (AsNumber t, Integral a) => a -> t
- pattern Primitive :: forall t. AsPrimitive t => Primitive -> t
- pattern Bool_ :: forall t. AsPrimitive t => Bool -> t
- pattern String_ :: forall t. AsPrimitive t => Text -> t
- pattern Null_ :: forall t. AsPrimitive t => t
- class AsNumber t where
- data Primitive
- = StringPrim !Text
- | NumberPrim !Scientific
- | BoolPrim !Bool
- | NullPrim
- class AsNumber t => AsPrimitive t where
- class AsPrimitive t => AsValue t where
- class AsJSON t where
- liftIO :: MonadIO m => IO a -> m a
SitePipe
This module re-exports everything you need to build a site.
In addition to exporting all of SitePipe it also exports Data.Aeson, Data.Aeson.Lens,
Control.Lens, System.FilePath.Posix, and liftIO
Running SitePipe
site :: SiteM () -> IO () Source #
Build a site generator from a set of rules embedded in a SiteM
.
Use this in your main
function.
main :: IO () main = site $ do posts <- resourceLoader markdownReader ["posts/*.md"] writeTemplate "templates/post.html" posts
siteWithGlobals :: Value -> SiteM () -> IO () Source #
Like site
, but allows you to pass an Value
Object which consists
of an environment which is available inside your templates.
This is useful for globally providing utility functions for use in your templates.
import qualified Text.Mustache as MT import qualified Text.Mustache.Types as MT utilityFuncs :: MT.Value utilityFuncs = MT.object ["truncate" MT.~> MT.overText (T.take 30) ] main :: IO () main = siteWithGlobals utilityFuncs $ do -- your site ...
<!-- in your template --> {{#truncate}} Anything inside this block will be truncated to 30 chars. {{vars}} are interpolated before applying the function. {{/truncate}}
Loaders
:: (String -> IO String) | A reader which processes file contents |
-> [GlobPattern] | File glob; relative to the |
-> SiteM [Value] | Returns a list of Aeson objects |
Given a resource reader (see SitePipe.Readers)
this function finds all files matching any of the provided list
of fileglobs (according to srcGlob
) and returns a list of loaded resources
as Aeson Value
s.
Writers
:: ToJSON a | |
=> (a -> SiteM String) | A function which renders a resource to a string. |
-> [a] | List of resources to write |
-> SiteM () |
Write a list of resources using the given processing function from a resource to a string.
:: ToJSON a | |
=> FilePath | Path to template (relative to site dir) |
-> [a] | List of resources to write |
-> SiteM () |
Given a path to a mustache template file (relative to your source directory); this writes a list of resources to the output directory by applying each one to the template.
Writes the content of the given resources without using a template.
Loader/Writers
copyFiles :: [GlobPattern] -> SiteM [Value] Source #
Given a list of file or directory globs (see srcGlob
)
we copy matching files and directories as-is from the source directory
to the output directory maintaining their relative filepath.
For convenience this also returns a list of the files copied as
Value
s with "src" and "url" keys
which represent the source path and the url.of the copied file respectively.
copyFilesWith :: (FilePath -> FilePath) -> [GlobPattern] -> SiteM [Value] Source #
Readers
Built-in
Reader Generators
mkPandocReader :: (ReaderOptions -> String -> PandocIO Pandoc) -> String -> IO String Source #
Given any standard pandoc reader (see Text.Pandoc; e.g. readMarkdown
, readDocX
)
makes a resource reader compatible with resourceLoader
.
docs <- resourceLoader (mkPandocReader readDocX) ["docs/*.docx"]
Utilities
setExt :: String -> FilePath -> FilePath Source #
Set the extension of a filepath or url to the given extension.
Use setExt ""
to remove any extension.
Given a function which creates a url from a tag name and a list of posts (which have a tags property which is a list of strings) this returns a list of tags which contain:
- name: The tag name
- url: The tag's url
- posts: The list of posts matching that tag
Types
module SitePipe.Types
Exports
class (Functor t, Foldable t) => Traversable (t :: Type -> Type) where #
Functors representing data structures that can be traversed from left to right.
A definition of traverse
must satisfy the following laws:
- naturality
t .
for every applicative transformationtraverse
f =traverse
(t . f)t
- identity
traverse
Identity = Identity- composition
traverse
(Compose .fmap
g . f) = Compose .fmap
(traverse
g) .traverse
f
A definition of sequenceA
must satisfy the following laws:
- naturality
t .
for every applicative transformationsequenceA
=sequenceA
.fmap
tt
- identity
sequenceA
.fmap
Identity = Identity- composition
sequenceA
.fmap
Compose = Compose .fmap
sequenceA
.sequenceA
where an applicative transformation is a function
t :: (Applicative f, Applicative g) => f a -> g a
preserving the Applicative
operations, i.e.
and the identity functor Identity
and composition of functors Compose
are defined as
newtype Identity a = Identity a instance Functor Identity where fmap f (Identity x) = Identity (f x) instance Applicative Identity where pure x = Identity x Identity f <*> Identity x = Identity (f x) newtype Compose f g a = Compose (f (g a)) instance (Functor f, Functor g) => Functor (Compose f g) where fmap f (Compose x) = Compose (fmap (fmap f) x) instance (Applicative f, Applicative g) => Applicative (Compose f g) where pure x = Compose (pure (pure x)) Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
(The naturality law is implied by parametricity.)
Instances are similar to Functor
, e.g. given a data type
data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
a suitable instance would be
instance Traversable Tree where traverse f Empty = pure Empty traverse f (Leaf x) = Leaf <$> f x traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r
This is suitable even for abstract types, as the laws for <*>
imply a form of associativity.
The superclass instances should satisfy the following:
- In the
Functor
instance,fmap
should be equivalent to traversal with the identity applicative functor (fmapDefault
). - In the
Foldable
instance,foldMap
should be equivalent to traversal with a constant applicative functor (foldMapDefault
).
traverse :: Applicative f => (a -> f b) -> t a -> f (t b) #
Map each element of a structure to an action, evaluate these actions
from left to right, and collect the results. For a version that ignores
the results see traverse_
.
Instances
File and directory names are values of type String
, whose precise
meaning is operating system dependent. Files can be opened, yielding a
handle which can then be used to operate on the contents of that file.
newtype Const a (b :: k) :: forall k. Type -> k -> Type #
The Const
functor.
Instances
Generic1 (Const a :: k -> Type) | |
ToJSON2 (Const :: Type -> Type -> Type) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> Const a b -> Value # liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [Const a b] -> Value # liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> Const a b -> Encoding # liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [Const a b] -> Encoding # | |
FromJSON2 (Const :: Type -> Type -> Type) | |
Defined in Data.Aeson.Types.FromJSON | |
Bitraversable (Const :: Type -> Type -> Type) | Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Const a b -> f (Const c d) # | |
Bifunctor (Const :: Type -> Type -> Type) | Since: base-4.8.0.0 |
Eq2 (Const :: Type -> Type -> Type) | Since: base-4.9.0.0 |
Ord2 (Const :: Type -> Type -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Classes | |
Read2 (Const :: Type -> Type -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Classes liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (Const a b) # liftReadList2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [Const a b] # liftReadPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (Const a b) # liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [Const a b] # | |
Show2 (Const :: Type -> Type -> Type) | Since: base-4.9.0.0 |
Biapplicative (Const :: Type -> Type -> Type) | |
Hashable2 (Const :: Type -> Type -> Type) | |
Defined in Data.Hashable.Class | |
Bitraversable1 (Const :: Type -> Type -> Type) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> Const a c -> f (Const b d) # bisequence1 :: Apply f => Const (f a) (f b) -> f (Const a b) # | |
Biapply (Const :: Type -> Type -> Type) | |
Functor (Const m :: Type -> Type) | Since: base-2.1 |
Monoid m => Applicative (Const m :: Type -> Type) | Since: base-2.0.1 |
Foldable (Const m :: Type -> Type) | Since: base-4.7.0.0 |
Defined in Data.Functor.Const fold :: Monoid m0 => Const m m0 -> m0 # foldMap :: Monoid m0 => (a -> m0) -> Const m a -> m0 # foldr :: (a -> b -> b) -> b -> Const m a -> b # foldr' :: (a -> b -> b) -> b -> Const m a -> b # foldl :: (b -> a -> b) -> b -> Const m a -> b # foldl' :: (b -> a -> b) -> b -> Const m a -> b # foldr1 :: (a -> a -> a) -> Const m a -> a # foldl1 :: (a -> a -> a) -> Const m a -> a # elem :: Eq a => a -> Const m a -> Bool # maximum :: Ord a => Const m a -> a # minimum :: Ord a => Const m a -> a # | |
Traversable (Const m :: Type -> Type) | Since: base-4.7.0.0 |
Contravariant (Const a :: Type -> Type) | |
ToJSON a => ToJSON1 (Const a :: Type -> Type) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> Const a a0 -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [Const a a0] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> Const a a0 -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [Const a a0] -> Encoding # | |
FromJSON a => FromJSON1 (Const a :: Type -> Type) | |
Eq a => Eq1 (Const a :: Type -> Type) | Since: base-4.9.0.0 |
Ord a => Ord1 (Const a :: Type -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Classes | |
Read a => Read1 (Const a :: Type -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Classes | |
Show a => Show1 (Const a :: Type -> Type) | Since: base-4.9.0.0 |
Hashable a => Hashable1 (Const a :: Type -> Type) | |
Defined in Data.Hashable.Class | |
Semigroup m => Apply (Const m :: Type -> Type) | |
Bounded a => Bounded (Const a b) | Since: base-4.9.0.0 |
Enum a => Enum (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const succ :: Const a b -> Const a b # pred :: Const a b -> Const a b # fromEnum :: Const a b -> Int # enumFrom :: Const a b -> [Const a b] # enumFromThen :: Const a b -> Const a b -> [Const a b] # enumFromTo :: Const a b -> Const a b -> [Const a b] # enumFromThenTo :: Const a b -> Const a b -> Const a b -> [Const a b] # | |
Eq a => Eq (Const a b) | Since: base-4.9.0.0 |
Floating a => Floating (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const exp :: Const a b -> Const a b # log :: Const a b -> Const a b # sqrt :: Const a b -> Const a b # (**) :: Const a b -> Const a b -> Const a b # logBase :: Const a b -> Const a b -> Const a b # sin :: Const a b -> Const a b # cos :: Const a b -> Const a b # tan :: Const a b -> Const a b # asin :: Const a b -> Const a b # acos :: Const a b -> Const a b # atan :: Const a b -> Const a b # sinh :: Const a b -> Const a b # cosh :: Const a b -> Const a b # tanh :: Const a b -> Const a b # asinh :: Const a b -> Const a b # acosh :: Const a b -> Const a b # atanh :: Const a b -> Const a b # log1p :: Const a b -> Const a b # expm1 :: Const a b -> Const a b # | |
Fractional a => Fractional (Const a b) | Since: base-4.9.0.0 |
Integral a => Integral (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const | |
Num a => Num (Const a b) | Since: base-4.9.0.0 |
Ord a => Ord (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const | |
Read a => Read (Const a b) | This instance would be equivalent to the derived instances of the
Since: base-4.8.0.0 |
Real a => Real (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const toRational :: Const a b -> Rational # | |
RealFloat a => RealFloat (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const floatRadix :: Const a b -> Integer # floatDigits :: Const a b -> Int # floatRange :: Const a b -> (Int, Int) # decodeFloat :: Const a b -> (Integer, Int) # encodeFloat :: Integer -> Int -> Const a b # exponent :: Const a b -> Int # significand :: Const a b -> Const a b # scaleFloat :: Int -> Const a b -> Const a b # isInfinite :: Const a b -> Bool # isDenormalized :: Const a b -> Bool # isNegativeZero :: Const a b -> Bool # | |
RealFrac a => RealFrac (Const a b) | Since: base-4.9.0.0 |
Show a => Show (Const a b) | This instance would be equivalent to the derived instances of the
Since: base-4.8.0.0 |
Ix a => Ix (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const range :: (Const a b, Const a b) -> [Const a b] # index :: (Const a b, Const a b) -> Const a b -> Int # unsafeIndex :: (Const a b, Const a b) -> Const a b -> Int inRange :: (Const a b, Const a b) -> Const a b -> Bool # rangeSize :: (Const a b, Const a b) -> Int # unsafeRangeSize :: (Const a b, Const a b) -> Int | |
IsString a => IsString (Const a b) | Since: base-4.9.0.0 |
Defined in Data.String fromString :: String -> Const a b # | |
Generic (Const a b) | |
Semigroup a => Semigroup (Const a b) | Since: base-4.9.0.0 |
Monoid a => Monoid (Const a b) | Since: base-4.9.0.0 |
Hashable a => Hashable (Const a b) | |
Defined in Data.Hashable.Class | |
ToJSON a => ToJSON (Const a b) | |
Defined in Data.Aeson.Types.ToJSON | |
FromJSON a => FromJSON (Const a b) | |
Storable a => Storable (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const | |
Bits a => Bits (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const (.&.) :: Const a b -> Const a b -> Const a b # (.|.) :: Const a b -> Const a b -> Const a b # xor :: Const a b -> Const a b -> Const a b # complement :: Const a b -> Const a b # shift :: Const a b -> Int -> Const a b # rotate :: Const a b -> Int -> Const a b # setBit :: Const a b -> Int -> Const a b # clearBit :: Const a b -> Int -> Const a b # complementBit :: Const a b -> Int -> Const a b # testBit :: Const a b -> Int -> Bool # bitSizeMaybe :: Const a b -> Maybe Int # isSigned :: Const a b -> Bool # shiftL :: Const a b -> Int -> Const a b # unsafeShiftL :: Const a b -> Int -> Const a b # shiftR :: Const a b -> Int -> Const a b # unsafeShiftR :: Const a b -> Int -> Const a b # rotateL :: Const a b -> Int -> Const a b # | |
FiniteBits a => FiniteBits (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const finiteBitSize :: Const a b -> Int # countLeadingZeros :: Const a b -> Int # countTrailingZeros :: Const a b -> Int # | |
Prim a => Prim (Const a b) | Since: primitive-0.6.5.0 |
Defined in Data.Primitive.Types sizeOf# :: Const a b -> Int# # alignment# :: Const a b -> Int# # indexByteArray# :: ByteArray# -> Int# -> Const a b # readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (#State# s, Const a b#) # writeByteArray# :: MutableByteArray# s -> Int# -> Const a b -> State# s -> State# s # setByteArray# :: MutableByteArray# s -> Int# -> Int# -> Const a b -> State# s -> State# s # indexOffAddr# :: Addr# -> Int# -> Const a b # readOffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Const a b#) # writeOffAddr# :: Addr# -> Int# -> Const a b -> State# s -> State# s # setOffAddr# :: Addr# -> Int# -> Int# -> Const a b -> State# s -> State# s # | |
Wrapped (Const a x) | |
t ~ Const a' x' => Rewrapped (Const a x) t | |
Defined in Control.Lens.Wrapped | |
type Rep1 (Const a :: k -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const | |
type Rep (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const | |
type Unwrapped (Const a x) | |
Defined in Control.Lens.Wrapped |
Identity functor and monad. (a non-strict monad)
Since: base-4.8.0.0
Identity | |
|
Instances
class Contravariant (f :: Type -> Type) where #
The class of contravariant functors.
Whereas in Haskell, one can think of a Functor
as containing or producing
values, a contravariant functor is a functor that can be thought of as
consuming values.
As an example, consider the type of predicate functions a -> Bool
. One
such predicate might be negative x = x < 0
, which
classifies integers as to whether they are negative. However, given this
predicate, we can re-use it in other situations, providing we have a way to
map values to integers. For instance, we can use the negative
predicate
on a person's bank balance to work out if they are currently overdrawn:
newtype Predicate a = Predicate { getPredicate :: a -> Bool } instance Contravariant Predicate where contramap f (Predicate p) = Predicate (p . f) | `- First, map the input... `----- then apply the predicate. overdrawn :: Predicate Person overdrawn = contramap personBankBalance negative
Any instance should be subject to the following laws:
contramap id = id contramap f . contramap g = contramap (g . f)
Note, that the second law follows from the free theorem of the type of
contramap
and the first law, so you need only check that the former
condition holds.
Instances
eitherDecodeFileStrict' :: FromJSON a => FilePath -> IO (Either String a) #
Like decodeFileStrict'
but returns an error message when decoding fails.
eitherDecodeStrict' :: FromJSON a => ByteString -> Either String a #
Like decodeStrict'
but returns an error message when decoding fails.
eitherDecode' :: FromJSON a => ByteString -> Either String a #
Like decode'
but returns an error message when decoding fails.
eitherDecodeFileStrict :: FromJSON a => FilePath -> IO (Either String a) #
Like decodeFileStrict
but returns an error message when decoding fails.
eitherDecodeStrict :: FromJSON a => ByteString -> Either String a #
Like decodeStrict
but returns an error message when decoding fails.
eitherDecode :: FromJSON a => ByteString -> Either String a #
Like decode
but returns an error message when decoding fails.
decodeFileStrict' :: FromJSON a => FilePath -> IO (Maybe a) #
Efficiently deserialize a JSON value from a file.
If this fails due to incomplete or invalid input, Nothing
is
returned.
The input file's content must consist solely of a JSON document, with no trailing data except for whitespace.
This function parses and performs conversion immediately. See
json'
for details.
decodeStrict' :: FromJSON a => ByteString -> Maybe a #
Efficiently deserialize a JSON value from a strict ByteString
.
If this fails due to incomplete or invalid input, Nothing
is
returned.
The input must consist solely of a JSON document, with no trailing data except for whitespace.
This function parses and performs conversion immediately. See
json'
for details.
decode' :: FromJSON a => ByteString -> Maybe a #
Efficiently deserialize a JSON value from a lazy ByteString
.
If this fails due to incomplete or invalid input, Nothing
is
returned.
The input must consist solely of a JSON document, with no trailing data except for whitespace.
This function parses and performs conversion immediately. See
json'
for details.
decodeFileStrict :: FromJSON a => FilePath -> IO (Maybe a) #
Efficiently deserialize a JSON value from a file.
If this fails due to incomplete or invalid input, Nothing
is
returned.
The input file's content must consist solely of a JSON document, with no trailing data except for whitespace.
This function parses immediately, but defers conversion. See
json
for details.
decodeStrict :: FromJSON a => ByteString -> Maybe a #
Efficiently deserialize a JSON value from a strict ByteString
.
If this fails due to incomplete or invalid input, Nothing
is
returned.
The input must consist solely of a JSON document, with no trailing data except for whitespace.
This function parses immediately, but defers conversion. See
json
for details.
decode :: FromJSON a => ByteString -> Maybe a #
Efficiently deserialize a JSON value from a lazy ByteString
.
If this fails due to incomplete or invalid input, Nothing
is
returned.
The input must consist solely of a JSON document, with no trailing data except for whitespace.
This function parses immediately, but defers conversion. See
json
for details.
encodeFile :: ToJSON a => FilePath -> a -> IO () #
Efficiently serialize a JSON value as a lazy ByteString
and write it to a file.
encode :: ToJSON a => a -> ByteString #
Efficiently serialize a JSON value as a lazy ByteString
.
This is implemented in terms of the ToJSON
class's toEncoding
method.
type GToEncoding = GToJSON Encoding #
toEncoding2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Encoding #
Lift the standard toEncoding
function through the type constructor.
toJSON2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Value #
Lift the standard toJSON
function through the type constructor.
toEncoding1 :: (ToJSON1 f, ToJSON a) => f a -> Encoding #
Lift the standard toEncoding
function through the type constructor.
toJSON1 :: (ToJSON1 f, ToJSON a) => f a -> Value #
Lift the standard toJSON
function through the type constructor.
genericToJSONKey :: (Generic a, GToJSONKey (Rep a)) => JSONKeyOptions -> ToJSONKeyFunction a #
genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f)) => Options -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding #
A configurable generic JSON encoder. This function applied to
defaultOptions
is used as the default for liftToEncoding
when the type
is an instance of Generic1
.
genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a)) => Options -> a -> Encoding #
A configurable generic JSON encoder. This function applied to
defaultOptions
is used as the default for toEncoding
when the type
is an instance of Generic
.
genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f)) => Options -> (a -> Value) -> ([a] -> Value) -> f a -> Value #
A configurable generic JSON creator. This function applied to
defaultOptions
is used as the default for liftToJSON
when the type
is an instance of Generic1
.
genericToJSON :: (Generic a, GToJSON Value Zero (Rep a)) => Options -> a -> Value #
A configurable generic JSON creator. This function applied to
defaultOptions
is used as the default for toJSON
when the type
is an instance of Generic
.
A type that can be converted to JSON.
Instances in general must specify toJSON
and should (but don't need
to) specify toEncoding
.
An example type and instance:
-- Allow ourselves to writeText
literals. {-# LANGUAGE OverloadedStrings #-} data Coord = Coord { x :: Double, y :: Double } instanceToJSON
Coord wheretoJSON
(Coord x y) =object
["x".=
x, "y".=
y]toEncoding
(Coord x y) =pairs
("x".=
x<>
"y".=
y)
Instead of manually writing your ToJSON
instance, there are two options
to do it automatically:
- Data.Aeson.TH provides Template Haskell functions which will derive an instance at compile time. The generated instance is optimized for your type so it will probably be more efficient than the following option.
- The compiler can provide a default generic implementation for
toJSON
.
To use the second, simply add a deriving
clause to your
datatype and declare a Generic
ToJSON
instance. If you require nothing other than
defaultOptions
, it is sufficient to write (and this is the only
alternative where the default toJSON
implementation is sufficient):
{-# LANGUAGE DeriveGeneric #-} import GHC.Generics data Coord = Coord { x :: Double, y :: Double } derivingGeneric
instanceToJSON
Coord wheretoEncoding
=genericToEncoding
defaultOptions
If on the other hand you wish to customize the generic decoding, you have to implement both methods:
customOptions =defaultOptions
{fieldLabelModifier
=map
toUpper
} instanceToJSON
Coord wheretoJSON
=genericToJSON
customOptionstoEncoding
=genericToEncoding
customOptions
Previous versions of this library only had the toJSON
method. Adding
toEncoding
had two reasons:
- toEncoding is more efficient for the common case that the output of
toJSON
is directly serialized to aByteString
. Further, expressing either method in terms of the other would be non-optimal. - The choice of defaults allows a smooth transition for existing users:
Existing instances that do not define
toEncoding
still compile and have the correct semantics. This is ensured by making the default implementation oftoEncoding
usetoJSON
. This produces correct results, but since it performs an intermediate conversion to aValue
, it will be less efficient than directly emitting anEncoding
. (this also means that specifying nothing more thaninstance ToJSON Coord
would be sufficient as a generically decoding instance, but there probably exists no good reason to not specifytoEncoding
in new instances.)
Nothing
Convert a Haskell value to a JSON-friendly intermediate type.
toEncoding :: a -> Encoding #
Encode a Haskell value as JSON.
The default implementation of this method creates an
intermediate Value
using toJSON
. This provides
source-level compatibility for people upgrading from older
versions of this library, but obviously offers no performance
advantage.
To benefit from direct encoding, you must provide an
implementation for this method. The easiest way to do so is by
having your types implement Generic
using the DeriveGeneric
extension, and then have GHC generate a method body as follows.
instanceToJSON
Coord wheretoEncoding
=genericToEncoding
defaultOptions
toJSONList :: [a] -> Value #
toEncodingList :: [a] -> Encoding #
Instances
A key-value pair for encoding a JSON object.
Typeclass for types that can be used as the key of a map-like container
(like Map
or HashMap
). For example, since Text
has a ToJSONKey
instance and Char
has a ToJSON
instance, we can encode a value of
type Map
Text
Char
:
>>>
LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
{"foo":"a"}
Since Int
also has a ToJSONKey
instance, we can similarly write:
>>>
LBC8.putStrLn $ encode $ Map.fromList [(5 :: Int, 'a')]
{"5":"a"}
JSON documents only accept strings as object keys. For any type
from base
that has a natural textual representation, it can be
expected that its ToJSONKey
instance will choose that representation.
For data types that lack a natural textual representation, an alternative is provided. The map-like container is represented as a JSON array instead of a JSON object. Each value in the array is an array with exactly two values. The first is the key and the second is the value.
For example, values of type '[Text]' cannot be encoded to a
string, so a Map
with keys of type '[Text]' is encoded as follows:
>>>
LBC8.putStrLn $ encode $ Map.fromList [(["foo","bar","baz" :: Text], 'a')]
[[["foo","bar","baz"],"a"]]
The default implementation of ToJSONKey
chooses this method of
encoding a key, using the ToJSON
instance of the type.
To use your own data type as the key in a map, all that is needed
is to write a ToJSONKey
(and possibly a FromJSONKey
) instance
for it. If the type cannot be trivially converted to and from Text
,
it is recommended that ToJSONKeyValue
is used. Since the default
implementations of the typeclass methods can build this from a
ToJSON
instance, there is nothing that needs to be written:
data Foo = Foo { fooAge :: Int, fooName :: Text } deriving (Eq,Ord,Generic) instance ToJSON Foo instance ToJSONKey Foo
That's it. We can now write:
>>>
let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
>>>
LBC8.putStrLn $ encode m
[[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
The next case to consider is if we have a type that is a
newtype wrapper around Text
. The recommended approach is to use
generalized newtype deriving:
newtype RecordId = RecordId { getRecordId :: Text } deriving (Eq,Ord,ToJSONKey)
Then we may write:
>>>
LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
{"abc":"a"}
Simple sum types are a final case worth considering. Suppose we have:
data Color = Red | Green | Blue deriving (Show,Read,Eq,Ord)
It is possible to get the ToJSONKey
instance for free as we did
with Foo
. However, in this case, we have a natural way to go to
and from Text
that does not require any escape sequences. So
ToJSONKeyText
can be used instead of ToJSONKeyValue
to encode maps
as objects instead of arrays of pairs. This instance may be
implemented using generics as follows:
instanceToJSONKey
Color wheretoJSONKey
=genericToJSONKey
defaultJSONKeyOptions
Low-level implementations
The Show
instance can be used to help write ToJSONKey
:
instance ToJSONKey Color where toJSONKey = ToJSONKeyText f g where f = Text.pack . show g = text . Text.pack . show -- text function is from Data.Aeson.Encoding
The situation of needing to turning function a -> Text
into
a ToJSONKeyFunction
is common enough that a special combinator
is provided for it. The above instance can be rewritten as:
instance ToJSONKey Color where toJSONKey = toJSONKeyText (Text.pack . show)
The performance of the above instance can be improved by
not using Value
as an intermediate step when converting to
Text
. One option for improving performance would be to use
template haskell machinery from the text-show
package. However,
even with the approach, the Encoding
(a wrapper around a bytestring
builder) is generated by encoding the Text
to a ByteString
,
an intermediate step that could be avoided. The fastest possible
implementation would be:
-- Assuming that OverloadedStrings is enabled instance ToJSONKey Color where toJSONKey = ToJSONKeyText f g where f x = case x of {Red -> "Red";Green ->"Green";Blue -> "Blue"} g x = case x of {Red -> text "Red";Green -> text "Green";Blue -> text "Blue"} -- text function is from Data.Aeson.Encoding
This works because GHC can lift the encoded values out of the case statements, which means that they are only evaluated once. This approach should only be used when there is a serious need to maximize performance.
Nothing
toJSONKey :: ToJSONKeyFunction a #
Strategy for rendering the key for a map-like container.
toJSONKeyList :: ToJSONKeyFunction [a] #
Instances
data ToJSONKeyFunction a #
ToJSONKeyText !(a -> Text) !(a -> Encoding' Text) | key is encoded to string, produces object |
ToJSONKeyValue !(a -> Value) !(a -> Encoding) | key is encoded to value, produces array |
Instances
Contravariant ToJSONKeyFunction | |
Defined in Data.Aeson.Types.ToJSON contramap :: (a -> b) -> ToJSONKeyFunction b -> ToJSONKeyFunction a # (>$) :: b -> ToJSONKeyFunction b -> ToJSONKeyFunction a # |
class GetConName f => GToJSONKey (f :: k -> Type) #
Instances
GetConName f => GToJSONKey (f :: k -> Type) | |
Defined in Data.Aeson.Types.ToJSON |
class ToJSON1 (f :: Type -> Type) where #
Lifting of the ToJSON
class to unary type constructors.
Instead of manually writing your ToJSON1
instance, there are two options
to do it automatically:
- Data.Aeson.TH provides Template Haskell functions which will derive an instance at compile time. The generated instance is optimized for your type so it will probably be more efficient than the following option.
- The compiler can provide a default generic implementation for
toJSON1
.
To use the second, simply add a deriving
clause to your
datatype and declare a Generic1
ToJSON1
instance for your datatype without giving
definitions for liftToJSON
or liftToEncoding
.
For example:
{-# LANGUAGE DeriveGeneric #-} import GHC.Generics data Pair = Pair { pairFst :: a, pairSnd :: b } derivingGeneric1
instanceToJSON
a =>ToJSON1
(Pair a)
If the default implementation doesn't give exactly the results you want,
you can customize the generic encoding with only a tiny amount of
effort, using genericLiftToJSON
and genericLiftToEncoding
with
your preferred Options
:
customOptions =defaultOptions
{fieldLabelModifier
=map
toUpper
} instanceToJSON
a =>ToJSON1
(Pair a) whereliftToJSON
=genericLiftToJSON
customOptionsliftToEncoding
=genericLiftToEncoding
customOptions
See also ToJSON
.
Nothing
liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value #
liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [f a] -> Value #
liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding #
liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding #
Instances
ToJSON1 [] | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> [a] -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [[a]] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> [a] -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [[a]] -> Encoding # | |
ToJSON1 Maybe | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> Maybe a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [Maybe a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> Maybe a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [Maybe a] -> Encoding # | |
ToJSON1 Set | |
Defined in Data.Aeson.Types.ToJSON | |
ToJSON1 Identity | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> Identity a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [Identity a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> Identity a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [Identity a] -> Encoding # | |
ToJSON1 Min | |
Defined in Data.Aeson.Types.ToJSON | |
ToJSON1 Max | |
Defined in Data.Aeson.Types.ToJSON | |
ToJSON1 First | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> First a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [First a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> First a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [First a] -> Encoding # | |
ToJSON1 Last | |
Defined in Data.Aeson.Types.ToJSON | |
ToJSON1 WrappedMonoid | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> WrappedMonoid a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [WrappedMonoid a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> WrappedMonoid a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [WrappedMonoid a] -> Encoding # | |
ToJSON1 Option | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> Option a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [Option a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> Option a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [Option a] -> Encoding # | |
ToJSON1 First | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> First a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [First a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> First a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [First a] -> Encoding # | |
ToJSON1 Last | |
Defined in Data.Aeson.Types.ToJSON | |
ToJSON1 Dual | |
Defined in Data.Aeson.Types.ToJSON | |
ToJSON1 NonEmpty | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> NonEmpty a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [NonEmpty a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> NonEmpty a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [NonEmpty a] -> Encoding # | |
ToJSON1 IntMap | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> IntMap a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [IntMap a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> IntMap a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [IntMap a] -> Encoding # | |
ToJSON1 Tree | |
Defined in Data.Aeson.Types.ToJSON | |
ToJSON1 Seq | |
Defined in Data.Aeson.Types.ToJSON | |
ToJSON1 DList | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> DList a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [DList a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> DList a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [DList a] -> Encoding # | |
ToJSON1 HashSet | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> HashSet a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [HashSet a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> HashSet a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [HashSet a] -> Encoding # | |
ToJSON1 Vector | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> Vector a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [Vector a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> Vector a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [Vector a] -> Encoding # | |
ToJSON a => ToJSON1 (Either a) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> Either a a0 -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [Either a a0] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> Either a a0 -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [Either a a0] -> Encoding # | |
ToJSON a => ToJSON1 ((,) a) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, a0)] -> Encoding # | |
ToJSONKey k => ToJSON1 (Map k) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> Map k a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [Map k a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> Map k a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [Map k a] -> Encoding # | |
ToJSONKey k => ToJSON1 (HashMap k) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> HashMap k a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [HashMap k a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> HashMap k a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [HashMap k a] -> Encoding # | |
ToJSON1 (Proxy :: Type -> Type) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> Proxy a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [Proxy a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> Proxy a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [Proxy a] -> Encoding # | |
(ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, a0)] -> Encoding # | |
ToJSON a => ToJSON1 (Const a :: Type -> Type) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> Const a a0 -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [Const a a0] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> Const a a0 -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [Const a a0] -> Encoding # | |
ToJSON1 (Tagged a) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> Tagged a a0 -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [Tagged a a0] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> Tagged a a0 -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [Tagged a a0] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, a0)] -> Encoding # | |
(ToJSON1 f, ToJSON1 g) => ToJSON1 (Product f g) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> Product f g a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [Product f g a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> Product f g a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [Product f g a] -> Encoding # | |
(ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> Sum f g a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [Sum f g a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> Sum f g a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [Sum f g a] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, a0)] -> Encoding # | |
(ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a -> Value) -> ([a] -> Value) -> Compose f g a -> Value # liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [Compose f g a] -> Value # liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> Compose f g a -> Encoding # liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [Compose f g a] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, a0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, f, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, f, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, f, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, f, a0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, f, g, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, f, g, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, f, g, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, f, g, a0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, f, g, h, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, f, g, h, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, f, g, h, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, f, g, h, a0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, f, g, h, i, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, f, g, h, i, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, a0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, f, g, h, i, j, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, f, g, h, i, j, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, j, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, j, a0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, f, g, h, i, j, k, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, f, g, h, i, j, k, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, j, k, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, j, k, a0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, f, g, h, i, j, k, l, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, f, g, h, i, j, k, l, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, j, k, l, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, j, k, l, a0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, f, g, h, i, j, k, l, m, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, j, k, l, m, a0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON :: (a0 -> Value) -> ([a0] -> Value) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, a0) -> Value # liftToJSONList :: (a0 -> Value) -> ([a0] -> Value) -> [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, a0)] -> Value # liftToEncoding :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, a0) -> Encoding # liftToEncodingList :: (a0 -> Encoding) -> ([a0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, a0)] -> Encoding # |
class ToJSON2 (f :: Type -> Type -> Type) where #
Lifting of the ToJSON
class to binary type constructors.
Instead of manually writing your ToJSON2
instance, Data.Aeson.TH
provides Template Haskell functions which will derive an instance at compile time.
The compiler cannot provide a default generic implementation for liftToJSON2
,
unlike toJSON
and liftToJSON
.
liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> f a b -> Value #
liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [f a b] -> Value #
liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> f a b -> Encoding #
liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [f a b] -> Encoding #
Instances
ToJSON2 Either | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> Either a b -> Value # liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [Either a b] -> Value # liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> Either a b -> Encoding # liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [Either a b] -> Encoding # | |
ToJSON2 (,) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> (a, b) -> Value # liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [(a, b)] -> Value # liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> (a, b) -> Encoding # liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [(a, b)] -> Encoding # | |
ToJSON a => ToJSON2 ((,,) a) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b -> Value) -> ([b] -> Value) -> (a, a0, b) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b -> Value) -> ([b] -> Value) -> [(a, a0, b)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> (a, a0, b) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [(a, a0, b)] -> Encoding # | |
ToJSON2 (Const :: Type -> Type -> Type) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> Const a b -> Value # liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [Const a b] -> Value # liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> Const a b -> Encoding # liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [Const a b] -> Encoding # | |
ToJSON2 (Tagged :: Type -> Type -> Type) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> Tagged a b -> Value # liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [Tagged a b] -> Value # liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> Tagged a b -> Encoding # liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [Tagged a b] -> Encoding # | |
(ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,) a b c d e) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, e, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, e, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, e, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, e, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2 ((,,,,,,,) a b c d e f) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, e, f, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, e, f, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, e, f, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, e, f, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON2 ((,,,,,,,,) a b c d e f g) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, e, f, g, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, e, f, g, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, e, f, g, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, e, f, g, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON2 ((,,,,,,,,,) a b c d e f g h) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, e, f, g, h, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, e, f, g, h, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, e, f, g, h, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, e, f, g, h, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON2 ((,,,,,,,,,,) a b c d e f g h i) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, e, f, g, h, i, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, e, f, g, h, i, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON2 ((,,,,,,,,,,,) a b c d e f g h i j) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, e, f, g, h, i, j, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, e, f, g, h, i, j, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, j, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, j, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON2 ((,,,,,,,,,,,,) a b c d e f g h i j k) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, e, f, g, h, i, j, k, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, e, f, g, h, i, j, k, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, j, k, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, j, k, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON2 ((,,,,,,,,,,,,,) a b c d e f g h i j k l) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, e, f, g, h, i, j, k, l, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, e, f, g, h, i, j, k, l, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, j, k, l, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, j, k, l, a0, b0)] -> Encoding # | |
(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON2 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m) | |
Defined in Data.Aeson.Types.ToJSON liftToJSON2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a0, b0) -> Value # liftToJSONList2 :: (a0 -> Value) -> ([a0] -> Value) -> (b0 -> Value) -> ([b0] -> Value) -> [(a, b, c, d, e, f, g, h, i, j, k, l, m, a0, b0)] -> Value # liftToEncoding2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a0, b0) -> Encoding # liftToEncodingList2 :: (a0 -> Encoding) -> ([a0] -> Encoding) -> (b0 -> Encoding) -> ([b0] -> Encoding) -> [(a, b, c, d, e, f, g, h, i, j, k, l, m, a0, b0)] -> Encoding # |
fromEncoding :: Encoding' tag -> Builder #
Acquire the underlying bytestring builder.
A series of values that, when encoded, should be separated by
commas. Since 0.11.0.0, the .=
operator is overloaded to create
either (Text, Value)
or Series
. You can use Series when
encoding directly to a bytestring builder as in the following
example:
toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)
(.!=) :: Parser (Maybe a) -> a -> Parser a #
Helper for use in combination with .:?
to provide default
values for optional JSON object fields.
This combinator is most useful if the key and value can be absent
from an object without affecting its validity and we know a default
value to assign in that case. If the key and value are mandatory,
use .:
instead.
Example usage:
v1 <- o.:?
"opt_field_with_dfl" .!= "default_val" v2 <- o.:
"mandatory_field" v3 <- o.:?
"opt_field2"
(.:?) :: FromJSON a => Object -> Text -> Parser (Maybe a) #
Retrieve the value associated with the given key of an Object
. The
result is Nothing
if the key is not present or if its value is Null
,
or empty
if the value cannot be converted to the desired type.
This accessor is most useful if the key and value can be absent
from an object without affecting its validity. If the key and
value are mandatory, use .:
instead.
(.:) :: FromJSON a => Object -> Text -> Parser a #
Retrieve the value associated with the given key of an Object
.
The result is empty
if the key is not present or the value cannot
be converted to the desired type.
This accessor is appropriate if the key and value must be present
in an object for it to be valid. If the key and value are
optional, use .:?
instead.
fromJSON :: FromJSON a => Value -> Result a #
Convert a value from JSON, failing if the types do not match.
withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a #
Decode a nested JSON-encoded string.
withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a #
applies withScientific
name f valuef
to the Scientific
number
when value
is a Number
and fails using typeMismatch
otherwise.
Warning: If you are converting from a scientific to an unbounded
type such as Integer
you may want to add a restriction on the
size of the exponent (see withBoundedScientific
) to prevent
malicious input from filling up the memory of the target system.
Error message example
withScientific "MyType" f (String "oops") -- Error: "parsing MyType failed, expected Number, but encountered String"
withObject :: String -> (Object -> Parser a) -> Value -> Parser a #
applies withObject
name f valuef
to the Object
when value
is an Object
and fails otherwise.
Error message example
withObject "MyType" f (String "oops") -- Error: "parsing MyType failed, expected Object, but encountered String"
parseJSON2 :: (FromJSON2 f, FromJSON a, FromJSON b) => Value -> Parser (f a b) #
Lift the standard parseJSON
function through the type constructor.
parseJSON1 :: (FromJSON1 f, FromJSON a) => Value -> Parser (f a) #
Lift the standard parseJSON
function through the type constructor.
genericFromJSONKey :: (Generic a, GFromJSONKey (Rep a)) => JSONKeyOptions -> FromJSONKeyFunction a #
fromJSONKey
for Generic
types.
These types must be sums of nullary constructors, whose names will be used
as keys for JSON objects.
See also genericToJSONKey
.
Example
data Color = Red | Green | Blue derivingGeneric
instanceFromJSONKey
Color wherefromJSONKey
=genericFromJSONKey
defaultJSONKeyOptions
genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f)) => Options -> (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a) #
A configurable generic JSON decoder. This function applied to
defaultOptions
is used as the default for liftParseJSON
when the
type is an instance of Generic1
.
genericParseJSON :: (Generic a, GFromJSON Zero (Rep a)) => Options -> Value -> Parser a #
A configurable generic JSON decoder. This function applied to
defaultOptions
is used as the default for parseJSON
when the
type is an instance of Generic
.
class GFromJSON arity (f :: Type -> Type) where #
Class of generic representation types that can be converted from JSON.
gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (f a) #
This method (applied to defaultOptions
) is used as the
default generic implementation of parseJSON
(if the arity
is Zero
)
or liftParseJSON
(if the arity
is One
).
Instances
GFromJSON One Par1 | |
Defined in Data.Aeson.Types.FromJSON | |
GFromJSON arity (V1 :: Type -> Type) | |
Defined in Data.Aeson.Types.FromJSON | |
FromJSON1 f => GFromJSON One (Rec1 f) | |
Defined in Data.Aeson.Types.FromJSON | |
(GFromJSON' arity a, Datatype d) => GFromJSON arity (D1 d a) | |
Defined in Data.Aeson.Types.FromJSON | |
FromJSON a => GFromJSON arity (K1 i a :: Type -> Type) | |
Defined in Data.Aeson.Types.FromJSON | |
GFromJSON arity a => GFromJSON arity (M1 i c a) | |
Defined in Data.Aeson.Types.FromJSON | |
(FromJSON1 f, GFromJSON One g) => GFromJSON One (f :.: g) | |
Defined in Data.Aeson.Types.FromJSON |
A type that can be converted from JSON, with the possibility of failure.
In many cases, you can get the compiler to generate parsing code for you (see below). To begin, let's cover writing an instance by hand.
There are various reasons a conversion could fail. For example, an
Object
could be missing a required key, an Array
could be of
the wrong size, or a value could be of an incompatible type.
The basic ways to signal a failed conversion are as follows:
fail
yields a custom error message: it is the recommended way of reporting a failure;empty
(ormzero
) is uninformative: use it when the error is meant to be caught by some(
;<|>
)typeMismatch
can be used to report a failure when the encountered value is not of the expected JSON type;unexpected
is an appropriate alternative when more than one type may be expected, or to keep the expected type implicit.
prependFailure
(or modifyFailure
) add more information to a parser's
error messages.
An example type and instance using typeMismatch
and prependFailure
:
-- Allow ourselves to writeText
literals. {-# LANGUAGE OverloadedStrings #-} data Coord = Coord { x :: Double, y :: Double } instanceFromJSON
Coord whereparseJSON
(Object
v) = Coord<$>
v.:
"x"<*>
v.:
"y" -- We do not expect a non-Object
value here. -- We could useempty
to fail, buttypeMismatch
-- gives a much more informative error message.parseJSON
invalid =prependFailure
"parsing Coord failed, " (typeMismatch
"Object" invalid)
For this common case of only being concerned with a single
type of JSON value, the functions withObject
, withScientific
, etc.
are provided. Their use is to be preferred when possible, since
they are more terse. Using withObject
, we can rewrite the above instance
(assuming the same language extension and data type) as:
instanceFromJSON
Coord whereparseJSON
=withObject
"Coord" $ \v -> Coord<$>
v.:
"x"<*>
v.:
"y"
Instead of manually writing your FromJSON
instance, there are two options
to do it automatically:
- Data.Aeson.TH provides Template Haskell functions which will derive an instance at compile time. The generated instance is optimized for your type so it will probably be more efficient than the following option.
- The compiler can provide a default generic implementation for
parseJSON
.
To use the second, simply add a deriving
clause to your
datatype and declare a Generic
FromJSON
instance for your datatype without giving
a definition for parseJSON
.
For example, the previous example can be simplified to just:
{-# LANGUAGE DeriveGeneric #-} import GHC.Generics data Coord = Coord { x :: Double, y :: Double } derivingGeneric
instanceFromJSON
Coord
The default implementation will be equivalent to
parseJSON =
; if you need different
options, you can customize the generic decoding by defining:genericParseJSON
defaultOptions
customOptions =defaultOptions
{fieldLabelModifier
=map
toUpper
} instanceFromJSON
Coord whereparseJSON
=genericParseJSON
customOptions
Nothing
Instances
class FromJSONKey a where #
Read the docs for ToJSONKey
first. This class is a conversion
in the opposite direction. If you have a newtype wrapper around Text
,
the recommended way to define instances is with generalized newtype deriving:
newtype SomeId = SomeId { getSomeId :: Text } deriving (Eq,Ord,Hashable,FromJSONKey)
If you have a sum of nullary constructors, you may use the generic implementation:
data Color = Red | Green | Blue deriving Generic instanceFromJSONKey
Color wherefromJSONKey
=genericFromJSONKey
defaultJSONKeyOptions
Nothing
fromJSONKey :: FromJSONKeyFunction a #
Strategy for parsing the key of a map-like container.
fromJSONKeyList :: FromJSONKeyFunction [a] #
Instances
data FromJSONKeyFunction a #
This type is related to ToJSONKeyFunction
. If FromJSONKeyValue
is used in the
FromJSONKey
instance, then ToJSONKeyValue
should be used in the ToJSONKey
instance. The other three data constructors for this type all correspond to
ToJSONKeyText
. Strictly speaking, FromJSONKeyTextParser
is more powerful than
FromJSONKeyText
, which is in turn more powerful than FromJSONKeyCoerce
.
For performance reasons, these exist as three options instead of one.
FromJSONKeyCoerce !(CoerceText a) | uses |
FromJSONKeyText !(Text -> a) | conversion from |
FromJSONKeyTextParser !(Text -> Parser a) | conversion from |
FromJSONKeyValue !(Value -> Parser a) | conversion for non-textual keys |
Instances
Functor FromJSONKeyFunction | Only law abiding up to interpretation |
Defined in Data.Aeson.Types.FromJSON fmap :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b # (<$) :: a -> FromJSONKeyFunction b -> FromJSONKeyFunction a # |
class (ConstructorNames f, SumFromString f) => GFromJSONKey (f :: Type -> Type) #
Instances
(ConstructorNames f, SumFromString f) => GFromJSONKey f | |
Defined in Data.Aeson.Types.FromJSON |
class FromJSON1 (f :: Type -> Type) where #
Lifting of the FromJSON
class to unary type constructors.
Instead of manually writing your FromJSON1
instance, there are two options
to do it automatically:
- Data.Aeson.TH provides Template Haskell functions which will derive an instance at compile time. The generated instance is optimized for your type so it will probably be more efficient than the following option.
- The compiler can provide a default generic implementation for
liftParseJSON
.
To use the second, simply add a deriving
clause to your
datatype and declare a Generic1
FromJSON1
instance for your datatype without giving
a definition for liftParseJSON
.
For example:
{-# LANGUAGE DeriveGeneric #-} import GHC.Generics data Pair a b = Pair { pairFst :: a, pairSnd :: b } derivingGeneric1
instanceFromJSON
a =>FromJSON1
(Pair a)
If the default implementation doesn't give exactly the results you want,
you can customize the generic decoding with only a tiny amount of
effort, using genericLiftParseJSON
with your preferred Options
:
customOptions =defaultOptions
{fieldLabelModifier
=map
toUpper
} instanceFromJSON
a =>FromJSON1
(Pair a) whereliftParseJSON
=genericLiftParseJSON
customOptions
Nothing
liftParseJSON :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a) #
liftParseJSONList :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser [f a] #
Instances
class FromJSON2 (f :: Type -> Type -> Type) where #
Lifting of the FromJSON
class to binary type constructors.
Instead of manually writing your FromJSON2
instance, Data.Aeson.TH
provides Template Haskell functions which will derive an instance at compile time.
liftParseJSON2 :: (Value -> Parser a) -> (Value -> Parser [a]) -> (Value -> Parser b) -> (Value -> Parser [b]) -> Value -> Parser (f a b) #
liftParseJSONList2 :: (Value -> Parser a) -> (Value -> Parser [a]) -> (Value -> Parser b) -> (Value -> Parser [b]) -> Value -> Parser [f a b] #
Instances
FromJSON2 Either | |
Defined in Data.Aeson.Types.FromJSON | |
FromJSON2 (,) | |
Defined in Data.Aeson.Types.FromJSON | |
FromJSON a => FromJSON2 ((,,) a) | |
Defined in Data.Aeson.Types.FromJSON | |
FromJSON2 (Const :: Type -> Type -> Type) | |
Defined in Data.Aeson.Types.FromJSON | |
FromJSON2 (Tagged :: Type -> Type -> Type) | |
Defined in Data.Aeson.Types.FromJSON | |
(FromJSON a, FromJSON b) => FromJSON2 ((,,,) a b) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c) => FromJSON2 ((,,,,) a b c) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON2 ((,,,,,) a b c d) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON2 ((,,,,,,) a b c d e) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, e, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, e, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON2 ((,,,,,,,) a b c d e f) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, e, f, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, e, f, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON2 ((,,,,,,,,) a b c d e f g) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, e, f, g, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, e, f, g, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON2 ((,,,,,,,,,) a b c d e f g h) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, e, f, g, h, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, e, f, g, h, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON2 ((,,,,,,,,,,) a b c d e f g h i) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, e, f, g, h, i, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, e, f, g, h, i, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON2 ((,,,,,,,,,,,) a b c d e f g h i j) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, e, f, g, h, i, j, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, e, f, g, h, i, j, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON2 ((,,,,,,,,,,,,) a b c d e f g h i j k) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, e, f, g, h, i, j, k, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON2 ((,,,,,,,,,,,,,) a b c d e f g h i j k l) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, e, f, g, h, i, j, k, l, a0, b0)] # | |
(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON2 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m) | |
Defined in Data.Aeson.Types.FromJSON liftParseJSON2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a0, b0) # liftParseJSONList2 :: (Value -> Parser a0) -> (Value -> Parser [a0]) -> (Value -> Parser b0) -> (Value -> Parser [b0]) -> Value -> Parser [(a, b, c, d, e, f, g, h, i, j, k, l, m, a0, b0)] # |
Parse any JSON value.
This is a strict version of json
which avoids building up thunks
during parsing; it performs all conversions immediately. Prefer
this version if most of the JSON data needs to be accessed.
This function is an alias for value'
. In aeson 0.8 and earlier, it
parsed only object or array types, in conformance with the
now-obsolete RFC 4627.
Warning
If an object contains duplicate keys, only the first one will be kept.
For a more flexible alternative, see jsonWith'
.
Parse any JSON value.
The conversion of a parsed value to a Haskell value is deferred until the Haskell value is needed. This may improve performance if only a subset of the results of conversions are needed, but at a cost in thunk allocation.
This function is an alias for value
. In aeson 0.8 and earlier, it
parsed only object or array types, in conformance with the
now-obsolete RFC 4627.
Warning
If an object contains duplicate keys, only the first one will be kept.
For a more flexible alternative, see jsonWith
.
camelTo2 :: Char -> String -> String #
Better version of camelTo
. Example where it works better:
camelTo '_' 'CamelAPICase' == "camel_apicase" camelTo2 '_' 'CamelAPICase' == "camel_api_case"
defaultJSONKeyOptions :: JSONKeyOptions #
Default JSONKeyOptions
:
defaultJSONKeyOptions =JSONKeyOptions
{keyModifier
=id
}
defaultTaggedObject :: SumEncoding #
Default TaggedObject
SumEncoding
options:
defaultTaggedObject =TaggedObject
{tagFieldName
= "tag" ,contentsFieldName
= "contents" }
Default encoding Options
:
Options
{fieldLabelModifier
= id ,constructorTagModifier
= id ,allNullaryToStringTag
= True ,omitNothingFields
= False ,sumEncoding
=defaultTaggedObject
,unwrapUnaryRecords
= False ,tagSingleConstructors
= False }
(<?>) :: Parser a -> JSONPathElement -> Parser a #
Add JSON Path context to a parser
When parsing a complex structure, it helps to annotate (sub)parsers with context, so that if an error occurs, you can find its location.
withObject "Person" $ \o -> Person <$> o .: "name" <?> Key "name" <*> o .: "age" <?> Key "age"
(Standard methods like '(.:)' already do this.)
With such annotations, if an error occurs, you will get a JSON Path location of that error.
Since 0.10
type JSONPath = [JSONPathElement] #
The result of running a Parser
.
Instances
Monad Result | |
Functor Result | |
MonadFail Result | |
Defined in Data.Aeson.Types.Internal | |
Applicative Result | |
Foldable Result | |
Defined in Data.Aeson.Types.Internal fold :: Monoid m => Result m -> m # foldMap :: Monoid m => (a -> m) -> Result a -> m # foldr :: (a -> b -> b) -> b -> Result a -> b # foldr' :: (a -> b -> b) -> b -> Result a -> b # foldl :: (b -> a -> b) -> b -> Result a -> b # foldl' :: (b -> a -> b) -> b -> Result a -> b # foldr1 :: (a -> a -> a) -> Result a -> a # foldl1 :: (a -> a -> a) -> Result a -> a # elem :: Eq a => a -> Result a -> Bool # maximum :: Ord a => Result a -> a # minimum :: Ord a => Result a -> a # | |
Traversable Result | |
MonadPlus Result | |
Alternative Result | |
Eq a => Eq (Result a) | |
Show a => Show (Result a) | |
Semigroup (Result a) | |
Monoid (Result a) | |
NFData a => NFData (Result a) | |
Defined in Data.Aeson.Types.Internal |
A JSON value represented as a Haskell value.
Instances
Eq Value | |
Data Value | |
Defined in Data.Aeson.Types.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Value -> c Value # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Value # dataTypeOf :: Value -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Value) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value) # gmapT :: (forall b. Data b => b -> b) -> Value -> Value # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r # gmapQ :: (forall d. Data d => d -> u) -> Value -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Value -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Value -> m Value # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Value -> m Value # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Value -> m Value # | |
Read Value | |
Show Value | |
IsString Value | |
Defined in Data.Aeson.Types.Internal fromString :: String -> Value # | |
Generic Value | |
Lift Value | |
Hashable Value | |
Defined in Data.Aeson.Types.Internal | |
ToJSON Value | |
Defined in Data.Aeson.Types.ToJSON | |
KeyValue Object | Constructs a singleton |
KeyValue Pair | |
FromJSON Value | |
NFData Value | |
Defined in Data.Aeson.Types.Internal | |
AsNumber Value | |
AsPrimitive Value | |
AsValue Value | |
AsJSON Value | |
ToMustache Value | |
Defined in Text.Mustache.Internal.Types toMustache :: Value -> Value0 # listToMustache :: [Value] -> Value0 | |
FromString Encoding | |
Defined in Data.Aeson.Types.ToJSON fromString :: String -> Encoding | |
FromString Value | |
Defined in Data.Aeson.Types.ToJSON fromString :: String -> Value | |
GToJSON Encoding arity (U1 :: Type -> Type) | |
GToJSON Value arity (V1 :: Type -> Type) | |
GToJSON Value arity (U1 :: Type -> Type) | |
ToJSON1 f => GToJSON Encoding One (Rec1 f) | |
ToJSON1 f => GToJSON Value One (Rec1 f) | |
ToJSON a => GToJSON Encoding arity (K1 i a :: Type -> Type) | |
(EncodeProduct arity a, EncodeProduct arity b) => GToJSON Encoding arity (a :*: b) | |
ToJSON a => GToJSON Value arity (K1 i a :: Type -> Type) | |
(WriteProduct arity a, WriteProduct arity b, ProductSize a, ProductSize b) => GToJSON Value arity (a :*: b) | |
(ToJSON1 f, GToJSON Encoding One g) => GToJSON Encoding One (f :.: g) | |
(ToJSON1 f, GToJSON Value One g) => GToJSON Value One (f :.: g) | |
FromPairs Value (DList Pair) | |
Defined in Data.Aeson.Types.ToJSON | |
v ~ Value => KeyValuePair v (DList Pair) | |
Defined in Data.Aeson.Types.ToJSON | |
(GToJSON Encoding arity a, ConsToJSON Encoding arity a, Constructor c) => SumToJSON' TwoElemArray Encoding arity (C1 c a) | |
Defined in Data.Aeson.Types.ToJSON | |
(GToJSON Value arity a, ConsToJSON Value arity a, Constructor c) => SumToJSON' TwoElemArray Value arity (C1 c a) | |
Defined in Data.Aeson.Types.ToJSON | |
type Rep Value | |
Defined in Data.Aeson.Types.Internal type Rep Value = D1 (MetaData "Value" "Data.Aeson.Types.Internal" "aeson-1.4.6.0-1XnxcetEtfUG8O3EDchcas" False) ((C1 (MetaCons "Object" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Object)) :+: (C1 (MetaCons "Array" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Array)) :+: C1 (MetaCons "String" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Text)))) :+: (C1 (MetaCons "Number" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Scientific)) :+: (C1 (MetaCons "Bool" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Bool)) :+: C1 (MetaCons "Null" PrefixI False) (U1 :: Type -> Type)))) | |
type Index Value | |
Defined in Data.Aeson.Lens | |
type IxValue Value | |
Defined in Data.Aeson.Lens |
newtype DotNetTime #
A newtype wrapper for UTCTime
that uses the same non-standard
serialization format as Microsoft .NET, whose
System.DateTime
type is by default serialized to JSON as in the following example:
/Date(1302547608878)/
The number represents milliseconds since the Unix epoch.
DotNetTime | |
|
Instances
Options that specify how to encode/decode your datatype to/from JSON.
Options can be set using record syntax on defaultOptions
with the fields
below.
data SumEncoding #
Specifies how to encode constructors of a sum datatype.
TaggedObject | A constructor will be encoded to an object with a field
|
UntaggedValue | Constructor names won't be encoded. Instead only the contents of the constructor will be encoded as if the type had a single constructor. JSON encodings have to be disjoint for decoding to work properly. When decoding, constructors are tried in the order of definition. If some encodings overlap, the first one defined will succeed. Note: Nullary constructors are encoded as strings (using
Note: Only the last error is kept when decoding, so in the case of malformed JSON, only an error for the last constructor will be reported. |
ObjectWithSingleField | A constructor will be encoded to an object with a single
field named after the constructor tag (modified by the
|
TwoElemArray | A constructor will be encoded to a 2-element array where the
first element is the tag of the constructor (modified by the
|
Instances
Eq SumEncoding | |
Defined in Data.Aeson.Types.Internal (==) :: SumEncoding -> SumEncoding -> Bool # (/=) :: SumEncoding -> SumEncoding -> Bool # | |
Show SumEncoding | |
Defined in Data.Aeson.Types.Internal showsPrec :: Int -> SumEncoding -> ShowS # show :: SumEncoding -> String # showList :: [SumEncoding] -> ShowS # |
data JSONKeyOptions #
Options for encoding keys with genericFromJSONKey
and
genericToJSONKey
.
A type-level indicator that ToJSON1
or FromJSON1
is being derived generically.
Instances
GFromJSON One Par1 | |
Defined in Data.Aeson.Types.FromJSON | |
GToJSON enc One Par1 | |
ToJSON1 f => GToJSON Encoding One (Rec1 f) | |
ToJSON1 f => GToJSON Value One (Rec1 f) | |
(ToJSON1 f, GToJSON Encoding One g) => GToJSON Encoding One (f :.: g) | |
(ToJSON1 f, GToJSON Value One g) => GToJSON Value One (f :.: g) | |
FromJSON1 f => GFromJSON One (Rec1 f) | |
Defined in Data.Aeson.Types.FromJSON | |
(FromJSON1 f, GFromJSON One g) => GFromJSON One (f :.: g) | |
Defined in Data.Aeson.Types.FromJSON |
class Bifunctor (p :: Type -> Type -> Type) where #
A bifunctor is a type constructor that takes
two type arguments and is a functor in both arguments. That
is, unlike with Functor
, a type constructor such as Either
does not need to be partially applied for a Bifunctor
instance, and the methods in this class permit mapping
functions over the Left
value or the Right
value,
or both at the same time.
Formally, the class Bifunctor
represents a bifunctor
from Hask
-> Hask
.
Intuitively it is a bifunctor where both the first and second arguments are covariant.
You can define a Bifunctor
by either defining bimap
or by
defining both first
and second
.
If you supply bimap
, you should ensure that:
bimap
id
id
≡id
If you supply first
and second
, ensure:
first
id
≡id
second
id
≡id
If you supply both, you should also ensure:
bimap
f g ≡first
f.
second
g
These ensure by parametricity:
bimap
(f.
g) (h.
i) ≡bimap
f h.
bimap
g ifirst
(f.
g) ≡first
f.
first
gsecond
(f.
g) ≡second
f.
second
g
Since: base-4.8.0.0
Instances
data (a :: k) :~: (b :: k) :: forall k. k -> k -> Type where infix 4 #
Propositional equality. If a :~: b
is inhabited by some terminating
value, then the type a
is the same as the type b
. To use this equality
in practice, pattern-match on the a :~: b
to get out the Refl
constructor;
in the body of the pattern-match, the compiler knows that a ~ b
.
Since: base-4.7.0.0
Instances
TestEquality ((:~:) a :: k -> Type) | Since: base-4.7.0.0 |
Defined in Data.Type.Equality | |
a ~ b => Bounded (a :~: b) | Since: base-4.7.0.0 |
a ~ b => Enum (a :~: b) | Since: base-4.7.0.0 |
Defined in Data.Type.Equality | |
Eq (a :~: b) | Since: base-4.7.0.0 |
Ord (a :~: b) | Since: base-4.7.0.0 |
Defined in Data.Type.Equality | |
a ~ b => Read (a :~: b) | Since: base-4.7.0.0 |
Show (a :~: b) | Since: base-4.7.0.0 |
(</>) :: FilePath -> FilePath -> FilePath infixr 5 #
Combine two paths with a path separator.
If the second path starts with a path separator or a drive letter, then it returns the second.
The intention is that readFile (dir
will access the same file as
</>
file)setCurrentDirectory dir; readFile file
.
Posix: "/directory" </> "file.ext" == "/directory/file.ext" Windows: "/directory" </> "file.ext" == "/directory\\file.ext" "directory" </> "/file.ext" == "/file.ext" Valid x => (takeDirectory x </> takeFileName x) `equalFilePath` x
Combined:
Posix: "/" </> "test" == "/test" Posix: "home" </> "bob" == "home/bob" Posix: "x:" </> "foo" == "x:/foo" Windows: "C:\\foo" </> "bar" == "C:\\foo\\bar" Windows: "home" </> "bob" == "home\\bob"
Not combined:
Posix: "home" </> "/bob" == "/bob" Windows: "home" </> "C:\\bob" == "C:\\bob"
Not combined (tricky):
On Windows, if a filepath starts with a single slash, it is relative to the
root of the current drive. In [1], this is (confusingly) referred to as an
absolute path.
The current behavior of </>
is to never combine these forms.
Windows: "home" </> "/bob" == "/bob" Windows: "home" </> "\\bob" == "\\bob" Windows: "C:\\home" </> "\\bob" == "\\bob"
On Windows, from [1]: "If a file name begins with only a disk designator
but not the backslash after the colon, it is interpreted as a relative path
to the current directory on the drive with the specified letter."
The current behavior of </>
is to never combine these forms.
Windows: "D:\\foo" </> "C:bar" == "C:bar" Windows: "C:\\foo" </> "C:bar" == "C:bar"
makeRelative :: FilePath -> FilePath -> FilePath #
Contract a filename, based on a relative path. Note that the resulting path
will never introduce ..
paths, as the presence of symlinks means ../b
may not reach a/b
if it starts from a/c
. For a worked example see
this blog post.
The corresponding makeAbsolute
function can be found in
System.Directory
.
makeRelative "/directory" "/directory/file.ext" == "file.ext" Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x makeRelative x x == "." Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob" Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob" Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" Windows: makeRelative "/Home" "/home/bob" == "bob" Windows: makeRelative "/" "//" == "//" Posix: makeRelative "/Home" "/home/bob" == "/home/bob" Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" Posix: makeRelative "/fred" "bob" == "bob" Posix: makeRelative "/file/test" "/file/test/fred" == "fred" Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
dropTrailingPathSeparator :: FilePath -> FilePath #
Remove any trailing path separators
dropTrailingPathSeparator "file/test/" == "file/test" dropTrailingPathSeparator "/" == "/" Windows: dropTrailingPathSeparator "\\" == "\\" Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
normalise :: FilePath -> FilePath #
Normalise a file
- // outside of the drive can be made blank
- / ->
pathSeparator
- ./ -> ""
Posix: normalise "/file/\\test////" == "/file/\\test/" Posix: normalise "/file/./test" == "/file/test" Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" Posix: normalise "../bob/fred/" == "../bob/fred/" Posix: normalise "./bob/fred/" == "bob/fred/" Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" Windows: normalise "c:\\" == "C:\\" Windows: normalise "C:.\\" == "C:" Windows: normalise "\\\\server\\test" == "\\\\server\\test" Windows: normalise "//server/test" == "\\\\server\\test" Windows: normalise "c:/file" == "C:\\file" Windows: normalise "/file" == "\\file" Windows: normalise "\\" == "\\" Windows: normalise "/./" == "\\" normalise "." == "." Posix: normalise "./" == "./" Posix: normalise "./." == "./" Posix: normalise "/./" == "/" Posix: normalise "/" == "/" Posix: normalise "bob/fred/." == "bob/fred/" Posix: normalise "//home" == "/home"
isAbsolute :: FilePath -> Bool #
not . isRelative
isAbsolute x == not (isRelative x)
isRelative :: FilePath -> Bool #
Is a path relative, or is it fixed to the root?
Windows: isRelative "path\\test" == True Windows: isRelative "c:\\test" == False Windows: isRelative "c:test" == True Windows: isRelative "c:\\" == False Windows: isRelative "c:/" == False Windows: isRelative "c:" == True Windows: isRelative "\\\\foo" == False Windows: isRelative "\\\\?\\foo" == False Windows: isRelative "\\\\?\\UNC\\foo" == False Windows: isRelative "/foo" == True Windows: isRelative "\\foo" == True Posix: isRelative "test/path" == True Posix: isRelative "/test" == False Posix: isRelative "/" == False
According to [1]:
- "A UNC name of any format [is never relative]."
- "You cannot use the "\?" prefix with a relative path."
makeValid :: FilePath -> FilePath #
Take a FilePath and make it valid; does not change already valid FilePaths.
isValid (makeValid x) isValid x ==> makeValid x == x makeValid "" == "_" makeValid "file\0name" == "file_name" Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid" Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test" Windows: makeValid "test*" == "test_" Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_" Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file" Windows: makeValid "\\\\\\foo" == "\\\\drive" Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" Windows: makeValid "nul .txt" == "nul _.txt"
Is a FilePath valid, i.e. could you create a file like it? This function checks for invalid names, and invalid characters, but does not check if length limits are exceeded, as these are typically filesystem dependent.
isValid "" == False isValid "\0" == False Posix: isValid "/random_ path:*" == True Posix: isValid x == not (null x) Windows: isValid "c:\\test" == True Windows: isValid "c:\\test:of_test" == False Windows: isValid "test*" == False Windows: isValid "c:\\test\\nul" == False Windows: isValid "c:\\test\\prn.txt" == False Windows: isValid "c:\\nul\\file" == False Windows: isValid "\\\\" == False Windows: isValid "\\\\\\foo" == False Windows: isValid "\\\\?\\D:file" == False Windows: isValid "foo\tbar" == False Windows: isValid "nul .txt" == False Windows: isValid " nul.txt" == True
equalFilePath :: FilePath -> FilePath -> Bool #
Equality of two FilePath
s.
If you call System.Directory.canonicalizePath
first this has a much better chance of working.
Note that this doesn't follow symlinks or DOSNAM~1s.
x == y ==> equalFilePath x y normalise x == normalise y ==> equalFilePath x y equalFilePath "foo" "foo/" not (equalFilePath "foo" "/foo") Posix: not (equalFilePath "foo" "FOO") Windows: equalFilePath "foo" "FOO" Windows: not (equalFilePath "C:" "C:/")
joinPath :: [FilePath] -> FilePath #
Join path elements back together.
joinPath ["/","directory/","file.ext"] == "/directory/file.ext" Valid x => joinPath (splitPath x) == x joinPath [] == "" Posix: joinPath ["test","file","path"] == "test/file/path"
splitDirectories :: FilePath -> [FilePath] #
Just as splitPath
, but don't add the trailing slashes to each element.
splitDirectories "/directory/file.ext" == ["/","directory","file.ext"] splitDirectories "test/file" == ["test","file"] splitDirectories "/test/file" == ["/","test","file"] Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"] Valid x => joinPath (splitDirectories x) `equalFilePath` x splitDirectories "" == [] Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] splitDirectories "/test///file" == ["/","test","file"]
splitPath :: FilePath -> [FilePath] #
Split a path by the directory separator.
splitPath "/directory/file.ext" == ["/","directory/","file.ext"] concat (splitPath x) == x splitPath "test//item/" == ["test//","item/"] splitPath "test/item/file" == ["test/","item/","file"] splitPath "" == [] Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"] Posix: splitPath "/file/test" == ["/","file/","test"]
replaceDirectory :: FilePath -> String -> FilePath #
Set the directory, keeping the filename the same.
replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext" Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x
takeDirectory :: FilePath -> FilePath #
Get the directory name, move up one level.
takeDirectory "/directory/other.ext" == "/directory" takeDirectory x `isPrefixOf` x || takeDirectory x == "." takeDirectory "foo" == "." takeDirectory "/" == "/" takeDirectory "/foo" == "/" takeDirectory "/foo/bar/baz" == "/foo/bar" takeDirectory "/foo/bar/baz/" == "/foo/bar/baz" takeDirectory "foo/bar/baz" == "foo/bar" Windows: takeDirectory "foo\\bar" == "foo" Windows: takeDirectory "foo\\bar\\\\" == "foo\\bar" Windows: takeDirectory "C:\\" == "C:\\"
addTrailingPathSeparator :: FilePath -> FilePath #
Add a trailing file path separator if one is not already present.
hasTrailingPathSeparator (addTrailingPathSeparator x) hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x Posix: addTrailingPathSeparator "test/rest" == "test/rest/"
hasTrailingPathSeparator :: FilePath -> Bool #
Is an item either a directory or the last character a path separator?
hasTrailingPathSeparator "test" == False hasTrailingPathSeparator "test/" == True
replaceBaseName :: FilePath -> String -> FilePath #
Set the base name.
replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext" replaceBaseName "file/test.txt" "bob" == "file/bob.txt" replaceBaseName "fred" "bill" == "bill" replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar" Valid x => replaceBaseName x (takeBaseName x) == x
takeBaseName :: FilePath -> String #
Get the base name, without an extension or path.
takeBaseName "/directory/file.ext" == "file" takeBaseName "file/test.txt" == "test" takeBaseName "dave.ext" == "dave" takeBaseName "" == "" takeBaseName "test" == "test" takeBaseName (addTrailingPathSeparator x) == "" takeBaseName "file/file.tar.gz" == "file.tar"
takeFileName :: FilePath -> FilePath #
Get the file name.
takeFileName "/directory/file.ext" == "file.ext" takeFileName "test/" == "" takeFileName x `isSuffixOf` x takeFileName x == snd (splitFileName x) Valid x => takeFileName (replaceFileName x "fred") == "fred" Valid x => takeFileName (x </> "fred") == "fred" Valid x => isRelative (takeFileName x)
dropFileName :: FilePath -> FilePath #
Drop the filename. Unlike takeDirectory
, this function will leave
a trailing path separator on the directory.
dropFileName "/directory/file.ext" == "/directory/" dropFileName x == fst (splitFileName x)
replaceFileName :: FilePath -> String -> FilePath #
Set the filename.
replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext" Valid x => replaceFileName x (takeFileName x) == x
splitFileName :: FilePath -> (String, String) #
Split a filename into directory and file. </>
is the inverse.
The first component will often end with a trailing slash.
splitFileName "/directory/file.ext" == ("/directory/","file.ext") Valid x => uncurry (</>) (splitFileName x) == x || fst (splitFileName x) == "./" Valid x => isValid (fst (splitFileName x)) splitFileName "file/bob.txt" == ("file/", "bob.txt") splitFileName "file/" == ("file/", "") splitFileName "bob" == ("./", "bob") Posix: splitFileName "/" == ("/","") Windows: splitFileName "c:" == ("c:","")
Is an element a drive
Posix: isDrive "/" == True Posix: isDrive "/foo" == False Windows: isDrive "C:\\" == True Windows: isDrive "C:\\foo" == False isDrive "" == False
hasDrive :: FilePath -> Bool #
Does a path have a drive.
not (hasDrive x) == null (takeDrive x) Posix: hasDrive "/foo" == True Windows: hasDrive "C:\\foo" == True Windows: hasDrive "C:foo" == True hasDrive "foo" == False hasDrive "" == False
joinDrive :: FilePath -> FilePath -> FilePath #
Join a drive and the rest of the path.
Valid x => uncurry joinDrive (splitDrive x) == x Windows: joinDrive "C:" "foo" == "C:foo" Windows: joinDrive "C:\\" "bar" == "C:\\bar" Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo" Windows: joinDrive "/:" "foo" == "/:\\foo"
splitDrive :: FilePath -> (FilePath, FilePath) #
Split a path into a drive and a path. On Posix, / is a Drive.
uncurry (++) (splitDrive x) == x Windows: splitDrive "file" == ("","file") Windows: splitDrive "c:/file" == ("c:/","file") Windows: splitDrive "c:\\file" == ("c:\\","file") Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test") Windows: splitDrive "\\\\shared" == ("\\\\shared","") Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file") Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file") Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file") Windows: splitDrive "/d" == ("","/d") Posix: splitDrive "/test" == ("/","test") Posix: splitDrive "//test" == ("//","test") Posix: splitDrive "test/file" == ("","test/file") Posix: splitDrive "file" == ("","file")
replaceExtensions :: FilePath -> String -> FilePath #
Replace all extensions of a file with a new extension. Note
that replaceExtension
and addExtension
both work for adding
multiple extensions, so only required when you need to drop
all extensions first.
replaceExtensions "file.fred.bob" "txt" == "file.txt" replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz"
takeExtensions :: FilePath -> String #
Get all extensions.
takeExtensions "/directory/path.ext" == ".ext" takeExtensions "file.tar.gz" == ".tar.gz"
dropExtensions :: FilePath -> FilePath #
Drop all extensions.
dropExtensions "/directory/path.ext" == "/directory/path" dropExtensions "file.tar.gz" == "file" not $ hasExtension $ dropExtensions x not $ any isExtSeparator $ takeFileName $ dropExtensions x
splitExtensions :: FilePath -> (FilePath, String) #
Split on all extensions.
splitExtensions "/directory/path.ext" == ("/directory/path",".ext") splitExtensions "file.tar.gz" == ("file",".tar.gz") uncurry (++) (splitExtensions x) == x Valid x => uncurry addExtension (splitExtensions x) == x splitExtensions "file.tar.gz" == ("file",".tar.gz")
stripExtension :: String -> FilePath -> Maybe FilePath #
Drop the given extension from a FilePath, and the "."
preceding it.
Returns Nothing
if the FilePath does not have the given extension, or
Just
and the part before the extension if it does.
This function can be more predictable than dropExtensions
, especially if the filename
might itself contain .
characters.
stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x" stripExtension "hi.o" "foo.x.hs.o" == Nothing dropExtension x == fromJust (stripExtension (takeExtension x) x) dropExtensions x == fromJust (stripExtension (takeExtensions x) x) stripExtension ".c.d" "a.b.c.d" == Just "a.b" stripExtension ".c.d" "a.b..c.d" == Just "a.b." stripExtension "baz" "foo.bar" == Nothing stripExtension "bar" "foobar" == Nothing stripExtension "" x == Just x
isExtensionOf :: String -> FilePath -> Bool #
Does the given filename have the specified extension?
"png" `isExtensionOf` "/directory/file.png" == True ".png" `isExtensionOf` "/directory/file.png" == True ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False "png" `isExtensionOf` "/directory/file.png.jpg" == False "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False
hasExtension :: FilePath -> Bool #
Does the given filename have an extension?
hasExtension "/directory/path.ext" == True hasExtension "/directory/path" == False null (takeExtension x) == not (hasExtension x)
addExtension :: FilePath -> String -> FilePath #
Add an extension, even if there is already one there, equivalent to <.>
.
addExtension "/directory/path" "ext" == "/directory/path.ext" addExtension "file.txt" "bib" == "file.txt.bib" addExtension "file." ".bib" == "file..bib" addExtension "file" ".bib" == "file.bib" addExtension "/" "x" == "/.x" addExtension x "" == x Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext" Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
dropExtension :: FilePath -> FilePath #
Remove last extension, and the "." preceding it.
dropExtension "/directory/path.ext" == "/directory/path" dropExtension x == fst (splitExtension x)
(<.>) :: FilePath -> String -> FilePath infixr 7 #
Add an extension, even if there is already one there, equivalent to addExtension
.
"/directory/path" <.> "ext" == "/directory/path.ext" "/directory/path" <.> ".ext" == "/directory/path.ext"
replaceExtension :: FilePath -> String -> FilePath #
Set the extension of a file, overwriting one if already present, equivalent to -<.>
.
replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext" replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext" replaceExtension "file.txt" ".bob" == "file.bob" replaceExtension "file.txt" "bob" == "file.bob" replaceExtension "file" ".bob" == "file.bob" replaceExtension "file.txt" "" == "file" replaceExtension "file.fred.bob" "txt" == "file.fred.txt" replaceExtension x y == addExtension (dropExtension x) y
(-<.>) :: FilePath -> String -> FilePath infixr 7 #
Remove the current extension and add another, equivalent to replaceExtension
.
"/directory/path.txt" -<.> "ext" == "/directory/path.ext" "/directory/path.txt" -<.> ".ext" == "/directory/path.ext" "foo.o" -<.> "c" == "foo.c"
takeExtension :: FilePath -> String #
Get the extension of a file, returns ""
for no extension, .ext
otherwise.
takeExtension "/directory/path.ext" == ".ext" takeExtension x == snd (splitExtension x) Valid x => takeExtension (addExtension x "ext") == ".ext" Valid x => takeExtension (replaceExtension x "ext") == ".ext"
splitExtension :: FilePath -> (String, String) #
Split on the extension. addExtension
is the inverse.
splitExtension "/directory/path.ext" == ("/directory/path",".ext") uncurry (++) (splitExtension x) == x Valid x => uncurry addExtension (splitExtension x) == x splitExtension "file.txt" == ("file",".txt") splitExtension "file" == ("file","") splitExtension "file/file.txt" == ("file/file",".txt") splitExtension "file.txt/boris" == ("file.txt/boris","") splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext") splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred") splitExtension "file/path.txt/" == ("file/path.txt/","")
getSearchPath :: IO [FilePath] #
Get a list of FilePath
s in the $PATH variable.
splitSearchPath :: String -> [FilePath] #
Take a string, split it on the searchPathSeparator
character.
Blank items are ignored on Windows, and converted to .
on Posix.
On Windows path elements are stripped of quotes.
Follows the recommendations in http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html
Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"] Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"] Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]
isExtSeparator :: Char -> Bool #
Is the character an extension character?
isExtSeparator a == (a == extSeparator)
extSeparator :: Char #
File extension character
extSeparator == '.'
isSearchPathSeparator :: Char -> Bool #
Is the character a file separator?
isSearchPathSeparator a == (a == searchPathSeparator)
The character that is used to separate the entries in the $PATH environment variable.
Windows: searchPathSeparator == ';' Posix: searchPathSeparator == ':'
isPathSeparator :: Char -> Bool #
Rather than using (==
, use this. Test if something
is a path separator.pathSeparator
)
isPathSeparator a == (a `elem` pathSeparators)
pathSeparators :: [Char] #
The list of all possible separators.
Windows: pathSeparators == ['\\', '/'] Posix: pathSeparators == ['/'] pathSeparator `elem` pathSeparators
pathSeparator :: Char #
The character that separates directories. In the case where more than
one character is possible, pathSeparator
is the 'ideal' one.
Windows: pathSeparator == '\\' Posix: pathSeparator == '/' isPathSeparator pathSeparator
class Profunctor (p :: Type -> Type -> Type) where #
Formally, the class Profunctor
represents a profunctor
from Hask
-> Hask
.
Intuitively it is a bifunctor where the first argument is contravariant and the second argument is covariant.
You can define a Profunctor
by either defining dimap
or by defining both
lmap
and rmap
.
If you supply dimap
, you should ensure that:
dimap
id
id
≡id
If you supply lmap
and rmap
, ensure:
lmap
id
≡id
rmap
id
≡id
If you supply both, you should also ensure:
dimap
f g ≡lmap
f.
rmap
g
These ensure by parametricity:
dimap
(f.
g) (h.
i) ≡dimap
g h.
dimap
f ilmap
(f.
g) ≡lmap
g.
lmap
frmap
(f.
g) ≡rmap
f.
rmap
g
Instances
Profunctor ReifiedGetter | |
Defined in Control.Lens.Reified dimap :: (a -> b) -> (c -> d) -> ReifiedGetter b c -> ReifiedGetter a d # lmap :: (a -> b) -> ReifiedGetter b c -> ReifiedGetter a c # rmap :: (b -> c) -> ReifiedGetter a b -> ReifiedGetter a c # (#.) :: Coercible c b => q b c -> ReifiedGetter a b -> ReifiedGetter a c # (.#) :: Coercible b a => ReifiedGetter b c -> q a b -> ReifiedGetter a c # | |
Profunctor ReifiedFold | |
Defined in Control.Lens.Reified dimap :: (a -> b) -> (c -> d) -> ReifiedFold b c -> ReifiedFold a d # lmap :: (a -> b) -> ReifiedFold b c -> ReifiedFold a c # rmap :: (b -> c) -> ReifiedFold a b -> ReifiedFold a c # (#.) :: Coercible c b => q b c -> ReifiedFold a b -> ReifiedFold a c # (.#) :: Coercible b a => ReifiedFold b c -> q a b -> ReifiedFold a c # | |
Monad m => Profunctor (Kleisli m) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Kleisli m b c -> Kleisli m a d # lmap :: (a -> b) -> Kleisli m b c -> Kleisli m a c # rmap :: (b -> c) -> Kleisli m a b -> Kleisli m a c # (#.) :: Coercible c b => q b c -> Kleisli m a b -> Kleisli m a c # (.#) :: Coercible b a => Kleisli m b c -> q a b -> Kleisli m a c # | |
Profunctor (ReifiedIndexedGetter i) | |
Defined in Control.Lens.Reified dimap :: (a -> b) -> (c -> d) -> ReifiedIndexedGetter i b c -> ReifiedIndexedGetter i a d # lmap :: (a -> b) -> ReifiedIndexedGetter i b c -> ReifiedIndexedGetter i a c # rmap :: (b -> c) -> ReifiedIndexedGetter i a b -> ReifiedIndexedGetter i a c # (#.) :: Coercible c b => q b c -> ReifiedIndexedGetter i a b -> ReifiedIndexedGetter i a c # (.#) :: Coercible b a => ReifiedIndexedGetter i b c -> q a b -> ReifiedIndexedGetter i a c # | |
Profunctor (ReifiedIndexedFold i) | |
Defined in Control.Lens.Reified dimap :: (a -> b) -> (c -> d) -> ReifiedIndexedFold i b c -> ReifiedIndexedFold i a d # lmap :: (a -> b) -> ReifiedIndexedFold i b c -> ReifiedIndexedFold i a c # rmap :: (b -> c) -> ReifiedIndexedFold i a b -> ReifiedIndexedFold i a c # (#.) :: Coercible c b => q b c -> ReifiedIndexedFold i a b -> ReifiedIndexedFold i a c # (.#) :: Coercible b a => ReifiedIndexedFold i b c -> q a b -> ReifiedIndexedFold i a c # | |
Profunctor (Indexed i) | |
Defined in Control.Lens.Internal.Indexed dimap :: (a -> b) -> (c -> d) -> Indexed i b c -> Indexed i a d # lmap :: (a -> b) -> Indexed i b c -> Indexed i a c # rmap :: (b -> c) -> Indexed i a b -> Indexed i a c # (#.) :: Coercible c b => q b c -> Indexed i a b -> Indexed i a c # (.#) :: Coercible b a => Indexed i b c -> q a b -> Indexed i a c # | |
Profunctor p => Profunctor (TambaraSum p) | |
Defined in Data.Profunctor.Choice dimap :: (a -> b) -> (c -> d) -> TambaraSum p b c -> TambaraSum p a d # lmap :: (a -> b) -> TambaraSum p b c -> TambaraSum p a c # rmap :: (b -> c) -> TambaraSum p a b -> TambaraSum p a c # (#.) :: Coercible c b => q b c -> TambaraSum p a b -> TambaraSum p a c # (.#) :: Coercible b a => TambaraSum p b c -> q a b -> TambaraSum p a c # | |
Profunctor (PastroSum p) | |
Defined in Data.Profunctor.Choice dimap :: (a -> b) -> (c -> d) -> PastroSum p b c -> PastroSum p a d # lmap :: (a -> b) -> PastroSum p b c -> PastroSum p a c # rmap :: (b -> c) -> PastroSum p a b -> PastroSum p a c # (#.) :: Coercible c b => q b c -> PastroSum p a b -> PastroSum p a c # (.#) :: Coercible b a => PastroSum p b c -> q a b -> PastroSum p a c # | |
Profunctor (CotambaraSum p) | |
Defined in Data.Profunctor.Choice dimap :: (a -> b) -> (c -> d) -> CotambaraSum p b c -> CotambaraSum p a d # lmap :: (a -> b) -> CotambaraSum p b c -> CotambaraSum p a c # rmap :: (b -> c) -> CotambaraSum p a b -> CotambaraSum p a c # (#.) :: Coercible c b => q b c -> CotambaraSum p a b -> CotambaraSum p a c # (.#) :: Coercible b a => CotambaraSum p b c -> q a b -> CotambaraSum p a c # | |
Profunctor (CopastroSum p) | |
Defined in Data.Profunctor.Choice dimap :: (a -> b) -> (c -> d) -> CopastroSum p b c -> CopastroSum p a d # lmap :: (a -> b) -> CopastroSum p b c -> CopastroSum p a c # rmap :: (b -> c) -> CopastroSum p a b -> CopastroSum p a c # (#.) :: Coercible c b => q b c -> CopastroSum p a b -> CopastroSum p a c # (.#) :: Coercible b a => CopastroSum p b c -> q a b -> CopastroSum p a c # | |
Profunctor p => Profunctor (Tambara p) | |
Defined in Data.Profunctor.Strong dimap :: (a -> b) -> (c -> d) -> Tambara p b c -> Tambara p a d # lmap :: (a -> b) -> Tambara p b c -> Tambara p a c # rmap :: (b -> c) -> Tambara p a b -> Tambara p a c # (#.) :: Coercible c b => q b c -> Tambara p a b -> Tambara p a c # (.#) :: Coercible b a => Tambara p b c -> q a b -> Tambara p a c # | |
Profunctor (Pastro p) | |
Defined in Data.Profunctor.Strong | |
Profunctor (Cotambara p) | |
Defined in Data.Profunctor.Strong dimap :: (a -> b) -> (c -> d) -> Cotambara p b c -> Cotambara p a d # lmap :: (a -> b) -> Cotambara p b c -> Cotambara p a c # rmap :: (b -> c) -> Cotambara p a b -> Cotambara p a c # (#.) :: Coercible c b => q b c -> Cotambara p a b -> Cotambara p a c # (.#) :: Coercible b a => Cotambara p b c -> q a b -> Cotambara p a c # | |
Profunctor (Copastro p) | |
Defined in Data.Profunctor.Strong dimap :: (a -> b) -> (c -> d) -> Copastro p b c -> Copastro p a d # lmap :: (a -> b) -> Copastro p b c -> Copastro p a c # rmap :: (b -> c) -> Copastro p a b -> Copastro p a c # (#.) :: Coercible c b => q b c -> Copastro p a b -> Copastro p a c # (.#) :: Coercible b a => Copastro p b c -> q a b -> Copastro p a c # | |
Functor f => Profunctor (Star f) | |
Defined in Data.Profunctor.Types | |
Functor f => Profunctor (Costar f) | |
Defined in Data.Profunctor.Types | |
Arrow p => Profunctor (WrappedArrow p) | |
Defined in Data.Profunctor.Types dimap :: (a -> b) -> (c -> d) -> WrappedArrow p b c -> WrappedArrow p a d # lmap :: (a -> b) -> WrappedArrow p b c -> WrappedArrow p a c # rmap :: (b -> c) -> WrappedArrow p a b -> WrappedArrow p a c # (#.) :: Coercible c b => q b c -> WrappedArrow p a b -> WrappedArrow p a c # (.#) :: Coercible b a => WrappedArrow p b c -> q a b -> WrappedArrow p a c # | |
Profunctor (Forget r) | |
Defined in Data.Profunctor.Types | |
Profunctor (Tagged :: Type -> Type -> Type) | |
Defined in Data.Profunctor.Unsafe | |
Profunctor ((->) :: Type -> Type -> Type) | |
Functor w => Profunctor (Cokleisli w) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Cokleisli w b c -> Cokleisli w a d # lmap :: (a -> b) -> Cokleisli w b c -> Cokleisli w a c # rmap :: (b -> c) -> Cokleisli w a b -> Cokleisli w a c # (#.) :: Coercible c b => q b c -> Cokleisli w a b -> Cokleisli w a c # (.#) :: Coercible b a => Cokleisli w b c -> q a b -> Cokleisli w a c # | |
Profunctor (Exchange a b) | |
Defined in Control.Lens.Internal.Iso dimap :: (a0 -> b0) -> (c -> d) -> Exchange a b b0 c -> Exchange a b a0 d # lmap :: (a0 -> b0) -> Exchange a b b0 c -> Exchange a b a0 c # rmap :: (b0 -> c) -> Exchange a b a0 b0 -> Exchange a b a0 c # (#.) :: Coercible c b0 => q b0 c -> Exchange a b a0 b0 -> Exchange a b a0 c # (.#) :: Coercible b0 a0 => Exchange a b b0 c -> q a0 b0 -> Exchange a b a0 c # | |
(Profunctor p, Profunctor q) => Profunctor (Procompose p q) | |
Defined in Data.Profunctor.Composition dimap :: (a -> b) -> (c -> d) -> Procompose p q b c -> Procompose p q a d # lmap :: (a -> b) -> Procompose p q b c -> Procompose p q a c # rmap :: (b -> c) -> Procompose p q a b -> Procompose p q a c # (#.) :: Coercible c b => q0 b c -> Procompose p q a b -> Procompose p q a c # (.#) :: Coercible b a => Procompose p q b c -> q0 a b -> Procompose p q a c # | |
(Profunctor p, Profunctor q) => Profunctor (Rift p q) | |
Defined in Data.Profunctor.Composition | |
Functor f => Profunctor (Joker f :: Type -> Type -> Type) | |
Defined in Data.Profunctor.Unsafe | |
Contravariant f => Profunctor (Clown f :: Type -> Type -> Type) | |
Defined in Data.Profunctor.Unsafe | |
(Profunctor p, Profunctor q) => Profunctor (Sum p q) | |
Defined in Data.Profunctor.Unsafe | |
(Profunctor p, Profunctor q) => Profunctor (Product p q) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Product p q b c -> Product p q a d # lmap :: (a -> b) -> Product p q b c -> Product p q a c # rmap :: (b -> c) -> Product p q a b -> Product p q a c # (#.) :: Coercible c b => q0 b c -> Product p q a b -> Product p q a c # (.#) :: Coercible b a => Product p q b c -> q0 a b -> Product p q a c # | |
(Functor f, Profunctor p) => Profunctor (Tannen f p) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Tannen f p b c -> Tannen f p a d # lmap :: (a -> b) -> Tannen f p b c -> Tannen f p a c # rmap :: (b -> c) -> Tannen f p a b -> Tannen f p a c # (#.) :: Coercible c b => q b c -> Tannen f p a b -> Tannen f p a c # (.#) :: Coercible b a => Tannen f p b c -> q a b -> Tannen f p a c # | |
(Profunctor p, Functor f, Functor g) => Profunctor (Biff p f g) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Biff p f g b c -> Biff p f g a d # lmap :: (a -> b) -> Biff p f g b c -> Biff p f g a c # rmap :: (b -> c) -> Biff p f g a b -> Biff p f g a c # (#.) :: Coercible c b => q b c -> Biff p f g a b -> Biff p f g a c # (.#) :: Coercible b a => Biff p f g b c -> q a b -> Biff p f g a c # |
makeFieldsNoPrefix :: Name -> DecsQ #
Generate overloaded field accessors based on field names which
are only prefixed with an underscore (e.g. _name
), not
additionally with the type name (e.g. _fooName
).
This might be the desired behaviour in case the
DuplicateRecordFields
language extension is used in order to get
rid of the necessity to prefix each field name with the type name.
As an example:
data Foo a = Foo { _x ::Int
, _y :: a } newtype Bar = Bar { _x ::Char
} makeFieldsNoPrefix ''Foo makeFieldsNoPrefix ''Bar
will create classes
class HasX s a | s -> a where x :: Lens' s a class HasY s a | s -> a where y :: Lens' s a
together with instances
instance HasX (Foo a) Int instance HasY (Foo a) a where instance HasX Bar Char where
For details, see classUnderscoreNoPrefixFields
.
makeFieldsNoPrefix =makeLensesWith
classUnderscoreNoPrefixFields
makeFields :: Name -> DecsQ #
Generate overloaded field accessors.
e.g
data Foo a = Foo { _fooX ::Int
, _fooY :: a } newtype Bar = Bar { _barX ::Char
} makeFields ''Foo makeFields ''Bar
will create
_fooXLens :: Lens' (Foo a) Int _fooYLens :: Lens (Foo a) (Foo b) a b class HasX s a | s -> a where x :: Lens' s a instance HasX (Foo a) Int where x = _fooXLens class HasY s a | s -> a where y :: Lens' s a instance HasY (Foo a) a where y = _fooYLens _barXLens :: Iso' Bar Char instance HasX Bar Char where x = _barXLens
For details, see camelCaseFields
.
makeFields =makeLensesWith
defaultFieldRules
abbreviatedFields :: LensRules #
Field rules fields in the form prefixFieldname or _prefixFieldname
If you want all fields to be lensed, then there is no reason to use an _
before the prefix.
If any of the record fields leads with an _
then it is assume a field without an _
should not have a lens created.
Note that prefix
may be any string of characters that are not uppercase
letters. (In particular, it may be arbitrary string of lowercase letters
and numbers) This is the behavior that defaultFieldRules
had in lens
4.4 and earlier.
classUnderscoreNoPrefixFields :: LensRules #
Field rules for fields in the form _fieldname
(the leading
underscore is mandatory).
Note: The primary difference to camelCaseFields
is that for
classUnderscoreNoPrefixFields
the field names are not expected to
be prefixed with the type name. This might be the desired behaviour
when the DuplicateRecordFields
extension is enabled.
camelCaseNamer :: FieldNamer #
A FieldNamer
for camelCaseFields
.
camelCaseFields :: LensRules #
Field rules for fields in the form prefixFieldname or _prefixFieldname
If you want all fields to be lensed, then there is no reason to use an _
before the prefix.
If any of the record fields leads with an _
then it is assume a field without an _
should not have a lens created.
Note: The prefix
must be the same as the typename (with the first
letter lowercased). This is a change from lens versions before lens 4.5.
If you want the old behaviour, use makeLensesWith
abbreviatedFields
underscoreNamer :: FieldNamer #
A FieldNamer
for underscoreFields
.
underscoreFields :: LensRules #
Field rules for fields in the form _prefix_fieldname
makeWrapped :: Name -> DecsQ #
Build Wrapped
instance for a given newtype
declareLensesWith :: LensRules -> DecsQ -> DecsQ #
Declare lenses for each records in the given declarations, using the
specified LensRules
. Any record syntax in the input will be stripped
off.
declareFields :: DecsQ -> DecsQ #
declareFields =declareLensesWith
defaultFieldRules
declareWrapped :: DecsQ -> DecsQ #
Build Wrapped
instance for each newtype.
declarePrisms :: DecsQ -> DecsQ #
Generate a Prism
for each constructor of each data type.
e.g.
declarePrisms [d| data Exp = Lit Int | Var String | Lambda{ bound::String, body::Exp } |]
will create
data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp } _Lit ::Prism'
Exp Int _Var ::Prism'
Exp String _Lambda ::Prism'
Exp (String, Exp)
declareClassyFor :: [(String, (String, String))] -> [(String, String)] -> DecsQ -> DecsQ #
Similar to makeClassyFor
, but takes a declaration quote.
declareClassy :: DecsQ -> DecsQ #
For each record in the declaration quote, make lenses and traversals for it, and create a class when the type has no arguments. All record syntax in the input will be stripped off.
e.g.
declareClassy [d| data Foo = Foo { fooX, fooY ::Int
} derivingShow
|]
will create
data Foo = FooInt
Int
derivingShow
class HasFoo t where foo ::Lens'
t Foo instance HasFoo Foo where foo =id
fooX, fooY :: HasFoo t =>Lens'
tInt
declareLensesFor :: [(String, String)] -> DecsQ -> DecsQ #
Similar to makeLensesFor
, but takes a declaration quote.
declareLenses :: DecsQ -> DecsQ #
makeLensesWith :: LensRules -> Name -> DecsQ #
Build lenses with a custom configuration.
makeClassyFor :: String -> String -> [(String, String)] -> Name -> DecsQ #
Derive lenses and traversals, using a named wrapper class, and
specifying explicit pairings of (fieldName, traversalName)
.
Example usage:
makeClassyFor
"HasFoo" "foo" [("_foo", "fooLens"), ("bar", "lbar")] ''Foo
makeLensesFor :: [(String, String)] -> Name -> DecsQ #
Derive lenses and traversals, specifying explicit pairings
of (fieldName, lensName)
.
If you map multiple names to the same label, and it is present in the same
constructor then this will generate a Traversal
.
e.g.
makeLensesFor
[("_foo", "fooLens"), ("baz", "lbaz")] ''FoomakeLensesFor
[("_barX", "bar"), ("_barY", "bar")] ''Bar
makeClassy_ :: Name -> DecsQ #
Make lenses and traversals for a type, and create a class when the type
has no arguments. Works the same as makeClassy
except that (a) it
expects that record field names do not begin with an underscore, (b) all
record fields are made into lenses, and (c) the resulting lens is prefixed
with an underscore.
makeClassy :: Name -> DecsQ #
Make lenses and traversals for a type, and create a class when the type has no arguments.
e.g.
data Foo = Foo { _fooX, _fooY ::Int
}makeClassy
''Foo
will create
class HasFoo t where foo ::Lens'
t Foo fooX ::Lens'
tInt
fooX = foo . go where go f (Foo x y) = (\x' -> Foo x' y) <$> f x fooY ::Lens'
tInt
fooY = foo . go where go f (Foo x y) = (\y' -> Foo x y') <$> f y instance HasFoo Foo where foo = id
makeClassy
=makeLensesWith
classyRules
makeLenses :: Name -> DecsQ #
Build lenses (and traversals) with a sensible default configuration.
e.g.
data FooBar = Foo { _x, _y ::Int
} | Bar { _x ::Int
}makeLenses
''FooBar
will create
x ::Lens'
FooBarInt
x f (Foo a b) = (\a' -> Foo a' b) <$> f a x f (Bar a) = Bar <$> f a y ::Traversal'
FooBarInt
y f (Foo a b) = (\b' -> Foo a b') <$> f b y _ c@(Bar _) = pure c
makeLenses
=makeLensesWith
lensRules
A LensRules
used by makeClassy_
.
Rules for making lenses and traversals that precompose another Lens
.
:: (String -> [String]) | A function that maps a |
-> FieldNamer |
Create a FieldNamer
from a mapping function. If the function
returns []
, it creates no lens for the field.
lookingupNamer :: [(String, String)] -> FieldNamer #
Create a FieldNamer
from explicit pairings of (fieldName, lensName)
.
Construct a LensRules
value for generating top-level definitions
using the given map from field names to definition names.
underscoreNoPrefixNamer :: FieldNamer #
A FieldNamer
that strips the _ off of the field name,
lowercases the name, and skips the field if it doesn't start with
an '_'.
Rules for making fairly simple partial lenses, ignoring the special cases
for isomorphisms and traversals, and not making any classes.
It uses underscoreNoPrefixNamer
.
generateLazyPatterns :: Lens' LensRules Bool #
Generate optics using lazy pattern matches. This can allow fields of an undefined value to be initialized with lenses:
data Foo = Foo {_x :: Int, _y :: Bool} deriving ShowmakeLensesWith
(lensRules
&generateLazyPatterns
.~ True) ''Foo
> undefined & x .~ 8 & y .~ True Foo {_x = 8, _y = True}
The downside of this flag is that it can lead to space-leaks and code-size/compile-time increases when generated for large records. By default this flag is turned off, and strict optics are generated.
When using lazy optics the strict optic can be recovered by composing
with $!
:
strictOptic = ($!) . lazyOptic
generateSignatures :: Lens' LensRules Bool #
Indicate whether or not to supply the signatures for the generated lenses.
Disabling this can be useful if you want to provide a more restricted type signature or if you want to supply hand-written haddocks.
type FieldNamer #
= Name | Name of the data type that lenses are being generated for. |
-> [Name] | Names of all fields (including the field being named) in the data type. |
-> Name | Name of the field being named. |
-> [DefName] | Name(s) of the lens functions. If empty, no lens is created for that field. |
The rule to create function names of lenses for data fields.
Although it's sometimes useful, you won't need the first two arguments most of the time.
Name to give to generated field optics.
TopName Name | Simple top-level definiton name |
MethodName Name Name | makeFields-style class name and method name |
type ClassyNamer #
= Name | Name of the data type that lenses are being generated for. |
-> Maybe (Name, Name) | Names of the class and the main method it generates, respectively. |
The optional rule to create a class and method around a monomorphic data type. If this naming convention is provided, it generates a "classy" lens.
Generate a Prism
for each constructor of a data type
and combine them into a single class. No Isos are created.
Reviews are created for constructors with existentially
quantified constructors and GADTs.
e.g.
data FooBarBaz a = Foo Int | Bar a | Baz Int Char makeClassyPrisms ''FooBarBaz
will create
class AsFooBarBaz s a | s -> a where _FooBarBaz :: Prism' s (FooBarBaz a) _Foo :: Prism' s Int _Bar :: Prism' s a _Baz :: Prism' s (Int,Char) _Foo = _FooBarBaz . _Foo _Bar = _FooBarBaz . _Bar _Baz = _FooBarBaz . _Baz instance AsFooBarBaz (FooBarBaz a) a
Generate an As class of prisms. Names are selected by prefixing the constructor name with an underscore. Constructors with multiple fields will construct Prisms to tuples of those fields.
In the event that the name of a data type is also the name of one of its
constructors, the name of the Prism
generated for the data type will be
prefixed with an extra _
(if the data type name is prefix) or .
(if the
name is infix) to disambiguate it from the Prism
for the corresponding
constructor. For example, this code:
data Quux = Quux Int | Fred Bool makeClassyPrisms ''Quux
will create:
class AsQuux s where __Quux :: Prism' s Quux -- Data type prism _Quux :: Prism' s Int -- Constructor prism _Fred :: Prism' s Bool _Quux = __Quux . _Quux _Fred = __Quux . _Fred instance AsQuux Quux
Generate a Prism
for each constructor of a data type.
Isos generated when possible.
Reviews are created for constructors with existentially
quantified constructors and GADTs.
e.g.
data FooBarBaz a = Foo Int | Bar a | Baz Int Char makePrisms ''FooBarBaz
will create
_Foo :: Prism' (FooBarBaz a) Int _Bar :: Prism (FooBarBaz a) (FooBarBaz b) a b _Baz :: Prism' (FooBarBaz a) (Int, Char)
iat :: At m => Index m -> IndexedLens' (Index m) m (Maybe (IxValue m)) #
An indexed version of at
.
>>>
Map.fromList [(1,"world")] ^@. iat 1
(1,Just "world")
>>>
iat 1 %@~ (\i x -> if odd i then Just "hello" else Nothing) $ Map.empty
fromList [(1,"hello")]
>>>
iat 2 %@~ (\i x -> if odd i then Just "hello" else Nothing) $ Map.empty
fromList []
iix :: Ixed m => Index m -> IndexedTraversal' (Index m) m (IxValue m) #
An indexed version of ix
.
>>>
Seq.fromList [a,b,c,d] & iix 2 %@~ f'
fromList [a,b,f' 2 c,d]
>>>
Seq.fromList [a,b,c,d] & iix 2 .@~ h
fromList [a,b,h 2,d]
>>>
Seq.fromList [a,b,c,d] ^@? iix 2
Just (2,c)
>>>
Seq.fromList [] ^@? iix 2
Nothing
icontains :: Contains m => Index m -> IndexedLens' (Index m) m Bool #
An indexed version of contains
.
>>>
IntSet.fromList [1,2,3,4] ^@. icontains 3
(3,True)
>>>
IntSet.fromList [1,2,3,4] ^@. icontains 5
(5,False)
>>>
IntSet.fromList [1,2,3,4] & icontains 3 %@~ \i x -> if odd i then not x else x
fromList [1,2,4]
>>>
IntSet.fromList [1,2,3,4] & icontains 3 %@~ \i x -> if even i then not x else x
fromList [1,2,3,4]
Instances
type Index ByteString | |
Defined in Control.Lens.At | |
type Index ByteString | |
Defined in Control.Lens.At | |
type Index Text | |
Defined in Control.Lens.At | |
type Index Value | |
Defined in Data.Aeson.Lens | |
type Index Text | |
Defined in Control.Lens.At | |
type Index IntSet | |
Defined in Control.Lens.At | |
type Index [a] | |
Defined in Control.Lens.At | |
type Index (Maybe a) | |
Defined in Control.Lens.At | |
type Index (Set a) | |
Defined in Control.Lens.At | |
type Index (Identity a) | |
Defined in Control.Lens.At | |
type Index (Vector a) | |
Defined in Control.Lens.At | |
type Index (Complex a) | |
Defined in Control.Lens.At | |
type Index (NonEmpty a) | |
Defined in Control.Lens.At | |
type Index (IntMap a) | |
Defined in Control.Lens.At | |
type Index (Tree a) | |
Defined in Control.Lens.At | |
type Index (Seq a) | |
Defined in Control.Lens.At | |
type Index (Vector a) | |
Defined in Control.Lens.At | |
type Index (Vector a) | |
Defined in Control.Lens.At | |
type Index (HashSet a) | |
Defined in Control.Lens.At | |
type Index (Vector a) | |
Defined in Control.Lens.At | |
type Index (e -> a) | |
Defined in Control.Lens.At type Index (e -> a) = e | |
type Index (a, b) | |
Defined in Control.Lens.At | |
type Index (Map k a) | |
Defined in Control.Lens.At | |
type Index (HashMap k a) | |
Defined in Control.Lens.At | |
type Index (UArray i e) | |
Defined in Control.Lens.At | |
type Index (Array i e) | |
Defined in Control.Lens.At | |
type Index (a, b, c) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e, f) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e, f, g) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e, f, g, h) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e, f, g, h, i) | |
Defined in Control.Lens.At |
This class provides a simple Lens
that lets you view (and modify)
information about whether or not a container contains a given Index
.
contains :: Index m -> Lens' m Bool #
>>>
IntSet.fromList [1,2,3,4] ^. contains 3
True
>>>
IntSet.fromList [1,2,3,4] ^. contains 5
False
>>>
IntSet.fromList [1,2,3,4] & contains 3 .~ False
fromList [1,2,4]
type family IxValue m :: Type #
Instances
type IxValue ByteString | |
Defined in Control.Lens.At | |
type IxValue ByteString | |
Defined in Control.Lens.At | |
type IxValue Text | |
Defined in Control.Lens.At | |
type IxValue Value | |
Defined in Data.Aeson.Lens | |
type IxValue Text | |
Defined in Control.Lens.At | |
type IxValue IntSet | |
Defined in Control.Lens.At | |
type IxValue [a] | |
Defined in Control.Lens.At type IxValue [a] = a | |
type IxValue (Maybe a) | |
Defined in Control.Lens.At | |
type IxValue (Set k) | |
Defined in Control.Lens.At | |
type IxValue (Identity a) | |
Defined in Control.Lens.At | |
type IxValue (Vector a) | |
Defined in Control.Lens.At | |
type IxValue (NonEmpty a) | |
Defined in Control.Lens.At | |
type IxValue (IntMap a) | |
Defined in Control.Lens.At | |
type IxValue (Tree a) | |
Defined in Control.Lens.At | |
type IxValue (Seq a) | |
Defined in Control.Lens.At | |
type IxValue (Vector a) | |
Defined in Control.Lens.At | |
type IxValue (Vector a) | |
Defined in Control.Lens.At | |
type IxValue (HashSet k) | |
Defined in Control.Lens.At | |
type IxValue (Vector a) | |
Defined in Control.Lens.At | |
type IxValue (e -> a) | |
Defined in Control.Lens.At type IxValue (e -> a) = a | |
type IxValue (a, a2) |
|
Defined in Control.Lens.At type IxValue (a, a2) = a | |
type IxValue (Map k a) | |
Defined in Control.Lens.At | |
type IxValue (HashMap k a) | |
Defined in Control.Lens.At | |
type IxValue (UArray i e) | |
Defined in Control.Lens.At | |
type IxValue (Array i e) | |
Defined in Control.Lens.At | |
type IxValue (a, a2, a3) |
|
Defined in Control.Lens.At type IxValue (a, a2, a3) = a | |
type IxValue (a, a2, a3, a4) |
|
Defined in Control.Lens.At type IxValue (a, a2, a3, a4) = a | |
type IxValue (a, a2, a3, a4, a5) |
|
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5) = a | |
type IxValue (a, a2, a3, a4, a5, a6) |
|
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5, a6) = a | |
type IxValue (a, a2, a3, a4, a5, a6, a7) |
|
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5, a6, a7) = a | |
type IxValue (a, a2, a3, a4, a5, a6, a7, a8) |
|
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5, a6, a7, a8) = a | |
type IxValue (a, a2, a3, a4, a5, a6, a7, a8, a9) |
|
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5, a6, a7, a8, a9) = a |
Provides a simple Traversal
lets you traverse
the value at a given
key in a Map
or element at an ordinal position in a list or Seq
.
Nothing
ix :: Index m -> Traversal' m (IxValue m) #
NB: Setting the value of this Traversal
will only set the value in
at
if it is already present.
If you want to be able to insert missing values, you want at
.
>>>
Seq.fromList [a,b,c,d] & ix 2 %~ f
fromList [a,b,f c,d]
>>>
Seq.fromList [a,b,c,d] & ix 2 .~ e
fromList [a,b,e,d]
>>>
Seq.fromList [a,b,c,d] ^? ix 2
Just c
>>>
Seq.fromList [] ^? ix 2
Nothing
Instances
Ixed ByteString | |
Defined in Control.Lens.At ix :: Index ByteString -> Traversal' ByteString (IxValue ByteString) # | |
Ixed ByteString | |
Defined in Control.Lens.At ix :: Index ByteString -> Traversal' ByteString (IxValue ByteString) # | |
Ixed Text | |
Defined in Control.Lens.At | |
Ixed Text | |
Defined in Control.Lens.At | |
Ixed IntSet | |
Defined in Control.Lens.At | |
Ixed [a] | |
Defined in Control.Lens.At ix :: Index [a] -> Traversal' [a] (IxValue [a]) # | |
Ixed (Maybe a) | |
Defined in Control.Lens.At | |
Ord k => Ixed (Set k) | |
Defined in Control.Lens.At | |
Ixed (Identity a) | |
Defined in Control.Lens.At | |
Storable a => Ixed (Vector a) | |
Defined in Control.Lens.At | |
Ixed (NonEmpty a) | |
Defined in Control.Lens.At | |
Ixed (IntMap a) | |
Defined in Control.Lens.At | |
Ixed (Tree a) | |
Defined in Control.Lens.At | |
Ixed (Seq a) | |
Defined in Control.Lens.At | |
Prim a => Ixed (Vector a) | |
Defined in Control.Lens.At | |
Unbox a => Ixed (Vector a) | |
Defined in Control.Lens.At | |
(Eq k, Hashable k) => Ixed (HashSet k) | |
Defined in Control.Lens.At | |
Ixed (Vector a) | |
Defined in Control.Lens.At | |
Eq e => Ixed (e -> a) | |
Defined in Control.Lens.At ix :: Index (e -> a) -> Traversal' (e -> a) (IxValue (e -> a)) # | |
a ~ a2 => Ixed (a, a2) | |
Defined in Control.Lens.At ix :: Index (a, a2) -> Traversal' (a, a2) (IxValue (a, a2)) # | |
Ord k => Ixed (Map k a) | |
Defined in Control.Lens.At | |
(Eq k, Hashable k) => Ixed (HashMap k a) | |
Defined in Control.Lens.At | |
(IArray UArray e, Ix i) => Ixed (UArray i e) | arr |
Defined in Control.Lens.At | |
Ix i => Ixed (Array i e) | arr |
Defined in Control.Lens.At | |
(a ~ a2, a ~ a3) => Ixed (a, a2, a3) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3) -> Traversal' (a, a2, a3) (IxValue (a, a2, a3)) # | |
(a ~ a2, a ~ a3, a ~ a4) => Ixed (a, a2, a3, a4) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4) -> Traversal' (a, a2, a3, a4) (IxValue (a, a2, a3, a4)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5) => Ixed (a, a2, a3, a4, a5) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5) -> Traversal' (a, a2, a3, a4, a5) (IxValue (a, a2, a3, a4, a5)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6) => Ixed (a, a2, a3, a4, a5, a6) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5, a6) -> Traversal' (a, a2, a3, a4, a5, a6) (IxValue (a, a2, a3, a4, a5, a6)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7) => Ixed (a, a2, a3, a4, a5, a6, a7) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5, a6, a7) -> Traversal' (a, a2, a3, a4, a5, a6, a7) (IxValue (a, a2, a3, a4, a5, a6, a7)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8) => Ixed (a, a2, a3, a4, a5, a6, a7, a8) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5, a6, a7, a8) -> Traversal' (a, a2, a3, a4, a5, a6, a7, a8) (IxValue (a, a2, a3, a4, a5, a6, a7, a8)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, a ~ a9) => Ixed (a, a2, a3, a4, a5, a6, a7, a8, a9) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5, a6, a7, a8, a9) -> Traversal' (a, a2, a3, a4, a5, a6, a7, a8, a9) (IxValue (a, a2, a3, a4, a5, a6, a7, a8, a9)) # |
At
provides a Lens
that can be used to read,
write or delete the value associated with a key in a Map
-like
container on an ad hoc basis.
An instance of At
should satisfy:
ix
k ≡at
k.
traverse
class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Extract each
element of a (potentially monomorphic) container.
Notably, when applied to a tuple, this generalizes both
to arbitrary homogeneous tuples.
>>>
(1,2,3) & each *~ 10
(10,20,30)
It can also be used on monomorphic containers like Text
or ByteString
.
>>>
over each Char.toUpper ("hello"^.Text.packed)
"HELLO"
>>>
("hello","world") & each.each %~ Char.toUpper
("HELLO","WORLD")
Nothing
Instances
(a ~ Word8, b ~ Word8) => Each ByteString ByteString a b |
|
Defined in Control.Lens.Each each :: Traversal ByteString ByteString a b # | |
(a ~ Word8, b ~ Word8) => Each ByteString ByteString a b |
|
Defined in Control.Lens.Each each :: Traversal ByteString ByteString a b # | |
(a ~ Char, b ~ Char) => Each Text Text a b |
|
(a ~ Char, b ~ Char) => Each Text Text a b |
|
Each [a] [b] a b |
|
Defined in Control.Lens.Each | |
Each (Maybe a) (Maybe b) a b |
|
Each (Identity a) (Identity b) a b |
|
(Storable a, Storable b) => Each (Vector a) (Vector b) a b |
|
Each (Complex a) (Complex b) a b |
|
Each (NonEmpty a) (NonEmpty b) a b |
|
Each (IntMap a) (IntMap b) a b |
|
Each (Tree a) (Tree b) a b |
|
Each (Seq a) (Seq b) a b |
|
(Prim a, Prim b) => Each (Vector a) (Vector b) a b |
|
(Unbox a, Unbox b) => Each (Vector a) (Vector b) a b |
|
Each (Vector a) (Vector b) a b |
|
(a ~ a', b ~ b') => Each (Either a a') (Either b b') a b |
Since: lens-4.18 |
(a ~ a', b ~ b') => Each (a, a') (b, b') a b |
|
Defined in Control.Lens.Each | |
c ~ d => Each (Map c a) (Map d b) a b |
|
c ~ d => Each (HashMap c a) (HashMap d b) a b |
|
(Ix i, IArray UArray a, IArray UArray b, i ~ j) => Each (UArray i a) (UArray j b) a b |
|
(Ix i, i ~ j) => Each (Array i a) (Array j b) a b |
|
(a ~ a2, a ~ a3, b ~ b2, b ~ b3) => Each (a, a2, a3) (b, b2, b3) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, b ~ b2, b ~ b3, b ~ b4) => Each (a, a2, a3, a4) (b, b2, b3, b4) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, b ~ b2, b ~ b3, b ~ b4, b ~ b5) => Each (a, a2, a3, a4, a5) (b, b2, b3, b4, b5) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6) => Each (a, a2, a3, a4, a5, a6) (b, b2, b3, b4, b5, b6) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7) => Each (a, a2, a3, a4, a5, a6, a7) (b, b2, b3, b4, b5, b6, b7) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7, b ~ b8) => Each (a, a2, a3, a4, a5, a6, a7, a8) (b, b2, b3, b4, b5, b6, b7, b8) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, a ~ a9, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7, b ~ b8, b ~ b9) => Each (a, a2, a3, a4, a5, a6, a7, a8, a9) (b, b2, b3, b4, b5, b6, b7, b8, b9) a b |
|
Defined in Control.Lens.Each |
composOpFold :: Plated a => b -> (b -> b -> b) -> (a -> b) -> a -> b #
Fold the immediate children of a Plated
container.
composOpFold
z c f =foldrOf
plate
(c.
f) z
holesOnOf :: Conjoined p => LensLike (Bazaar p r r) s t a b -> Over p (Bazaar p r r) a b r r -> s -> [Pretext p r r t] #
Extract one level of holes
from a container in a region specified by one Traversal
, using another.
holesOnOf
b l ≡holesOf
(b.
l)
holesOnOf
::Iso'
s a ->Iso'
a a -> s -> [Pretext
(->) a a s]holesOnOf
::Lens'
s a ->Lens'
a a -> s -> [Pretext
(->) a a s]holesOnOf
::Traversal'
s a ->Traversal'
a a -> s -> [Pretext
(->) a a s]holesOnOf
::Lens'
s a ->IndexedLens'
i a a -> s -> [Pretext
(Indexed
i) a a s]holesOnOf
::Traversal'
s a ->IndexedTraversal'
i a a -> s -> [Pretext
(Indexed
i) a a s]
holesOn :: Conjoined p => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t] #
An alias for holesOf
, provided for consistency with the other combinators.
holesOn
≡holesOf
holesOn
::Iso'
s a -> s -> [Pretext
(->) a a s]holesOn
::Lens'
s a -> s -> [Pretext
(->) a a s]holesOn
::Traversal'
s a -> s -> [Pretext
(->) a a s]holesOn
::IndexedLens'
i s a -> s -> [Pretext
(Indexed
i) a a s]holesOn
::IndexedTraversal'
i s a -> s -> [Pretext
(Indexed
i) a a s]
holes :: Plated a => a -> [Pretext ((->) :: Type -> Type -> Type) a a a] #
The one-level version of context
. This extracts a list of the immediate children as editable contexts.
Given a context you can use pos
to see the values, peek
at what the structure would be like with an edited result, or simply extract
the original structure.
propChildren x =children
l x==
map
pos
(holes
l x) propId x =all
(==
x) [extract
w | w <-holes
l x]
holes
=holesOf
plate
contextsOnOf :: ATraversal s t a a -> ATraversal' a a -> s -> [Context a a t] #
Return a list of all of the editable contexts for every location in the structure in an areas indicated by a user supplied Traversal
, recursively using
another user-supplied Traversal
to walk each layer.
contextsOnOf
::Traversal'
s a ->Traversal'
a a -> s -> [Context
a a s]
contextsOn :: Plated a => ATraversal s t a a -> s -> [Context a a t] #
Return a list of all of the editable contexts for every location in the structure in an areas indicated by a user supplied Traversal
, recursively using plate
.
contextsOn
b ≡contextsOnOf
bplate
contextsOn
::Plated
a =>Traversal'
s a -> s -> [Context
a a s]
contextsOf :: ATraversal' a a -> a -> [Context a a a] #
Return a list of all of the editable contexts for every location in the structure, recursively, using a user-specified Traversal
to walk each layer.
propUniverse l x =universeOf
l x==
map
pos
(contextsOf
l x) propId l x =all
(==
x) [extract
w | w <-contextsOf
l x]
contextsOf
::Traversal'
a a -> a -> [Context
a a a]
transformMOnOf :: Monad m => LensLike (WrappedMonad m) s t a b -> LensLike (WrappedMonad m) a b a b -> (b -> m b) -> s -> m t #
Transform every element in a tree that lies in a region indicated by a supplied Traversal
, walking with a user supplied Traversal
in
a bottom-up manner with a monadic effect.
transformMOnOf
::Monad
m =>Traversal'
s a ->Traversal'
a a -> (a -> m a) -> s -> m s
transformMOf :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b #
Transform every element in a tree using a user supplied Traversal
in a bottom-up manner with a monadic effect.
transformMOf
::Monad
m =>Traversal'
a a -> (a -> m a) -> a -> m a
transformMOn :: (Monad m, Plated a) => LensLike (WrappedMonad m) s t a a -> (a -> m a) -> s -> m t #
Transform every element in the tree in a region indicated by a supplied Traversal
, in a bottom-up manner, monadically.
transformMOn
:: (Monad
m,Plated
a) =>Traversal'
s a -> (a -> m a) -> s -> m s
transformM :: (Monad m, Plated a) => (a -> m a) -> a -> m a #
Transform every element in the tree, in a bottom-up manner, monadically.
transformOnOf :: ASetter s t a b -> ASetter a b a b -> (b -> b) -> s -> t #
Transform every element in a region indicated by a Setter
by recursively applying another Setter
in a bottom-up manner.
transformOnOf
::Setter'
s a ->Traversal'
a a -> (a -> a) -> s -> stransformOnOf
::Setter'
s a ->Setter'
a a -> (a -> a) -> s -> s
transformOf :: ASetter a b a b -> (b -> b) -> a -> b #
Transform every element by recursively applying a given Setter
in a bottom-up manner.
transformOf
::Traversal'
a a -> (a -> a) -> a -> atransformOf
::Setter'
a a -> (a -> a) -> a -> a
transformOn :: Plated a => ASetter s t a a -> (a -> a) -> s -> t #
Transform every element in the tree in a bottom-up manner over a region indicated by a Setter
.
transformOn
::Plated
a =>Traversal'
s a -> (a -> a) -> s -> stransformOn
::Plated
a =>Setter'
s a -> (a -> a) -> s -> s
cosmosOnOf :: (Applicative f, Contravariant f) => LensLike' f s a -> LensLike' f a a -> LensLike' f s a #
cosmosOn :: (Applicative f, Contravariant f, Plated a) => LensLike' f s a -> LensLike' f s a #
cosmosOf :: (Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a #
cosmos :: Plated a => Fold a a #
Fold over all transitive descendants of a Plated
container, including itself.
universeOnOf :: Getting [a] s a -> Getting [a] a a -> s -> [a] #
Given a Fold
that knows how to locate immediate children, retrieve all of the transitive descendants of a node, including itself that lie
in a region indicated by another Fold
.
toListOf
l ≡universeOnOf
lignored
universeOn :: Plated a => Getting [a] s a -> s -> [a] #
universeOf :: Getting [a] a a -> a -> [a] #
Given a Fold
that knows how to locate immediate children, retrieve all of the transitive descendants of a node, including itself.
universeOf
::Fold
a a -> a -> [a]
universe :: Plated a => a -> [a] #
Retrieve all of the transitive descendants of a Plated
container, including itself.
rewriteMOnOf :: Monad m => LensLike (WrappedMonad m) s t a b -> LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> s -> m t #
rewriteMOn :: (Monad m, Plated a) => LensLike (WrappedMonad m) s t a a -> (a -> m (Maybe a)) -> s -> m t #
Rewrite by applying a monadic rule everywhere inside of a structure located by a user-specified Traversal
.
Ensures that the rule cannot be applied anywhere in the result.
rewriteMOf :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> a -> m b #
Rewrite by applying a monadic rule everywhere you recursing with a user-specified Traversal
.
Ensures that the rule cannot be applied anywhere in the result.
rewriteM :: (Monad m, Plated a) => (a -> m (Maybe a)) -> a -> m a #
Rewrite by applying a monadic rule everywhere you can. Ensures that the rule cannot be applied anywhere in the result.
rewriteOnOf :: ASetter s t a b -> ASetter a b a b -> (b -> Maybe a) -> s -> t #
Rewrite recursively over part of a larger structure using a specified Setter
.
rewriteOnOf
::Iso'
s a ->Iso'
a a -> (a ->Maybe
a) -> s -> srewriteOnOf
::Lens'
s a ->Lens'
a a -> (a ->Maybe
a) -> s -> srewriteOnOf
::Traversal'
s a ->Traversal'
a a -> (a ->Maybe
a) -> s -> srewriteOnOf
::Setter'
s a ->Setter'
a a -> (a ->Maybe
a) -> s -> s
rewriteOn :: Plated a => ASetter s t a a -> (a -> Maybe a) -> s -> t #
Rewrite recursively over part of a larger structure.
rewriteOn
::Plated
a =>Iso'
s a -> (a ->Maybe
a) -> s -> srewriteOn
::Plated
a =>Lens'
s a -> (a ->Maybe
a) -> s -> srewriteOn
::Plated
a =>Traversal'
s a -> (a ->Maybe
a) -> s -> srewriteOn
::Plated
a =>ASetter'
s a -> (a ->Maybe
a) -> s -> s
rewriteOf :: ASetter a b a b -> (b -> Maybe a) -> a -> b #
Rewrite by applying a rule everywhere you can. Ensures that the rule cannot be applied anywhere in the result:
propRewriteOf l r x =all
(isNothing
.
r) (universeOf
l (rewriteOf
l r x))
Usually transformOf
is more appropriate, but rewriteOf
can give better
compositionality. Given two single transformations f
and g
, you can
construct \a -> f a
which performs both rewrites until a fixed point.<|>
g a
rewriteOf
::Iso'
a a -> (a ->Maybe
a) -> a -> arewriteOf
::Lens'
a a -> (a ->Maybe
a) -> a -> arewriteOf
::Traversal'
a a -> (a ->Maybe
a) -> a -> arewriteOf
::Setter'
a a -> (a ->Maybe
a) -> a -> a
rewrite :: Plated a => (a -> Maybe a) -> a -> a #
Rewrite by applying a rule everywhere you can. Ensures that the rule cannot be applied anywhere in the result:
propRewrite r x =all
(isNothing
.
r) (universe
(rewrite
r x))
Usually transform
is more appropriate, but rewrite
can give better
compositionality. Given two single transformations f
and g
, you can
construct \a -> f a
which performs both rewrites until a fixed point.<|>
g a
deep :: (Conjoined p, Applicative f, Plated s) => Traversing p f s s a b -> Over p f s s a b #
Try to apply a traversal to all transitive descendants of a Plated
container, but
do not recurse through matching descendants.
deep
::Plated
s =>Fold
s a ->Fold
s adeep
::Plated
s =>IndexedFold
s a ->IndexedFold
s adeep
::Plated
s =>Traversal
s s a b ->Traversal
s s a bdeep
::Plated
s =>IndexedTraversal
s s a b ->IndexedTraversal
s s a b
(...) :: (Applicative f, Plated c) => LensLike f s t c c -> Over p f c c a b -> Over p f s t a b infixr 9 #
Compose through a plate
A Plated
type is one where we know how to extract its immediate self-similar children.
Example 1:
import Control.Applicative
import Control.Lens
import Control.Lens.Plated
import Data.Data
import Data.Data.Lens (uniplate
)
data Expr = ValInt
| Neg Expr | Add Expr Expr deriving (Eq
,Ord
,Show
,Read
,Data
,Typeable
)
instancePlated
Expr whereplate
f (Neg e) = Neg<$>
f eplate
f (Add a b) = Add<$>
f a<*>
f bplate
_ a =pure
a
or
instancePlated
Expr whereplate
=uniplate
Example 2:
import Control.Applicative
import Control.Lens
import Control.Lens.Plated
import Data.Data
import Data.Data.Lens (uniplate
)
data Tree a = Bin (Tree a) (Tree a) | Tip a deriving (Eq
,Ord
,Show
,Read
,Data
,Typeable
)
instancePlated
(Tree a) whereplate
f (Bin l r) = Bin<$>
f l<*>
f rplate
_ t =pure
t
or
instanceData
a =>Plated
(Tree a) whereplate
=uniplate
Note the big distinction between these two implementations.
The former will only treat children directly in this tree as descendents, the latter will treat trees contained in the values under the tips also as descendants!
When in doubt, pick a Traversal
and just use the various ...Of
combinators
rather than pollute Plated
with orphan instances!
If you want to find something unplated and non-recursive with biplate
use the ...OnOf
variant with ignored
, though those usecases are much better served
in most cases by using the existing Lens
combinators! e.g.
toListOf
biplate
≡universeOnOf
biplate
ignored
This same ability to explicitly pass the Traversal
in question is why there is no
analogue to uniplate's Biplate
.
Moreover, since we can allow custom traversals, we implement reasonable defaults for
polymorphic data types, that only traverse
into themselves, and not their
polymorphic arguments.
Nothing
plate :: Traversal' a a #
Instances
class GPlated a (g :: k -> Type) #
gplate'
Instances
GPlated a (V1 :: k -> Type) | |
Defined in Control.Lens.Plated gplate' :: Traversal' (V1 p) a | |
GPlated a (U1 :: k -> Type) | |
Defined in Control.Lens.Plated gplate' :: Traversal' (U1 p) a | |
GPlated a (URec b :: k -> Type) | |
Defined in Control.Lens.Plated gplate' :: Traversal' (URec b p) a | |
GPlated a (K1 i a :: k -> Type) | |
Defined in Control.Lens.Plated gplate' :: Traversal' (K1 i a p) a | |
GPlated a (K1 i b :: k -> Type) | |
Defined in Control.Lens.Plated gplate' :: Traversal' (K1 i b p) a | |
(GPlated a f, GPlated a g) => GPlated a (f :+: g :: k -> Type) | |
Defined in Control.Lens.Plated gplate' :: Traversal' ((f :+: g) p) a | |
(GPlated a f, GPlated a g) => GPlated a (f :*: g :: k -> Type) | |
Defined in Control.Lens.Plated gplate' :: Traversal' ((f :*: g) p) a | |
GPlated a f => GPlated a (M1 i c f :: k -> Type) | |
Defined in Control.Lens.Plated gplate' :: Traversal' (M1 i c f p) a |
class GPlated1 (f :: k -> Type) (g :: k -> Type) #
gplate1'
Instances
GPlated1 (f :: k -> Type) (V1 :: k -> Type) | ignored |
Defined in Control.Lens.Plated gplate1' :: Traversal' (V1 a) (f a) | |
GPlated1 (f :: k -> Type) (U1 :: k -> Type) | ignored |
Defined in Control.Lens.Plated gplate1' :: Traversal' (U1 a) (f a) | |
GPlated1 (f :: k -> Type) (URec a :: k -> Type) | ignored |
Defined in Control.Lens.Plated gplate1' :: Traversal' (URec a a0) (f a0) | |
GPlated1 (f :: k -> Type) (Rec1 f :: k -> Type) | match |
Defined in Control.Lens.Plated gplate1' :: Traversal' (Rec1 f a) (f a) | |
GPlated1 (f :: k -> Type) (Rec1 g :: k -> Type) | ignored |
Defined in Control.Lens.Plated gplate1' :: Traversal' (Rec1 g a) (f a) | |
GPlated1 (f :: k -> Type) (K1 i a :: k -> Type) | ignored |
Defined in Control.Lens.Plated gplate1' :: Traversal' (K1 i a a0) (f a0) | |
(GPlated1 f g, GPlated1 f h) => GPlated1 (f :: k -> Type) (g :+: h :: k -> Type) | recursive match |
Defined in Control.Lens.Plated gplate1' :: Traversal' ((g :+: h) a) (f a) | |
(GPlated1 f g, GPlated1 f h) => GPlated1 (f :: k -> Type) (g :*: h :: k -> Type) | recursive match |
Defined in Control.Lens.Plated gplate1' :: Traversal' ((g :*: h) a) (f a) | |
GPlated1 f g => GPlated1 (f :: k -> Type) (M1 i c g :: k -> Type) | recursive match |
Defined in Control.Lens.Plated gplate1' :: Traversal' (M1 i c g a) (f a) | |
(Traversable t, GPlated1 f g) => GPlated1 (f :: k1 -> Type) (t :.: g :: k1 -> Type) | recursive match under outer |
Defined in Control.Lens.Plated gplate1' :: Traversal' ((t :.: g) a) (f a) | |
GPlated1 (f :: Type -> Type) Par1 | ignored |
Defined in Control.Lens.Plated gplate1' :: Traversal' (Par1 a) (f a) |
type family Zoomed (m :: Type -> Type) :: Type -> Type -> Type #
This type family is used by Zoom
to describe the common effect type.
Instances
type Zoomed (MaybeT m) | |
Defined in Control.Lens.Zoom | |
type Zoomed (ListT m) | |
Defined in Control.Lens.Zoom | |
type Zoomed (IdentityT m) | |
Defined in Control.Lens.Zoom | |
type Zoomed (WriterT w m) | |
Defined in Control.Lens.Zoom | |
type Zoomed (WriterT w m) | |
Defined in Control.Lens.Zoom | |
type Zoomed (StateT s z) | |
Defined in Control.Lens.Zoom | |
type Zoomed (StateT s z) | |
Defined in Control.Lens.Zoom | |
type Zoomed (ExceptT e m) | |
Defined in Control.Lens.Zoom | |
type Zoomed (FreeT f m) | |
Defined in Control.Lens.Zoom | |
type Zoomed (ErrorT e m) | |
Defined in Control.Lens.Zoom | |
type Zoomed (ReaderT e m) | |
Defined in Control.Lens.Zoom | |
type Zoomed (RWST r w s z) | |
Defined in Control.Lens.Zoom | |
type Zoomed (RWST r w s z) | |
Defined in Control.Lens.Zoom |
type family Magnified (m :: Type -> Type) :: Type -> Type -> Type #
This type family is used by Magnify
to describe the common effect type.
Instances
type Magnified (IdentityT m) | |
Defined in Control.Lens.Zoom | |
type Magnified ((->) b :: Type -> Type) | |
type Magnified (ReaderT b m) | |
Defined in Control.Lens.Zoom | |
type Magnified (RWST a w s m) | |
Defined in Control.Lens.Zoom | |
type Magnified (RWST a w s m) | |
Defined in Control.Lens.Zoom |
class (MonadState s m, MonadState t n) => Zoom (m :: Type -> Type) (n :: Type -> Type) s t | m -> s, n -> t, m t -> n, n s -> m where #
This class allows us to use zoom
in, changing the State
supplied by
many different Monad
transformers, potentially quite
deep in a Monad
transformer stack.
zoom :: LensLike' (Zoomed m c) t s -> m c -> n c infixr 2 #
Run a monadic action in a larger State
than it was defined in,
using a Lens'
or Traversal'
.
This is commonly used to lift actions in a simpler State
Monad
into a State
Monad
with a larger State
type.
When applied to a Traversal'
over
multiple values, the actions for each target are executed sequentially
and the results are aggregated.
This can be used to edit pretty much any Monad
transformer stack with a State
in it!
>>>
flip State.evalState (a,b) $ zoom _1 $ use id
a
>>>
flip State.execState (a,b) $ zoom _1 $ id .= c
(c,b)
>>>
flip State.execState [(a,b),(c,d)] $ zoom traverse $ _2 %= f
[(a,f b),(c,f d)]
>>>
flip State.runState [(a,b),(c,d)] $ zoom traverse $ _2 <%= f
(f b <> f d <> mempty,[(a,f b),(c,f d)])
>>>
flip State.evalState (a,b) $ zoom both (use id)
a <> b
zoom
::Monad
m =>Lens'
s t ->StateT
t m a ->StateT
s m azoom
:: (Monad
m,Monoid
c) =>Traversal'
s t ->StateT
t m c ->StateT
s m czoom
:: (Monad
m,Monoid
w) =>Lens'
s t ->RWST
r w t m c ->RWST
r w s m czoom
:: (Monad
m,Monoid
w,Monoid
c) =>Traversal'
s t ->RWST
r w t m c ->RWST
r w s m czoom
:: (Monad
m,Monoid
w,Error
e) =>Lens'
s t ->ErrorT
e (RWST
r w t m) c ->ErrorT
e (RWST
r w s m) czoom
:: (Monad
m,Monoid
w,Monoid
c,Error
e) =>Traversal'
s t ->ErrorT
e (RWST
r w t m) c ->ErrorT
e (RWST
r w s m) c ...
Instances
Zoom m n s t => Zoom (MaybeT m) (MaybeT n) s t | |
Zoom m n s t => Zoom (ListT m) (ListT n) s t | |
Zoom m n s t => Zoom (IdentityT m) (IdentityT n) s t | |
(Monoid w, Zoom m n s t) => Zoom (WriterT w m) (WriterT w n) s t | |
(Monoid w, Zoom m n s t) => Zoom (WriterT w m) (WriterT w n) s t | |
Monad z => Zoom (StateT s z) (StateT t z) s t | |
Monad z => Zoom (StateT s z) (StateT t z) s t | |
Zoom m n s t => Zoom (ExceptT e m) (ExceptT e n) s t | |
(Functor f, Zoom m n s t) => Zoom (FreeT f m) (FreeT f n) s t | |
(Error e, Zoom m n s t) => Zoom (ErrorT e m) (ErrorT e n) s t | |
Zoom m n s t => Zoom (ReaderT e m) (ReaderT e n) s t | |
(Monoid w, Monad z) => Zoom (RWST r w s z) (RWST r w t z) s t | |
(Monoid w, Monad z) => Zoom (RWST r w s z) (RWST r w t z) s t | |
class (Magnified m ~ Magnified n, MonadReader b m, MonadReader a n) => Magnify (m :: Type -> Type) (n :: Type -> Type) b a | m -> b, n -> a, m a -> n, n b -> m where #
This class allows us to use magnify
part of the environment, changing the environment supplied by
many different Monad
transformers. Unlike zoom
this can change the environment of a deeply nested Monad
transformer.
Also, unlike zoom
, this can be used with any valid Getter
, but cannot be used with a Traversal
or Fold
.
magnify :: (Functor (Magnified m c) -> Contravariant (Magnified m c) -> LensLike' (Magnified m c) a b) -> m c -> n c infixr 2 #
Run a monadic action in a larger environment than it was defined in, using a Getter
.
This acts like local
, but can in many cases change the type of the environment as well.
This is commonly used to lift actions in a simpler Reader
Monad
into a Monad
with a larger environment type.
This can be used to edit pretty much any Monad
transformer stack with an environment in it:
>>>
(1,2) & magnify _2 (+1)
3
>>>
flip Reader.runReader (1,2) $ magnify _1 Reader.ask
1
>>>
flip Reader.runReader (1,2,[10..20]) $ magnify (_3._tail) Reader.ask
[11,12,13,14,15,16,17,18,19,20]
The type can be read as
magnify :: LensLike' (Magnified m c) a b -> m c -> n c
but the higher-rank constraints make it easier to apply magnify
to a
Getter
in highly-polymorphic code.
magnify
::Getter
s a -> (a -> r) -> s -> rmagnify
::Monoid
r =>Fold
s a -> (a -> r) -> s -> r
magnify
::Monoid
w =>Getter
s t ->RWS
t w st c ->RWS
s w st cmagnify
:: (Monoid
w,Monoid
c) =>Fold
s a ->RWS
a w st c ->RWS
s w st c ...
Instances
Magnify m n b a => Magnify (IdentityT m) (IdentityT n) b a | |
Magnify ((->) b :: Type -> Type) ((->) a :: Type -> Type) b a |
|
Defined in Control.Lens.Zoom | |
Monad m => Magnify (ReaderT b m) (ReaderT a m) b a | |
(Monad m, Monoid w) => Magnify (RWST b w s m) (RWST a w s m) b a | |
(Monad m, Monoid w) => Magnify (RWST b w s m) (RWST a w s m) b a | |
alaf :: (Functor f, Functor g, Rewrapping s t) => (Unwrapped s -> s) -> (f t -> g s) -> f (Unwrapped t) -> g (Unwrapped s) #
This combinator is based on ala'
from Conor McBride's work on Epigram.
As with _Wrapping
, the user supplied function for the newtype is ignored.
alaf :: Rewrapping s t => (Unwrapped s -> s) -> ((r -> t) -> e -> s) -> (r -> Unwrapped t) -> e -> Unwrapped s
>>>
alaf Sum foldMap Prelude.length ["hello","world"]
10
ala :: (Functor f, Rewrapping s t) => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s) #
This combinator is based on ala
from Conor McBride's work on Epigram.
As with _Wrapping
, the user supplied function for the newtype is ignored.
>>>
ala Sum foldMap [1,2,3,4]
10
>>>
ala All foldMap [True,True]
True
>>>
ala All foldMap [True,False]
False
>>>
ala Any foldMap [False,False]
False
>>>
ala Any foldMap [True,False]
True
>>>
ala Product foldMap [1,2,3,4]
24
You may want to think of this combinator as having the following, simpler, type.
ala :: Rewrapping s t => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> e -> s) -> e -> Unwrapped s
_Unwrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso (Unwrapped t) (Unwrapped s) t s #
This is a convenient version of _Unwrapped
with an argument that's ignored.
The user supplied function is ignored, merely its types are used.
_Wrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso s t (Unwrapped s) (Unwrapped t) #
This is a convenient version of _Wrapped
with an argument that's ignored.
The user supplied function is ignored, merely its types are used.
_Unwrapping' :: Wrapped s => (Unwrapped s -> s) -> Iso' (Unwrapped s) s #
This is a convenient version of _Wrapped
with an argument that's ignored.
The user supplied function is ignored, merely its type is used.
_Wrapping' :: Wrapped s => (Unwrapped s -> s) -> Iso' s (Unwrapped s) #
This is a convenient version of _Wrapped
with an argument that's ignored.
The user supplied function is ignored, merely its type is used.
_Unwrapped :: Rewrapping s t => Iso (Unwrapped t) (Unwrapped s) t s #
_Wrapped :: Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t) #
Work under a newtype wrapper.
>>>
Const "hello" & _Wrapped %~ Prelude.length & getConst
5
_Wrapped
≡from
_Unwrapped
_Unwrapped
≡from
_Wrapped
_Unwrapped' :: Wrapped s => Iso' (Unwrapped s) s #
_GWrapped' :: (Generic s, D1 d (C1 c (S1 s' (Rec0 a))) ~ Rep s, Unwrapped s ~ GUnwrapped (Rep s)) => Iso' s (Unwrapped s) #
Wrapped
provides isomorphisms to wrap and unwrap newtypes or
data types with one constructor.
Nothing
_Wrapped' :: Iso' s (Unwrapped s) #
An isomorphism between s
and a
.
If your type has a Generic
instance, _Wrapped'
will default to _GWrapped'
,
and you can choose to not override it with your own definition.
Instances
class Wrapped s => Rewrapped s t #
Instances
class (Rewrapped s t, Rewrapped t s) => Rewrapping s t #
Instances
(Rewrapped s t, Rewrapped t s) => Rewrapping s t | |
Defined in Control.Lens.Wrapped |
unsnoc :: Snoc s s a a => s -> Maybe (s, a) #
Attempt to extract the right-most element from a container, and a version of the container without that element.
>>>
unsnoc (LazyT.pack "hello!")
Just ("hello",'!')
>>>
unsnoc (LazyT.pack "")
Nothing
>>>
unsnoc (Seq.fromList [b,c,a])
Just (fromList [b,c],a)
>>>
unsnoc (Seq.fromList [])
Nothing
snoc :: Snoc s s a a => s -> a -> s infixl 5 #
snoc
an element onto the end of a container.
>>>
snoc (Seq.fromList []) a
fromList [a]
>>>
snoc (Seq.fromList [b, c]) a
fromList [b,c,a]
>>>
snoc (LazyT.pack "hello") '!'
"hello!"
_last :: Snoc s s a a => Traversal' s a #
A Traversal
reading and writing to the last element of a non-empty container.
>>>
[a,b,c]^?!_last
c
>>>
[]^?_last
Nothing
>>>
[a,b,c] & _last %~ f
[a,b,f c]
>>>
[1,2]^?_last
Just 2
>>>
[] & _last .~ 1
[]
>>>
[0] & _last .~ 2
[2]
>>>
[0,1] & _last .~ 2
[0,2]
This Traversal
is not limited to lists, however. We can also work with other containers, such as a Vector
.
>>>
Vector.fromList "abcde" ^? _last
Just 'e'
>>>
Vector.empty ^? _last
Nothing
>>>
(Vector.fromList "abcde" & _last .~ 'Q') == Vector.fromList "abcdQ"
True
_last
::Traversal'
[a] a_last
::Traversal'
(Seq
a) a_last
::Traversal'
(Vector
a) a
_init :: Snoc s s a a => Traversal' s s #
A Traversal
reading and replacing all but the a last element of a non-empty container.
>>>
[a,b,c,d]^?_init
Just [a,b,c]
>>>
[]^?_init
Nothing
>>>
[a,b] & _init .~ [c,d,e]
[c,d,e,b]
>>>
[] & _init .~ [a,b]
[]
>>>
[a,b,c,d] & _init.traverse %~ f
[f a,f b,f c,d]
>>>
[1,2,3]^?_init
Just [1,2]
>>>
[1,2,3,4]^?!_init
[1,2,3]
>>>
"hello"^._init
"hell"
>>>
""^._init
""
_init
::Traversal'
[a] [a]_init
::Traversal'
(Seq
a) (Seq
a)_init
::Traversal'
(Vector
a) (Vector
a)
_tail :: Cons s s a a => Traversal' s s #
A Traversal
reading and writing to the tail
of a non-empty container.
>>>
[a,b] & _tail .~ [c,d,e]
[a,c,d,e]
>>>
[] & _tail .~ [a,b]
[]
>>>
[a,b,c,d,e] & _tail.traverse %~ f
[a,f b,f c,f d,f e]
>>>
[1,2] & _tail .~ [3,4,5]
[1,3,4,5]
>>>
[] & _tail .~ [1,2]
[]
>>>
[a,b,c]^?_tail
Just [b,c]
>>>
[1,2]^?!_tail
[2]
>>>
"hello"^._tail
"ello"
>>>
""^._tail
""
This isn't limited to lists. For instance you can also traverse
the tail of a Seq
.
>>>
Seq.fromList [a,b] & _tail .~ Seq.fromList [c,d,e]
fromList [a,c,d,e]
>>>
Seq.fromList [a,b,c] ^? _tail
Just (fromList [b,c])
>>>
Seq.fromList [] ^? _tail
Nothing
_tail
::Traversal'
[a] [a]_tail
::Traversal'
(Seq
a) (Seq
a)_tail
::Traversal'
(Vector
a) (Vector
a)
_head :: Cons s s a a => Traversal' s a #
A Traversal
reading and writing to the head
of a non-empty container.
>>>
[a,b,c]^? _head
Just a
>>>
[a,b,c] & _head .~ d
[d,b,c]
>>>
[a,b,c] & _head %~ f
[f a,b,c]
>>>
[] & _head %~ f
[]
>>>
[1,2,3]^?!_head
1
>>>
[]^?_head
Nothing
>>>
[1,2]^?_head
Just 1
>>>
[] & _head .~ 1
[]
>>>
[0] & _head .~ 2
[2]
>>>
[0,1] & _head .~ 2
[2,1]
This isn't limited to lists.
For instance you can also traverse
the head of a Seq
:
>>>
Seq.fromList [a,b,c,d] & _head %~ f
fromList [f a,b,c,d]
>>>
Seq.fromList [] ^? _head
Nothing
>>>
Seq.fromList [a,b,c,d] ^? _head
Just a
_head
::Traversal'
[a] a_head
::Traversal'
(Seq
a) a_head
::Traversal'
(Vector
a) a
uncons :: Cons s s a a => s -> Maybe (a, s) #
Attempt to extract the left-most element from a container, and a version of the container without that element.
>>>
uncons []
Nothing
>>>
uncons [a, b, c]
Just (a,[b,c])
cons :: Cons s s a a => a -> s -> s infixr 5 #
cons
an element onto a container.
>>>
cons a []
[a]
>>>
cons a [b, c]
[a,b,c]
>>>
cons a (Seq.fromList [])
fromList [a]
>>>
cons a (Seq.fromList [b, c])
fromList [a,b,c]
class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where #
This class provides a way to attach or detach elements on the left side of a structure in a flexible manner.
Instances
Cons ByteString ByteString Word8 Word8 | |
Defined in Control.Lens.Cons _Cons :: Prism ByteString ByteString (Word8, ByteString) (Word8, ByteString) # | |
Cons ByteString ByteString Word8 Word8 | |
Defined in Control.Lens.Cons _Cons :: Prism ByteString ByteString (Word8, ByteString) (Word8, ByteString) # | |
Cons Text Text Char Char | |
Cons Text Text Char Char | |
Cons [a] [b] a b | |
Defined in Control.Lens.Cons | |
Cons (ZipList a) (ZipList b) a b | |
(Storable a, Storable b) => Cons (Vector a) (Vector b) a b | |
Cons (Seq a) (Seq b) a b | |
(Prim a, Prim b) => Cons (Vector a) (Vector b) a b | |
(Unbox a, Unbox b) => Cons (Vector a) (Vector b) a b | |
Cons (Vector a) (Vector b) a b | |
class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where #
This class provides a way to attach or detach elements on the right side of a structure in a flexible manner.
Instances
Snoc ByteString ByteString Word8 Word8 | |
Defined in Control.Lens.Cons _Snoc :: Prism ByteString ByteString (ByteString, Word8) (ByteString, Word8) # | |
Snoc ByteString ByteString Word8 Word8 | |
Defined in Control.Lens.Cons _Snoc :: Prism ByteString ByteString (ByteString, Word8) (ByteString, Word8) # | |
Snoc Text Text Char Char | |
Snoc Text Text Char Char | |
Snoc [a] [b] a b | |
Defined in Control.Lens.Cons | |
Snoc (ZipList a) (ZipList b) a b | |
(Storable a, Storable b) => Snoc (Vector a) (Vector b) a b | |
Snoc (Seq a) (Seq b) a b | |
(Prim a, Prim b) => Snoc (Vector a) (Vector b) a b | |
(Unbox a, Unbox b) => Snoc (Vector a) (Vector b) a b | |
Snoc (Vector a) (Vector b) a b | |
Nothing
Instances
coerced :: (Coercible s a, Coercible t b) => Iso s t a b #
Data types that are representationally equal are isomorphic.
This is only available on GHC 7.8+
Since: lens-4.13
seconding :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f x s) (g y t) (f x a) (g y b) #
Lift an Iso
into the second argument of a Bifunctor
. This is
essentially the same as mapping
, but it takes a 'Bifunctor p'
constraint instead of a 'Functor (p a)' one.
seconding ::Bifunctor
p =>Iso
s t a b ->Iso
(p x s) (p y t) (p x a) (p y b) seconding ::Bifunctor
p =>Iso'
s a ->Iso'
(p x s) (p x a)
bimapping :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b') #
rmapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p x s) (q y t) (p x a) (q y b) #
Lift an Iso
covariantly into the right argument of a Profunctor
.
rmapping ::Profunctor
p =>Iso
s t a b ->Iso
(p x s) (p y t) (p x a) (p y b) rmapping ::Profunctor
p =>Iso'
s a ->Iso'
(p x s) (p x a)
lmapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p a x) (q b y) (p s x) (q t y) #
Lift an Iso
contravariantly into the left argument of a Profunctor
.
lmapping ::Profunctor
p =>Iso
s t a b ->Iso
(p a x) (p b y) (p s x) (p t y) lmapping ::Profunctor
p =>Iso'
s a ->Iso'
(p a x) (p s x)
dimapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (p a s') (q b t') (p s a') (q t b') #
Lift two Iso
s into both arguments of a Profunctor
simultaneously.
dimapping ::Profunctor
p =>Iso
s t a b ->Iso
s' t' a' b' ->Iso
(p a s') (p b t') (p s a') (p t b') dimapping ::Profunctor
p =>Iso'
s a ->Iso'
s' a' ->Iso'
(p a s') (p s a')
contramapping :: Contravariant f => AnIso s t a b -> Iso (f a) (f b) (f s) (f t) #
Lift an Iso
into a Contravariant
functor.
contramapping ::Contravariant
f =>Iso
s t a b ->Iso
(f a) (f b) (f s) (f t) contramapping ::Contravariant
f =>Iso'
s a ->Iso'
(f a) (f s)
imagma :: Over (Indexed i) (Molten i a b) s t a b -> Iso s t' (Magma i t b a) (Magma j t' c c) #
This isomorphism can be used to inspect an IndexedTraversal
to see how it associates
the structure and it can also be used to bake the IndexedTraversal
into a Magma
so
that you can traverse over it multiple times with access to the original indices.
reversed :: Reversing a => Iso' a a #
An Iso
between a list, ByteString
, Text
fragment, etc. and its reversal.
>>>
"live" ^. reversed
"evil"
>>>
"live" & reversed %~ ('d':)
"lived"
lazy :: Strict lazy strict => Iso' strict lazy #
An Iso
between the strict variant of a structure and its lazy
counterpart.
lazy
=from
strict
See http://hackage.haskell.org/package/strict-base-types for an example use.
flipped :: Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c') #
The isomorphism for flipping a function.
>>>
((,)^.flipped) 1 2
(2,1)
anon :: a -> (a -> Bool) -> Iso' (Maybe a) a #
generalizes anon
a p
to take any value and a predicate.non
a
This function assumes that p a
holds
and generates an isomorphism between True
and Maybe
(a | not
(p a))a
.
>>>
Map.empty & at "hello" . anon Map.empty Map.null . at "world" ?~ "!!!"
fromList [("hello",fromList [("world","!!!")])]
>>>
fromList [("hello",fromList [("world","!!!")])] & at "hello" . anon Map.empty Map.null . at "world" .~ Nothing
fromList []
non' :: APrism' a () -> Iso' (Maybe a) a #
generalizes non'
p
to take any unit non
(p # ())Prism
This function generates an isomorphism between
and Maybe
(a | isn't
p a)a
.
>>>
Map.singleton "hello" Map.empty & at "hello" . non' _Empty . at "world" ?~ "!!!"
fromList [("hello",fromList [("world","!!!")])]
>>>
fromList [("hello",fromList [("world","!!!")])] & at "hello" . non' _Empty . at "world" .~ Nothing
fromList []
non :: Eq a => a -> Iso' (Maybe a) a #
If v
is an element of a type a
, and a'
is a
sans the element v
, then
is an isomorphism from
non
v
to Maybe
a'a
.
non
≡non'
.
only
Keep in mind this is only a real isomorphism if you treat the domain as being
.Maybe
(a sans v)
This is practically quite useful when you want to have a Map
where all the entries should have non-zero values.
>>>
Map.fromList [("hello",1)] & at "hello" . non 0 +~ 2
fromList [("hello",3)]
>>>
Map.fromList [("hello",1)] & at "hello" . non 0 -~ 1
fromList []
>>>
Map.fromList [("hello",1)] ^. at "hello" . non 0
1
>>>
Map.fromList [] ^. at "hello" . non 0
0
This combinator is also particularly useful when working with nested maps.
e.g. When you want to create the nested Map
when it is missing:
>>>
Map.empty & at "hello" . non Map.empty . at "world" ?~ "!!!"
fromList [("hello",fromList [("world","!!!")])]
and when have deleting the last entry from the nested Map
mean that we
should delete its entry from the surrounding one:
>>>
fromList [("hello",fromList [("world","!!!")])] & at "hello" . non Map.empty . at "world" .~ Nothing
fromList []
It can also be used in reverse to exclude a given value:
>>>
non 0 # rem 10 4
Just 2
>>>
non 0 # rem 10 5
Nothing
enum :: Enum a => Iso' Int a #
This isomorphism can be used to convert to or from an instance of Enum
.
>>>
LT^.from enum
0
>>>
97^.enum :: Char
'a'
Note: this is only an isomorphism from the numeric range actually used
and it is a bit of a pleasant fiction, since there are questionable
Enum
instances for Double
, and Float
that exist solely for
[1.0 .. 4.0]
sugar and the instances for those and Integer
don't
cover all values in their range.
auf :: (Functor f, Functor g) => AnIso s t a b -> (f t -> g s) -> f b -> g a #
Based on ala'
from Conor McBride's work on Epigram.
This version is generalized to accept any Iso
, not just a newtype
.
For a version you pass the name of the newtype
constructor to, see alaf
.
>>>
auf (_Wrapping Sum) (foldMapOf both) Prelude.length ("hello","world")
10
Mnemonically, the German auf plays a similar role to à la, and the combinator
is au
with an extra function argument:
auf
::Iso
s t a b -> ((r -> t) -> e -> s) -> (r -> b) -> e -> a
but the signature is general.
Note: The direction of the Iso
required for this function changed in lens
4.18 to match up
with the behavior of au
. For the old behavior use xplatf
or for a version that is compatible
across both old and new versions of lens
you can just use coerce
!
au :: Functor f => AnIso s t a b -> ((b -> t) -> f s) -> f a #
Based on ala
from Conor McBride's work on Epigram.
This version is generalized to accept any Iso
, not just a newtype
.
>>>
au (_Wrapping Sum) foldMap [1,2,3,4]
10
You may want to think of this combinator as having the following, simpler type:
au :: AnIso s t a b -> ((b -> t) -> e -> s) -> e -> a
au = xplat . from
cloneIso :: AnIso s t a b -> Iso s t a b #
Convert from AnIso
back to any Iso
.
This is useful when you need to store an isomorphism as a data type inside a container and later reconstitute it as an overloaded function.
See cloneLens
or cloneTraversal
for more information on why you might want to do this.
withIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r #
Extract the two functions, one from s -> a
and
one from b -> t
that characterize an Iso
.
type AnIso s t a b = Exchange a b a (Identity b) -> Exchange a b s (Identity t) #
When you see this as an argument to a function, it expects an Iso
.
class Bifunctor p => Swapped (p :: Type -> Type -> Type) where #
This class provides for symmetric bifunctors.
Instances
Swapped Either | |
Swapped (,) | |
Defined in Control.Lens.Iso | |
Swapped ((,,) x) | |
Defined in Control.Lens.Iso | |
Swapped ((,,,) x y) | |
Defined in Control.Lens.Iso | |
Swapped ((,,,,) x y z) | |
Defined in Control.Lens.Iso | |
Swapped p => Swapped (Flip p) | |
Swapped ((,,,,,) x y z w) | |
Defined in Control.Lens.Iso | |
(Swapped p, Swapped q) => Swapped (Sum p q) | |
(Swapped f, Swapped g) => Swapped (Product f g) | |
Swapped ((,,,,,,) x y z w v) | |
Defined in Control.Lens.Iso | |
(Functor f, Swapped p) => Swapped (Tannen f p) | |
(f ~ g, Functor f, Swapped p) => Swapped (Biff p f g) | |
class Strict lazy strict | lazy -> strict, strict -> lazy where #
Ad hoc conversion between "strict" and "lazy" versions of a structure,
such as Text
or ByteString
.
withEquality :: AnEquality s t a b -> ((s :~: a) -> (b :~: t) -> r) -> r #
A version of substEq
that provides explicit, rather than implicit,
equality evidence.
fromLeibniz' :: ((s :~: s) -> s :~: a) -> Equality' s a #
fromLeibniz :: (Identical a b a b -> Identical a b s t) -> Equality s t a b #
Convert a "profunctor lens" form of equality to an equality. Reverses
overEquality
.
The type should be understood as
fromLeibniz :: (forall p. p a b -> p s t) -> Equality s t a b
underEquality :: AnEquality s t a b -> p t s -> p b a #
The opposite of working overEquality
is working underEquality
.
overEquality :: AnEquality s t a b -> p a b -> p s t #
Recover a "profunctor lens" form of equality. Reverses fromLeibniz
.
equality :: (s :~: a) -> (b :~: t) -> Equality s t a b #
Construct an Equality
from explicit equality evidence.
cloneEquality :: AnEquality s t a b -> Equality s t a b #
simply :: (Optic' p f s a -> r) -> Optic' p f s a -> r #
This is an adverb that can be used to modify many other Lens
combinators to make them require
simple lenses, simple traversals, simple prisms or simple isos as input.
fromEq :: AnEquality s t a b -> Equality b a t s #
Equality
is symmetric.
mapEq :: AnEquality s t a b -> f s -> f a #
We can use Equality
to do substitution into anything.
substEq :: AnEquality s t a b -> ((s ~ a) -> (t ~ b) -> r) -> r #
Substituting types with Equality
.
runEq :: AnEquality s t a b -> Identical s t a b #
Extract a witness of type Equality
.
data Identical (a :: k) (b :: k1) (s :: k) (t :: k1) :: forall k k1. k -> k1 -> k -> k1 -> Type where #
Provides witness that (s ~ a, b ~ t)
holds.
type AnEquality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = Identical a (Proxy b) a (Proxy b) -> Identical a (Proxy b) s (Proxy t) #
When you see this as an argument to a function, it expects an Equality
.
type AnEquality' (s :: k2) (a :: k2) = AnEquality s s a a #
A Simple
AnEquality
.
itraverseByOf :: IndexedTraversal i s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> s -> f t #
itraverseBy :: TraversableWithIndex i t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> t a -> f (t b) #
ifoldMapByOf :: IndexedFold i t a -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r #
ifoldMapBy :: FoldableWithIndex i t => (r -> r -> r) -> r -> (i -> a -> r) -> t a -> r #
imapAccumL :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b) #
Generalizes mapAccumL
to add access to the index.
imapAccumLOf
accumulates state from left to right.
mapAccumLOf
≡imapAccumL
.
const
imapAccumR :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b) #
Generalizes mapAccumR
to add access to the index.
imapAccumROf
accumulates state from right to left.
mapAccumR
≡imapAccumR
.
const
iforM :: (TraversableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m (t b) #
imapM :: (TraversableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m (t b) #
ifor :: (TraversableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f (t b) #
itoList :: FoldableWithIndex i f => f a -> [(i, a)] #
ifoldlM :: (FoldableWithIndex i f, Monad m) => (i -> b -> a -> m b) -> b -> f a -> m b #
ifoldrM :: (FoldableWithIndex i f, Monad m) => (i -> a -> b -> m b) -> b -> f a -> m b #
ifind :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Maybe (i, a) #
iconcatMap :: FoldableWithIndex i f => (i -> a -> [b]) -> f a -> [b] #
Concatenate the results of a function of the elements of an indexed container with access to the index.
When you don't need access to the index then concatMap
is more flexible in what it accepts.
concatMap
≡iconcatMap
.
const
iconcatMap
≡ifoldMap
iforM_ :: (FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m () #
Run monadic actions for each target of an IndexedFold
or IndexedTraversal
with access to the index,
discarding the results (with the arguments flipped).
iforM_
≡flip
imapM_
When you don't need access to the index then forMOf_
is more flexible in what it accepts.
forMOf_
l a ≡iforMOf
l a.
const
imapM_ :: (FoldableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m () #
Run monadic actions for each target of an IndexedFold
or IndexedTraversal
with access to the index,
discarding the results.
When you don't need access to the index then mapMOf_
is more flexible in what it accepts.
mapM_
≡imapM
.
const
ifor_ :: (FoldableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f () #
itraverse_ :: (FoldableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f () #
inone :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool #
iall :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool #
iany :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool #
index :: (Indexable i p, Eq i, Applicative f) => i -> Optical' p (Indexed i) f a a #
This allows you to filter an IndexedFold
, IndexedGetter
, IndexedTraversal
or IndexedLens
based on an index.
>>>
["hello","the","world","!!!"]^?traversed.index 2
Just "world"
indices :: (Indexable i p, Applicative f) => (i -> Bool) -> Optical' p (Indexed i) f a a #
This allows you to filter an IndexedFold
, IndexedGetter
, IndexedTraversal
or IndexedLens
based on a predicate
on the indices.
>>>
["hello","the","world","!!!"]^..traversed.indices even
["hello","world"]
>>>
over (traversed.indices (>0)) Prelude.reverse $ ["He","was","stressed","o_O"]
["He","saw","desserts","O_o"]
icompose :: Indexable p c => (i -> j -> p) -> (Indexed i s t -> r) -> (Indexed j a b -> s -> t) -> c a b -> r #
Composition of Indexed
functions with a user supplied function for combining indices.
selfIndex :: Indexable a p => p a fb -> a -> fb #
Use a value itself as its own index. This is essentially an indexed version of id
.
Note: When used to modify the value, this can break the index requirements assumed by indices
and similar,
so this is only properly an IndexedGetter
, but it can be used as more.
selfIndex
::IndexedGetter
a a b
(.>) :: (st -> r) -> (kab -> st) -> kab -> r infixr 9 #
Compose a non-indexed function with an Indexed
function.
Mnemonically, the >
points to the indexing we want to preserve.
This is the same as (
..
)
f
(and .
gf
) gives you the index of .>
gg
unless g
is index-preserving, like a
Prism
, Iso
or Equality
, in which case it'll pass through the index of f
.
>>>
let nestedMap = (fmap Map.fromList . Map.fromList) [(1, [(10, "one,ten"), (20, "one,twenty")]), (2, [(30, "two,thirty"), (40,"two,forty")])]
>>>
nestedMap^..(itraversed.>itraversed).withIndex
[(10,"one,ten"),(20,"one,twenty"),(30,"two,thirty"),(40,"two,forty")]
(<.) :: Indexable i p => (Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r infixr 9 #
Compose an Indexed
function with a non-indexed function.
Mnemonically, the <
points to the indexing we want to preserve.
>>>
let nestedMap = (fmap Map.fromList . Map.fromList) [(1, [(10, "one,ten"), (20, "one,twenty")]), (2, [(30, "two,thirty"), (40,"two,forty")])]
>>>
nestedMap^..(itraversed<.itraversed).withIndex
[(1,"one,ten"),(1,"one,twenty"),(2,"two,thirty"),(2,"two,forty")]
class Functor f => FunctorWithIndex i (f :: Type -> Type) | f -> i where #
A Functor
with an additional index.
Instances must satisfy a modified form of the Functor
laws:
imap
f.
imap
g ≡imap
(\i -> f i.
g i)imap
(\_ a -> a) ≡id
Nothing
imap :: (i -> a -> b) -> f a -> f b #
Map with access to the index.
imapped :: IndexedSetter i (f a) (f b) a b #
The IndexedSetter
for a FunctorWithIndex
.
If you don't need access to the index, then mapped
is more flexible in what it accepts.
Instances
class Foldable f => FoldableWithIndex i (f :: Type -> Type) | f -> i where #
A container that supports folding with an additional index.
Nothing
ifoldMap :: Monoid m => (i -> a -> m) -> f a -> m #
Fold a container by mapping value to an arbitrary Monoid
with access to the index i
.
When you don't need access to the index then foldMap
is more flexible in what it accepts.
foldMap
≡ifoldMap
.
const
ifolded :: IndexedFold i (f a) a #
The IndexedFold
of a FoldableWithIndex
container.
is a fold over the keys of a ifolded
.
asIndex
FoldableWithIndex
.
>>>
Data.Map.fromList [(2, "hello"), (1, "world")]^..ifolded.asIndex
[1,2]
ifoldr :: (i -> a -> b -> b) -> b -> f a -> b #
Right-associative fold of an indexed container with access to the index i
.
When you don't need access to the index then foldr
is more flexible in what it accepts.
foldr
≡ifoldr
.
const
ifoldl :: (i -> b -> a -> b) -> b -> f a -> b #
Left-associative fold of an indexed container with access to the index i
.
When you don't need access to the index then foldl
is more flexible in what it accepts.
foldl
≡ifoldl
.
const
Instances
FoldableWithIndex Int [] | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex Int ZipList | |
FoldableWithIndex Int NonEmpty | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex Int IntMap | |
FoldableWithIndex Int Seq | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex Int Vector | |
FoldableWithIndex () Maybe | |
FoldableWithIndex () Par1 | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex () Identity | |
FoldableWithIndex k (Map k) | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex k (HashMap k) | |
FoldableWithIndex k ((,) k) | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex i (Level i) | |
Ix i => FoldableWithIndex i (Array i) | |
FoldableWithIndex Void (V1 :: Type -> Type) | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex Void (U1 :: Type -> Type) | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex Void (Proxy :: Type -> Type) | |
FoldableWithIndex () (Tagged a) | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex i f => FoldableWithIndex i (Reverse f) | |
FoldableWithIndex i f => FoldableWithIndex i (Rec1 f) | |
FoldableWithIndex i m => FoldableWithIndex i (IdentityT m) | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex i f => FoldableWithIndex i (Backwards f) | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex i (Magma i t b) | |
Defined in Control.Lens.Indexed ifoldMap :: Monoid m => (i -> a -> m) -> Magma i t b a -> m # ifolded :: IndexedFold i (Magma i t b a) a # ifoldr :: (i -> a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 # ifoldl :: (i -> b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 # ifoldr' :: (i -> a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 # ifoldl' :: (i -> b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 # | |
FoldableWithIndex Void (K1 i c :: Type -> Type) | |
FoldableWithIndex [Int] Tree | |
FoldableWithIndex i f => FoldableWithIndex [i] (Free f) | |
FoldableWithIndex i f => FoldableWithIndex [i] (Cofree f) | |
Defined in Control.Lens.Indexed | |
(FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (Sum f g) | |
Defined in Control.Lens.Indexed ifoldMap :: Monoid m => (Either i j -> a -> m) -> Sum f g a -> m # ifolded :: IndexedFold (Either i j) (Sum f g a) a # ifoldr :: (Either i j -> a -> b -> b) -> b -> Sum f g a -> b # ifoldl :: (Either i j -> b -> a -> b) -> b -> Sum f g a -> b # ifoldr' :: (Either i j -> a -> b -> b) -> b -> Sum f g a -> b # ifoldl' :: (Either i j -> b -> a -> b) -> b -> Sum f g a -> b # | |
(FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (Product f g) | |
Defined in Control.Lens.Indexed ifoldMap :: Monoid m => (Either i j -> a -> m) -> Product f g a -> m # ifolded :: IndexedFold (Either i j) (Product f g a) a # ifoldr :: (Either i j -> a -> b -> b) -> b -> Product f g a -> b # ifoldl :: (Either i j -> b -> a -> b) -> b -> Product f g a -> b # ifoldr' :: (Either i j -> a -> b -> b) -> b -> Product f g a -> b # ifoldl' :: (Either i j -> b -> a -> b) -> b -> Product f g a -> b # | |
(FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (f :+: g) | |
Defined in Control.Lens.Indexed ifoldMap :: Monoid m => (Either i j -> a -> m) -> (f :+: g) a -> m # ifolded :: IndexedFold (Either i j) ((f :+: g) a) a # ifoldr :: (Either i j -> a -> b -> b) -> b -> (f :+: g) a -> b # ifoldl :: (Either i j -> b -> a -> b) -> b -> (f :+: g) a -> b # ifoldr' :: (Either i j -> a -> b -> b) -> b -> (f :+: g) a -> b # ifoldl' :: (Either i j -> b -> a -> b) -> b -> (f :+: g) a -> b # | |
(FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (f :*: g) | |
Defined in Control.Lens.Indexed ifoldMap :: Monoid m => (Either i j -> a -> m) -> (f :*: g) a -> m # ifolded :: IndexedFold (Either i j) ((f :*: g) a) a # ifoldr :: (Either i j -> a -> b -> b) -> b -> (f :*: g) a -> b # ifoldl :: (Either i j -> b -> a -> b) -> b -> (f :*: g) a -> b # ifoldr' :: (Either i j -> a -> b -> b) -> b -> (f :*: g) a -> b # ifoldl' :: (Either i j -> b -> a -> b) -> b -> (f :*: g) a -> b # | |
(FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) (Compose f g) | |
Defined in Control.Lens.Indexed ifoldMap :: Monoid m => ((i, j) -> a -> m) -> Compose f g a -> m # ifolded :: IndexedFold (i, j) (Compose f g a) a # ifoldr :: ((i, j) -> a -> b -> b) -> b -> Compose f g a -> b # ifoldl :: ((i, j) -> b -> a -> b) -> b -> Compose f g a -> b # ifoldr' :: ((i, j) -> a -> b -> b) -> b -> Compose f g a -> b # ifoldl' :: ((i, j) -> b -> a -> b) -> b -> Compose f g a -> b # | |
(FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) (f :.: g) | |
Defined in Control.Lens.Indexed ifoldMap :: Monoid m => ((i, j) -> a -> m) -> (f :.: g) a -> m # ifolded :: IndexedFold (i, j) ((f :.: g) a) a # ifoldr :: ((i, j) -> a -> b -> b) -> b -> (f :.: g) a -> b # ifoldl :: ((i, j) -> b -> a -> b) -> b -> (f :.: g) a -> b # ifoldr' :: ((i, j) -> a -> b -> b) -> b -> (f :.: g) a -> b # ifoldl' :: ((i, j) -> b -> a -> b) -> b -> (f :.: g) a -> b # |
class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i (t :: Type -> Type) | t -> i where #
A Traversable
with an additional index.
An instance must satisfy a (modified) form of the Traversable
laws:
itraverse
(const
Identity
) ≡Identity
fmap
(itraverse
f).
itraverse
g ≡getCompose
.
itraverse
(\i ->Compose
.
fmap
(f i).
g i)
Nothing
itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b) #
Traverse an indexed container.
itraverse
≡itraverseOf
itraversed
itraversed :: IndexedTraversal i (t a) (t b) a b #
The IndexedTraversal
of a TraversableWithIndex
container.
Instances
newtype ReifiedLens s t a b #
Reify a ReifiedLens
so it can be stored safely in a container.
type ReifiedLens' s a = ReifiedLens s s a a #
typeReifiedLens'
=Simple
ReifiedLens
newtype ReifiedIndexedLens i s t a b #
Reify an ReifiedIndexedLens
so it can be stored safely in a container.
IndexedLens | |
|
type ReifiedIndexedLens' i s a = ReifiedIndexedLens i s s a a #
typeReifiedIndexedLens'
i =Simple
(ReifiedIndexedLens
i)
newtype ReifiedIndexedTraversal i s t a b #
Reify an ReifiedIndexedTraversal
so it can be stored safely in a container.
IndexedTraversal | |
|
type ReifiedIndexedTraversal' i s a = ReifiedIndexedTraversal i s s a a #
typeReifiedIndexedTraversal'
i =Simple
(ReifiedIndexedTraversal
i)
newtype ReifiedTraversal s t a b #
A form of ReifiedTraversal
that can be stored monomorphically in a container.
Traversal | |
|
type ReifiedTraversal' s a = ReifiedTraversal s s a a #
newtype ReifiedGetter s a #
Reify a ReifiedGetter
so it can be stored safely in a container.
This can also be useful when combining getters in novel ways, as
ReifiedGetter
is isomorphic to '(->)' and provides similar instances.
>>>
("hello","world","!!!")^.runGetter ((,) <$> Getter _2 <*> Getter (_1.to length))
("world",5)
Instances
newtype ReifiedIndexedGetter i s a #
Reify an ReifiedIndexedGetter
so it can be stored safely in a container.
IndexedGetter | |
|
Instances
newtype ReifiedFold s a #
Reify a ReifiedFold
so it can be stored safely in a container.
This can also be useful for creatively combining folds as
is isomorphic to ReifiedFold
sReaderT s []
and provides similar
instances.
>>>
("hello","world")^..runFold ((,) <$> Fold _2 <*> Fold both)
[("world","hello"),("world","world")]
Instances
newtype ReifiedIndexedFold i s a #
IndexedFold | |
|
Instances
newtype ReifiedSetter s t a b #
Reify a ReifiedSetter
so it can be stored safely in a container.
type ReifiedSetter' s a = ReifiedSetter s s a a #
typeReifiedSetter'
=Simple
ReifiedSetter
newtype ReifiedIndexedSetter i s t a b #
Reify an ReifiedIndexedSetter
so it can be stored safely in a container.
IndexedSetter | |
|
type ReifiedIndexedSetter' i s a = ReifiedIndexedSetter i s s a a #
typeReifiedIndexedSetter'
i =Simple
(ReifiedIndexedSetter
i)
newtype ReifiedIso s t a b #
Reify an ReifiedIso
so it can be stored safely in a container.
type ReifiedIso' s a = ReifiedIso s s a a #
typeReifiedIso'
=Simple
ReifiedIso
newtype ReifiedPrism s t a b #
Reify a ReifiedPrism
so it can be stored safely in a container.
type ReifiedPrism' s a = ReifiedPrism s s a a #
typeReifiedPrism'
=Simple
ReifiedPrism
ilevels :: Applicative f => Traversing (Indexed i) f s t a b -> IndexedLensLike Int f s t (Level i a) (Level j b) #
This provides a breadth-first Traversal
or Fold
of the individual
levels of any other Traversal
or Fold
via iterative deepening depth-first
search. The levels are returned to you in a compressed format.
This is similar to levels
, but retains the index of the original IndexedTraversal
, so you can
access it when traversing the levels later on.
>>>
["dog","cat"]^@..ilevels (traversed<.>traversed).itraversed
[((0,0),'d'),((0,1),'o'),((1,0),'c'),((0,2),'g'),((1,1),'a'),((1,2),'t')]
The resulting Traversal
of the levels which is indexed by the depth of each Level
.
>>>
["dog","cat"]^@..ilevels (traversed<.>traversed)<.>itraversed
[((2,(0,0)),'d'),((3,(0,1)),'o'),((3,(1,0)),'c'),((4,(0,2)),'g'),((4,(1,1)),'a'),((5,(1,2)),'t')]
ilevels
::IndexedTraversal
i s t a b ->IndexedTraversal
Int
s t (Level
i a) (Level
i b)ilevels
::IndexedFold
i s a ->IndexedFold
Int
s (Level
i a)
Note: Internally this is implemented by using an illegal Applicative
, as it extracts information
in an order that violates the Applicative
laws.
levels :: Applicative f => Traversing ((->) :: Type -> Type -> Type) f s t a b -> IndexedLensLike Int f s t (Level () a) (Level () b) #
This provides a breadth-first Traversal
or Fold
of the individual
levels
of any other Traversal
or Fold
via iterative deepening
depth-first search. The levels are returned to you in a compressed format.
This can permit us to extract the levels
directly:
>>>
["hello","world"]^..levels (traverse.traverse)
[Zero,Zero,One () 'h',Two 0 (One () 'e') (One () 'w'),Two 0 (One () 'l') (One () 'o'),Two 0 (One () 'l') (One () 'r'),Two 0 (One () 'o') (One () 'l'),One () 'd']
But we can also traverse them in turn:
>>>
["hello","world"]^..levels (traverse.traverse).traverse
"hewlolrold"
We can use this to traverse to a fixed depth in the tree of (<*>
) used in the Traversal
:
>>>
["hello","world"] & taking 4 (levels (traverse.traverse)).traverse %~ toUpper
["HEllo","World"]
Or we can use it to traverse the first n
elements in found in that Traversal
regardless of the depth
at which they were found.
>>>
["hello","world"] & taking 4 (levels (traverse.traverse).traverse) %~ toUpper
["HELlo","World"]
The resulting Traversal
of the levels
which is indexed by the depth of each Level
.
>>>
["dog","cat"]^@..levels (traverse.traverse) <. traverse
[(2,'d'),(3,'o'),(3,'c'),(4,'g'),(4,'a'),(5,'t')]
levels
::Traversal
s t a b ->IndexedTraversal
Int
s t (Level
() a) (Level
() b)levels
::Fold
s a ->IndexedFold
Int
s (Level
() a)
Note: Internally this is implemented by using an illegal Applicative
, as it extracts information
in an order that violates the Applicative
laws.
sequenceByOf :: Traversal s t (f b) b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> s -> f t #
Sequence a container using a specified Applicative
.
This is like traverseBy
where the Traversable
instance can be specified by any Traversal
sequenceByOf
traverse
≡sequenceBy
traverseByOf :: Traversal s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t #
Traverse a container using a specified Applicative
.
This is like traverseBy
where the Traversable
instance can be specified by any Traversal
traverseByOf
traverse
≡traverseBy
confusing :: Applicative f => LensLike (Curried (Yoneda f) (Yoneda f)) s t a b -> LensLike f s t a b #
Fuse a Traversal
by reassociating all of the (
operations to the
left and fusing all of the <*>
)fmap
calls into one. This is particularly
useful when constructing a Traversal
using operations from GHC.Generics.
Given a pair of Traversal
s foo
and bar
,
confusing
(foo.bar) = foo.bar
However, foo
and bar
are each going to use the Applicative
they are given.
confusing
exploits the Yoneda
lemma to merge their separate uses of fmap
into a single fmap
.
and it further exploits an interesting property of the right Kan lift (or Curried
) to left associate
all of the uses of (
to make it possible to fuse together more fmaps.<*>
)
This is particularly effective when the choice of functor f
is unknown at compile
time or when the Traversal
foo.bar
in the above description is recursive or complex
enough to prevent inlining.
fusing
is a version of this combinator suitable for fusing lenses.
confusing
::Traversal
s t a b ->Traversal
s t a b
deepOf :: (Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b #
Try the second traversal. If it returns no entries, try again with all entries from the first traversal, recursively.
deepOf
::Fold
s s ->Fold
s a ->Fold
s adeepOf
::Traversal'
s s ->Traversal'
s a ->Traversal'
s adeepOf
::Traversal
s t s t ->Traversal
s t a b ->Traversal
s t a bdeepOf
::Fold
s s ->IndexedFold
i s a ->IndexedFold
i s adeepOf
::Traversal
s t s t ->IndexedTraversal
i s t a b ->IndexedTraversal
i s t a b
failing :: (Conjoined p, Applicative f) => Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b infixl 5 #
Try the first Traversal
(or Fold
), falling back on the second Traversal
(or Fold
) if it returns no entries.
This is only a valid Traversal
if the second Traversal
is disjoint from the result of the first or returns
exactly the same results. These conditions are trivially met when given a Lens
, Iso
, Getter
, Prism
or "affine" Traversal -- one that
has 0 or 1 target.
Mutatis mutandis for Fold
.
>>>
[0,1,2,3] ^? failing (ix 1) (ix 2)
Just 1
>>>
[0,1,2,3] ^? failing (ix 42) (ix 2)
Just 2
failing
::Traversal
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Prism
s t a b ->Prism
s t a b ->Traversal
s t a bfailing
::Fold
s a ->Fold
s a ->Fold
s a
These cases are also supported, trivially, but are boring, because the left hand side always succeeds.
failing
::Lens
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Iso
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Equality
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Getter
s a ->Fold
s a ->Fold
s a
If both of the inputs are indexed, the result is also indexed, so you can apply this to a pair of indexed traversals or indexed folds, obtaining an indexed traversal or indexed fold.
failing
::IndexedTraversal
i s t a b ->IndexedTraversal
i s t a b ->IndexedTraversal
i s t a bfailing
::IndexedFold
i s a ->IndexedFold
i s a ->IndexedFold
i s a
These cases are also supported, trivially, but are boring, because the left hand side always succeeds.
failing
::IndexedLens
i s t a b ->IndexedTraversal
i s t a b ->IndexedTraversal
i s t a bfailing
::IndexedGetter
i s a ->IndexedGetter
i s a ->IndexedFold
i s a
ifailover :: Alternative m => Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t #
Try to map a function which uses the index over this IndexedTraversal
, failing if the IndexedTraversal
has no targets.
ifailover
:: Alternative m => IndexedTraversal i s t a b -> (i -> a -> b) -> s -> m t
failover :: Alternative m => LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t #
Try to map a function over this Traversal
, failing if the Traversal
has no targets.
>>>
failover (element 3) (*2) [1,2] :: Maybe [Int]
Nothing
>>>
failover _Left (*2) (Right 4) :: Maybe (Either Int Int)
Nothing
>>>
failover _Right (*2) (Right 4) :: Maybe (Either Int Int)
Just (Right 8)
failover
:: Alternative m => Traversal s t a b -> (a -> b) -> s -> m t
elements :: Traversable t => (Int -> Bool) -> IndexedTraversal' Int (t a) a #
Traverse elements of a Traversable
container where their ordinal positions match a predicate.
elements
≡elementsOf
traverse
elementsOf :: Applicative f => LensLike (Indexing f) s t a a -> (Int -> Bool) -> IndexedLensLike Int f s t a a #
Traverse (or fold) selected elements of a Traversal
(or Fold
) where their ordinal positions match a predicate.
elementsOf
::Traversal'
s a -> (Int
->Bool
) ->IndexedTraversal'
Int
s aelementsOf
::Fold
s a -> (Int
->Bool
) ->IndexedFold
Int
s a
element :: Traversable t => Int -> IndexedTraversal' Int (t a) a #
Traverse the nth element of a Traversable
container.
element
≡elementOf
traverse
elementOf :: Applicative f => LensLike (Indexing f) s t a a -> Int -> IndexedLensLike Int f s t a a #
Traverse the nth elementOf
a Traversal
, Lens
or
Iso
if it exists.
>>>
[[1],[3,4]] & elementOf (traverse.traverse) 1 .~ 5
[[1],[5,4]]
>>>
[[1],[3,4]] ^? elementOf (folded.folded) 1
Just 3
>>>
timingOut $ ['a'..] ^?! elementOf folded 5
'f'
>>>
timingOut $ take 10 $ elementOf traverse 3 .~ 16 $ [0..]
[0,1,2,16,4,5,6,7,8,9]
elementOf
::Traversal'
s a ->Int
->IndexedTraversal'
Int
s aelementOf
::Fold
s a ->Int
->IndexedFold
Int
s a
ignored :: Applicative f => pafb -> s -> f s #
traversed64 :: Traversable f => IndexedTraversal Int64 (f a) (f b) a b #
Traverse any Traversable
container. This is an IndexedTraversal
that is indexed by ordinal position.
traversed1 :: Traversable1 f => IndexedTraversal1 Int (f a) (f b) a b #
Traverse any Traversable1
container. This is an IndexedTraversal1
that is indexed by ordinal position.
traversed :: Traversable f => IndexedTraversal Int (f a) (f b) a b #
Traverse any Traversable
container. This is an IndexedTraversal
that is indexed by ordinal position.
imapAccumLOf :: Over (Indexed i) (State acc) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) #
Generalizes mapAccumL
to an arbitrary IndexedTraversal
with access to the index.
imapAccumLOf
accumulates state from left to right.
mapAccumLOf
l ≡imapAccumLOf
l.
const
imapAccumLOf
::IndexedLens
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)imapAccumLOf
::IndexedTraversal
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumROf :: Over (Indexed i) (Backwards (State acc)) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) #
Generalizes mapAccumR
to an arbitrary IndexedTraversal
with access to the index.
imapAccumROf
accumulates state from right to left.
mapAccumROf
l ≡imapAccumROf
l.
const
imapAccumROf
::IndexedLens
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)imapAccumROf
::IndexedTraversal
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
iforMOf :: (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t) -> s -> (i -> a -> m b) -> m t #
Map each element of a structure targeted by a Lens
to a monadic action,
evaluate these actions from left to right, and collect the results, with access
its position (and the arguments flipped).
forMOf
l a ≡iforMOf
l a.
const
iforMOf
≡flip
.
imapMOf
iforMOf
::Monad
m =>IndexedLens
i s t a b -> s -> (i -> a -> m b) -> m tiforMOf
::Monad
m =>IndexedTraversal
i s t a b -> s -> (i -> a -> m b) -> m t
imapMOf :: Over (Indexed i) (WrappedMonad m) s t a b -> (i -> a -> m b) -> s -> m t #
Map each element of a structure targeted by a Lens
to a monadic action,
evaluate these actions from left to right, and collect the results, with access
its position.
When you don't need access to the index mapMOf
is more liberal in what it can accept.
mapMOf
l ≡imapMOf
l.
const
imapMOf
::Monad
m =>IndexedLens
i s t a b -> (i -> a -> m b) -> s -> m timapMOf
::Monad
m =>IndexedTraversal
i s t a b -> (i -> a -> m b) -> s -> m timapMOf
::Bind
m =>IndexedTraversal1
i s t a b -> (i -> a -> m b) -> s -> m t
iforOf :: (Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t #
Traverse with an index (and the arguments flipped).
forOf
l a ≡iforOf
l a.
const
iforOf
≡flip
.
itraverseOf
iforOf
::Functor
f =>IndexedLens
i s t a b -> s -> (i -> a -> f b) -> f tiforOf
::Applicative
f =>IndexedTraversal
i s t a b -> s -> (i -> a -> f b) -> f tiforOf
::Apply
f =>IndexedTraversal1
i s t a b -> s -> (i -> a -> f b) -> f t
itraverseOf :: (Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t #
Traversal with an index.
NB: When you don't need access to the index then you can just apply your IndexedTraversal
directly as a function!
itraverseOf
≡withIndex
traverseOf
l =itraverseOf
l.
const
=id
itraverseOf
::Functor
f =>IndexedLens
i s t a b -> (i -> a -> f b) -> s -> f titraverseOf
::Applicative
f =>IndexedTraversal
i s t a b -> (i -> a -> f b) -> s -> f titraverseOf
::Apply
f =>IndexedTraversal1
i s t a b -> (i -> a -> f b) -> s -> f t
cloneIndexedTraversal1 :: AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b #
Clone an IndexedTraversal1
yielding an IndexedTraversal1
with the same index.
cloneIndexPreservingTraversal1 :: ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b #
Clone a Traversal1
yielding an IndexPreservingTraversal1
that passes through
whatever index it is composed with.
cloneTraversal1 :: ATraversal1 s t a b -> Traversal1 s t a b #
A Traversal1
is completely characterized by its behavior on a Bazaar1
.
cloneIndexedTraversal :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b #
Clone an IndexedTraversal
yielding an IndexedTraversal
with the same index.
cloneIndexPreservingTraversal :: ATraversal s t a b -> IndexPreservingTraversal s t a b #
Clone a Traversal
yielding an IndexPreservingTraversal
that passes through
whatever index it is composed with.
cloneTraversal :: ATraversal s t a b -> Traversal s t a b #
A Traversal
is completely characterized by its behavior on a Bazaar
.
Cloning a Traversal
is one way to make sure you aren't given
something weaker, such as a Fold
and can be
used as a way to pass around traversals that have to be monomorphic in f
.
Note: This only accepts a proper Traversal
(or Lens
). To clone a Lens
as such, use cloneLens
.
Note: It is usually better to use ReifiedTraversal
and
runTraversal
than to cloneTraversal
. The
former can execute at full speed, while the latter needs to round trip through
the Bazaar
.
>>>
let foo l a = (view (getting (cloneTraversal l)) a, set (cloneTraversal l) 10 a)
>>>
foo both ("hello","world")
("helloworld",(10,10))
cloneTraversal
::LensLike
(Bazaar
(->) a b) s t a b ->Traversal
s t a b
dropping :: (Conjoined p, Applicative f) => Int -> Over p (Indexing f) s t a a -> Over p f s t a a #
Visit all but the first n targets of a Traversal
, Fold
, Getter
or Lens
.
>>>
("hello","world") ^? dropping 1 both
Just "world"
Dropping works on infinite traversals as well:
>>>
[1..] ^? dropping 1 folded
Just 2
dropping
::Int
->Traversal'
s a ->Traversal'
s adropping
::Int
->Lens'
s a ->Traversal'
s adropping
::Int
->Iso'
s a ->Traversal'
s adropping
::Int
->Prism'
s a ->Traversal'
s adropping
::Int
->Getter
s a ->Fold
s adropping
::Int
->Fold
s a ->Fold
s adropping
::Int
->IndexedTraversal'
i s a ->IndexedTraversal'
i s adropping
::Int
->IndexedLens'
i s a ->IndexedTraversal'
i s adropping
::Int
->IndexedGetter
i s a ->IndexedFold
i s adropping
::Int
->IndexedFold
i s a ->IndexedFold
i s a
taking :: (Conjoined p, Applicative f) => Int -> Traversing p f s t a a -> Over p f s t a a #
Visit the first n targets of a Traversal
, Fold
, Getter
or Lens
.
>>>
[("hello","world"),("!!!","!!!")]^.. taking 2 (traverse.both)
["hello","world"]
>>>
timingOut $ [1..] ^.. taking 3 traverse
[1,2,3]
>>>
over (taking 5 traverse) succ "hello world"
"ifmmp world"
taking
::Int
->Traversal'
s a ->Traversal'
s ataking
::Int
->Lens'
s a ->Traversal'
s ataking
::Int
->Iso'
s a ->Traversal'
s ataking
::Int
->Prism'
s a ->Traversal'
s ataking
::Int
->Getter
s a ->Fold
s ataking
::Int
->Fold
s a ->Fold
s ataking
::Int
->IndexedTraversal'
i s a ->IndexedTraversal'
i s ataking
::Int
->IndexedLens'
i s a ->IndexedTraversal'
i s ataking
::Int
->IndexedGetter
i s a ->IndexedFold
i s ataking
::Int
->IndexedFold
i s a ->IndexedFold
i s a
beside :: (Representable q, Applicative (Rep q), Applicative f, Bitraversable r) => Optical p q f s t a b -> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b #
Apply a different Traversal
or Fold
to each side of a Bitraversable
container.
beside
::Traversal
s t a b ->Traversal
s' t' a b ->Traversal
(r s s') (r t t') a bbeside
::IndexedTraversal
i s t a b ->IndexedTraversal
i s' t' a b ->IndexedTraversal
i (r s s') (r t t') a bbeside
::IndexPreservingTraversal
s t a b ->IndexPreservingTraversal
s' t' a b ->IndexPreservingTraversal
(r s s') (r t t') a b
beside
::Traversal
s t a b ->Traversal
s' t' a b ->Traversal
(s,s') (t,t') a bbeside
::Lens
s t a b ->Lens
s' t' a b ->Traversal
(s,s') (t,t') a bbeside
::Fold
s a ->Fold
s' a ->Fold
(s,s') abeside
::Getter
s a ->Getter
s' a ->Fold
(s,s') a
beside
::IndexedTraversal
i s t a b ->IndexedTraversal
i s' t' a b ->IndexedTraversal
i (s,s') (t,t') a bbeside
::IndexedLens
i s t a b ->IndexedLens
i s' t' a b ->IndexedTraversal
i (s,s') (t,t') a bbeside
::IndexedFold
i s a ->IndexedFold
i s' a ->IndexedFold
i (s,s') abeside
::IndexedGetter
i s a ->IndexedGetter
i s' a ->IndexedFold
i (s,s') a
beside
::IndexPreservingTraversal
s t a b ->IndexPreservingTraversal
s' t' a b ->IndexPreservingTraversal
(s,s') (t,t') a bbeside
::IndexPreservingLens
s t a b ->IndexPreservingLens
s' t' a b ->IndexPreservingTraversal
(s,s') (t,t') a bbeside
::IndexPreservingFold
s a ->IndexPreservingFold
s' a ->IndexPreservingFold
(s,s') abeside
::IndexPreservingGetter
s a ->IndexPreservingGetter
s' a ->IndexPreservingFold
(s,s') a
>>>
("hello",["world","!!!"])^..beside id traverse
["hello","world","!!!"]
both1 :: Bitraversable1 r => Traversal1 (r a a) (r b b) a b #
Traverse both parts of a Bitraversable1
container with matching types.
Usually that type will be a pair.
both1
::Traversal1
(a, a) (b, b) a bboth1
::Traversal1
(Either
a a) (Either
b b) a b
both :: Bitraversable r => Traversal (r a a) (r b b) a b #
Traverse both parts of a Bitraversable
container with matching types.
Usually that type will be a pair. Use each
to traverse
the elements of arbitrary homogeneous tuples.
>>>
(1,2) & both *~ 10
(10,20)
>>>
over both length ("hello","world")
(5,5)
>>>
("hello","world")^.both
"helloworld"
both
::Traversal
(a, a) (b, b) a bboth
::Traversal
(Either
a a) (Either
b b) a b
holes1Of :: Conjoined p => Over p (Bazaar1 p a a) s t a a -> s -> NonEmpty (Pretext p a a t) #
The non-empty version of holesOf
.
This extract a non-empty list of immediate children accroding to a given
Traversal1
as editable contexts.
>>>
let head1 f s = runPretext (NonEmpty.head $ holes1Of traversed1 s) f
>>>
('a' :| "bc") ^. head1
'a'
>>>
('a' :| "bc") & head1 %~ toUpper
'A' :| "bc"
holes1Of
::Iso'
s a -> s ->NonEmpty
(Pretext'
(->) a s)holes1Of
::Lens'
s a -> s ->NonEmpty
(Pretext'
(->) a s)holes1Of
::Traversal1'
s a -> s ->NonEmpty
(Pretext'
(->) a s)holes1Of
::IndexedLens'
i s a -> s ->NonEmpty
(Pretext'
(Indexed
i) a s)holes1Of
::IndexedTraversal1'
i s a -> s ->NonEmpty
(Pretext'
(Indexed
i) a s)
holesOf :: Conjoined p => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t] #
The one-level version of contextsOf
. This extracts a
list of the immediate children according to a given Traversal
as editable
contexts.
Given a context you can use pos
to see the
values, peek
at what the structure would be
like with an edited result, or simply extract
the original structure.
propChildren l x =toListOf
l x==
map
pos
(holesOf
l x) propId l x =all
(==
x) [extract
w | w <-holesOf
l x]
holesOf
::Iso'
s a -> s -> [Pretext'
(->) a s]holesOf
::Lens'
s a -> s -> [Pretext'
(->) a s]holesOf
::Traversal'
s a -> s -> [Pretext'
(->) a s]holesOf
::IndexedLens'
i s a -> s -> [Pretext'
(Indexed
i) a s]holesOf
::IndexedTraversal'
i s a -> s -> [Pretext'
(Indexed
i) a s]
unsafeSingular :: (HasCallStack, Conjoined p, Functor f) => Traversing p f s t a b -> Over p f s t a b #
This converts a Traversal
that you "know" will target only one element to a Lens
. It can also be
used to transform a Fold
into a Getter
.
The resulting Lens
or Getter
will be partial if the Traversal
targets nothing
or more than one element.
>>>
Left (ErrorCall "unsafeSingular: empty traversal") <- try (evaluate ([] & unsafeSingular traverse .~ 0)) :: IO (Either ErrorCall [Integer])
unsafeSingular
::Traversal
s t a b ->Lens
s t a bunsafeSingular
::Fold
s a ->Getter
s aunsafeSingular
::IndexedTraversal
i s t a b ->IndexedLens
i s t a bunsafeSingular
::IndexedFold
i s a ->IndexedGetter
i s a
singular :: (HasCallStack, Conjoined p, Functor f) => Traversing p f s t a a -> Over p f s t a a #
This converts a Traversal
that you "know" will target one or more elements to a Lens
. It can
also be used to transform a non-empty Fold
into a Getter
.
The resulting Lens
or Getter
will be partial if the supplied Traversal
returns
no results.
>>>
[1,2,3] ^. singular _head
1
>>>
Left (ErrorCall "singular: empty traversal") <- try (evaluate ([] ^. singular _head)) :: IO (Either ErrorCall ())
>>>
Left 4 ^. singular _Left
4
>>>
[1..10] ^. singular (ix 7)
8
>>>
[] & singular traverse .~ 0
[]
singular
::Traversal
s t a a ->Lens
s t a asingular
::Fold
s a ->Getter
s asingular
::IndexedTraversal
i s t a a ->IndexedLens
i s t a asingular
::IndexedFold
i s a ->IndexedGetter
i s a
iunsafePartsOf' :: Over (Indexed i) (Bazaar (Indexed i) a b) s t a b -> IndexedLens [i] s t [a] [b] #
unsafePartsOf' :: ATraversal s t a b -> Lens s t [a] [b] #
iunsafePartsOf :: (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a b -> Over p f s t [a] [b] #
An indexed version of unsafePartsOf
that receives the entire list of indices as its index.
unsafePartsOf :: Functor f => Traversing ((->) :: Type -> Type -> Type) f s t a b -> LensLike f s t [a] [b] #
unsafePartsOf
turns a Traversal
into a uniplate
(or biplate
) family.
If you do not need the types of s
and t
to be different, it is recommended that
you use partsOf
.
It is generally safer to traverse with the Bazaar
rather than use this
combinator. However, it is sometimes convenient.
This is unsafe because if you don't supply at least as many b
's as you were
given a
's, then the reconstruction of t
will result in an error!
When applied to a Fold
the result is merely a Getter
(and becomes safe).
unsafePartsOf
::Iso
s t a b ->Lens
s t [a] [b]unsafePartsOf
::Lens
s t a b ->Lens
s t [a] [b]unsafePartsOf
::Traversal
s t a b ->Lens
s t [a] [b]unsafePartsOf
::Fold
s a ->Getter
s [a]unsafePartsOf
::Getter
s a ->Getter
s [a]
ipartsOf' :: (Indexable [i] p, Functor f) => Over (Indexed i) (Bazaar' (Indexed i) a) s t a a -> Over p f s t [a] [a] #
A type-restricted version of ipartsOf
that can only be used with an IndexedTraversal
.
partsOf' :: ATraversal s t a a -> Lens s t [a] [a] #
ipartsOf :: (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a a -> Over p f s t [a] [a] #
An indexed version of partsOf
that receives the entire list of indices as its index.
partsOf :: Functor f => Traversing ((->) :: Type -> Type -> Type) f s t a a -> LensLike f s t [a] [a] #
partsOf
turns a Traversal
into a Lens
that resembles an early version of the uniplate
(or biplate
) type.
Note: You should really try to maintain the invariant of the number of children in the list.
>>>
(a,b,c) & partsOf each .~ [x,y,z]
(x,y,z)
Any extras will be lost. If you do not supply enough, then the remainder will come from the original structure.
>>>
(a,b,c) & partsOf each .~ [w,x,y,z]
(w,x,y)
>>>
(a,b,c) & partsOf each .~ [x,y]
(x,y,c)
>>>
('b', 'a', 'd', 'c') & partsOf each %~ sort
('a','b','c','d')
So technically, this is only a Lens
if you do not change the number of results it returns.
When applied to a Fold
the result is merely a Getter
.
partsOf
::Iso'
s a ->Lens'
s [a]partsOf
::Lens'
s a ->Lens'
s [a]partsOf
::Traversal'
s a ->Lens'
s [a]partsOf
::Fold
s a ->Getter
s [a]partsOf
::Getter
s a ->Getter
s [a]
iloci :: IndexedTraversal i (Bazaar (Indexed i) a c s) (Bazaar (Indexed i) b c s) a b #
This IndexedTraversal
allows you to traverse
the individual stores in
a Bazaar
with access to their indices.
loci :: Traversal (Bazaar ((->) :: Type -> Type -> Type) a c s) (Bazaar ((->) :: Type -> Type -> Type) b c s) a b #
mapAccumLOf :: LensLike (State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) #
This generalizes mapAccumL
to an arbitrary Traversal
.
mapAccumL
≡mapAccumLOf
traverse
mapAccumLOf
accumulates State
from left to right.
mapAccumLOf
::Iso
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumLOf
::Lens
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumLOf
::Traversal
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf
::LensLike
(State
acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumLOf
l f acc0 s =swap
(runState
(l (a ->state
(acc ->swap
(f acc a))) s) acc0)
mapAccumROf :: LensLike (Backwards (State acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) #
This generalizes mapAccumR
to an arbitrary Traversal
.
mapAccumR
≡mapAccumROf
traverse
mapAccumROf
accumulates State
from right to left.
mapAccumROf
::Iso
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumROf
::Lens
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumROf
::Traversal
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumROf
::LensLike
(Backwards
(State
acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
transposeOf :: LensLike ZipList s t [a] a -> s -> [t] #
This generalizes transpose
to an arbitrary Traversal
.
Note: transpose
handles ragged inputs more intelligently, but for non-ragged inputs:
>>>
transposeOf traverse [[1,2,3],[4,5,6]]
[[1,4],[2,5],[3,6]]
transpose
≡transposeOf
traverse
Since every Lens
is a Traversal
, we can use this as a form of
monadic strength as well:
transposeOf
_2
:: (b, [a]) -> [(b, a)]
sequenceOf :: LensLike (WrappedMonad m) s t (m b) b -> s -> m t #
Sequence the (monadic) effects targeted by a Lens
in a container from left to right.
>>>
sequenceOf each ([1,2],[3,4],[5,6])
[(1,3,5),(1,3,6),(1,4,5),(1,4,6),(2,3,5),(2,3,6),(2,4,5),(2,4,6)]
sequence
≡sequenceOf
traverse
sequenceOf
l ≡mapMOf
lid
sequenceOf
l ≡unwrapMonad
.
lWrapMonad
sequenceOf
::Monad
m =>Iso
s t (m b) b -> s -> m tsequenceOf
::Monad
m =>Lens
s t (m b) b -> s -> m tsequenceOf
::Monad
m =>Traversal
s t (m b) b -> s -> m t
forMOf :: LensLike (WrappedMonad m) s t a b -> s -> (a -> m b) -> m t #
forMOf
is a flipped version of mapMOf
, consistent with the definition of forM
.
>>>
forMOf both (1,3) $ \x -> [x, x + 1]
[(1,3),(1,4),(2,3),(2,4)]
forM
≡forMOf
traverse
forMOf
l ≡flip
(mapMOf
l)iforMOf
l s ≡forM
l s.
Indexed
forMOf
::Monad
m =>Iso
s t a b -> s -> (a -> m b) -> m tforMOf
::Monad
m =>Lens
s t a b -> s -> (a -> m b) -> m tforMOf
::Monad
m =>Traversal
s t a b -> s -> (a -> m b) -> m t
mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t #
Map each element of a structure targeted by a Lens
to a monadic action,
evaluate these actions from left to right, and collect the results.
>>>
mapMOf both (\x -> [x, x + 1]) (1,3)
[(1,3),(1,4),(2,3),(2,4)]
mapM
≡mapMOf
traverse
imapMOf
l ≡forM
l.
Indexed
mapMOf
::Monad
m =>Iso
s t a b -> (a -> m b) -> s -> m tmapMOf
::Monad
m =>Lens
s t a b -> (a -> m b) -> s -> m tmapMOf
::Monad
m =>Traversal
s t a b -> (a -> m b) -> s -> m t
sequenceAOf :: LensLike f s t (f b) b -> s -> f t #
Evaluate each action in the structure from left to right, and collect the results.
>>>
sequenceAOf both ([1,2],[3,4])
[(1,3),(1,4),(2,3),(2,4)]
sequenceA
≡sequenceAOf
traverse
≡traverse
id
sequenceAOf
l ≡traverseOf
lid
≡ lid
sequenceAOf
::Functor
f =>Iso
s t (f b) b -> s -> f tsequenceAOf
::Functor
f =>Lens
s t (f b) b -> s -> f tsequenceAOf
::Applicative
f =>Traversal
s t (f b) b -> s -> f t
forOf :: LensLike f s t a b -> s -> (a -> f b) -> f t #
A version of traverseOf
with the arguments flipped, such that:
>>>
forOf each (1,2,3) print
1 2 3 ((),(),())
This function is only provided for consistency, flip
is strictly more general.
forOf
≡flip
forOf
≡flip
.traverseOf
for
≡forOf
traverse
ifor
l s ≡for
l s.
Indexed
forOf
::Functor
f =>Iso
s t a b -> s -> (a -> f b) -> f tforOf
::Functor
f =>Lens
s t a b -> s -> (a -> f b) -> f tforOf
::Applicative
f =>Traversal
s t a b -> s -> (a -> f b) -> f t
traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t #
Map each element of a structure targeted by a Lens
or Traversal
,
evaluate these actions from left to right, and collect the results.
This function is only provided for consistency, id
is strictly more general.
>>>
traverseOf each print (1,2,3)
1 2 3 ((),(),())
traverseOf
≡id
itraverseOf
l ≡traverseOf
l.
Indexed
itraverseOf
itraversed
≡itraverse
This yields the obvious law:
traverse
≡traverseOf
traverse
traverseOf
::Functor
f =>Iso
s t a b -> (a -> f b) -> s -> f ttraverseOf
::Functor
f =>Lens
s t a b -> (a -> f b) -> s -> f ttraverseOf
::Apply
f =>Traversal1
s t a b -> (a -> f b) -> s -> f ttraverseOf
::Applicative
f =>Traversal
s t a b -> (a -> f b) -> s -> f t
type ATraversal s t a b = LensLike (Bazaar ((->) :: Type -> Type -> Type) a b) s t a b #
When you see this as an argument to a function, it expects a Traversal
.
type ATraversal' s a = ATraversal s s a a #
typeATraversal'
=Simple
ATraversal
type ATraversal1 s t a b = LensLike (Bazaar1 ((->) :: Type -> Type -> Type) a b) s t a b #
When you see this as an argument to a function, it expects a Traversal1
.
type ATraversal1' s a = ATraversal1 s s a a #
typeATraversal1'
=Simple
ATraversal1
type AnIndexedTraversal i s t a b = Over (Indexed i) (Bazaar (Indexed i) a b) s t a b #
When you see this as an argument to a function, it expects an IndexedTraversal
.
type AnIndexedTraversal1 i s t a b = Over (Indexed i) (Bazaar1 (Indexed i) a b) s t a b #
When you see this as an argument to a function, it expects an IndexedTraversal1
.
type AnIndexedTraversal' i s a = AnIndexedTraversal i s s a a #
typeAnIndexedTraversal'
=Simple
(AnIndexedTraversal
i)
type AnIndexedTraversal1' i s a = AnIndexedTraversal1 i s s a a #
typeAnIndexedTraversal1'
=Simple
(AnIndexedTraversal1
i)
type Traversing (p :: Type -> Type -> Type) (f :: Type -> Type) s t a b = Over p (BazaarT p f a b) s t a b #
When you see this as an argument to a function, it expects
- to be indexed if
p
is an instance ofIndexed
i, - to be unindexed if
p
is(->)
, - a
Traversal
iff
isApplicative
, - a
Getter
iff
is only aFunctor
andContravariant
, - a
Lens
iff
is only aFunctor
, - a
Fold
iff
isApplicative
andContravariant
.
type Traversing1 (p :: Type -> Type -> Type) (f :: Type -> Type) s t a b = Over p (BazaarT1 p f a b) s t a b #
type Traversing' (p :: Type -> Type -> Type) (f :: Type -> Type) s a = Traversing p f s s a a #
typeTraversing'
f =Simple
(Traversing
f)
type Traversing1' (p :: Type -> Type -> Type) (f :: Type -> Type) s a = Traversing1 p f s s a a #
class Ord k => TraverseMin k (m :: Type -> Type) | m -> k where #
Allows IndexedTraversal
the value at the smallest index.
traverseMin :: IndexedTraversal' k (m v) v #
IndexedTraversal
of the element with the smallest index.
Instances
TraverseMin Int IntMap | |
Defined in Control.Lens.Traversal traverseMin :: IndexedTraversal' Int (IntMap v) v # | |
Ord k => TraverseMin k (Map k) | |
Defined in Control.Lens.Traversal traverseMin :: IndexedTraversal' k (Map k v) v # |
class Ord k => TraverseMax k (m :: Type -> Type) | m -> k where #
Allows IndexedTraversal
of the value at the largest index.
traverseMax :: IndexedTraversal' k (m v) v #
IndexedTraversal
of the element at the largest index.
Instances
TraverseMax Int IntMap | |
Defined in Control.Lens.Traversal traverseMax :: IndexedTraversal' Int (IntMap v) v # | |
Ord k => TraverseMax k (Map k) | |
Defined in Control.Lens.Traversal traverseMax :: IndexedTraversal' k (Map k v) v # |
foldMapByOf :: Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r #
Fold a value using a specified Fold
and Monoid
operations.
This is like foldMapBy
where the Foldable
instance can be
manually specified.
foldMapByOf
folded
≡foldMapBy
foldMapByOf
::Getter
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> rfoldMapByOf
::Fold
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> rfoldMapByOf
::Traversal'
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> rfoldMapByOf
::Lens'
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> rfoldMapByOf
::Iso'
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r
>>>
foldMapByOf both (+) 0 length ("hello","world")
10
foldByOf :: Fold s a -> (a -> a -> a) -> a -> s -> a #
Fold a value using a specified Fold
and Monoid
operations.
This is like foldBy
where the Foldable
instance can be
manually specified.
foldByOf
folded
≡foldBy
foldByOf
::Getter
s a -> (a -> a -> a) -> a -> s -> afoldByOf
::Fold
s a -> (a -> a -> a) -> a -> s -> afoldByOf
::Lens'
s a -> (a -> a -> a) -> a -> s -> afoldByOf
::Traversal'
s a -> (a -> a -> a) -> a -> s -> afoldByOf
::Iso'
s a -> (a -> a -> a) -> a -> s -> a
>>>
foldByOf both (++) [] ("hello","world")
"helloworld"
idroppingWhile :: (Indexable i p, Profunctor q, Applicative f) => (i -> a -> Bool) -> Optical (Indexed i) q (Compose (State Bool) f) s t a a -> Optical p q f s t a a #
Obtain an IndexedFold
by dropping elements from another IndexedFold
, IndexedLens
, IndexedGetter
or IndexedTraversal
while a predicate holds.
idroppingWhile
:: (i -> a ->Bool
) ->IndexedFold
i s a ->IndexedFold
i s aidroppingWhile
:: (i -> a ->Bool
) ->IndexedTraversal'
i s a ->IndexedFold
i s a -- see notesidroppingWhile
:: (i -> a ->Bool
) ->IndexedLens'
i s a ->IndexedFold
i s a -- see notesidroppingWhile
:: (i -> a ->Bool
) ->IndexedGetter
i s a ->IndexedFold
i s a
Note: As with droppingWhile
applying idroppingWhile
to an IndexedLens
or IndexedTraversal
will still
allow you to use it as a pseudo-IndexedTraversal
, but if you change the value of the first target to one
where the predicate returns True
, then you will break the Traversal
laws and Traversal
fusion will
no longer be sound.
itakingWhile :: (Indexable i p, Profunctor q, Contravariant f, Applicative f) => (i -> a -> Bool) -> Optical' (Indexed i) q (Const (Endo (f s)) :: Type -> Type) s a -> Optical' p q f s a #
Obtain an IndexedFold
by taking elements from another
IndexedFold
, IndexedLens
, IndexedGetter
or IndexedTraversal
while a predicate holds.
itakingWhile
:: (i -> a ->Bool
) ->IndexedFold
i s a ->IndexedFold
i s aitakingWhile
:: (i -> a ->Bool
) ->IndexedTraversal'
i s a ->IndexedFold
i s aitakingWhile
:: (i -> a ->Bool
) ->IndexedLens'
i s a ->IndexedFold
i s aitakingWhile
:: (i -> a ->Bool
) ->IndexedGetter
i s a ->IndexedFold
i s a
Note: Applying itakingWhile
to an IndexedLens
or IndexedTraversal
will still allow you to use it as a
pseudo-IndexedTraversal
, but if you change the value of any target to one where the predicate returns
False
, then you will break the Traversal
laws and Traversal
fusion will no longer be sound.
ifiltered :: (Indexable i p, Applicative f) => (i -> a -> Bool) -> Optical' p (Indexed i) f a a #
Filter an IndexedFold
or IndexedGetter
, obtaining an IndexedFold
.
>>>
[0,0,0,5,5,5]^..traversed.ifiltered (\i a -> i <= a)
[0,5,5,5]
Compose with ifiltered
to filter another IndexedLens
, IndexedIso
, IndexedGetter
, IndexedFold
(or IndexedTraversal
) with
access to both the value and the index.
Note: As with filtered
, this is not a legal IndexedTraversal
, unless you are very careful not to invalidate the predicate on the target!
findIndicesOf :: IndexedGetting i (Endo [i]) s a -> (a -> Bool) -> s -> [i] #
Retrieve the indices of the values targeted by a IndexedFold
or IndexedTraversal
which satisfy a predicate.
findIndices
≡findIndicesOf
folded
findIndicesOf
::IndexedFold
i s a -> (a ->Bool
) -> s -> [i]findIndicesOf
::IndexedTraversal'
i s a -> (a ->Bool
) -> s -> [i]
findIndexOf :: IndexedGetting i (First i) s a -> (a -> Bool) -> s -> Maybe i #
Retrieve the index of the first value targeted by a IndexedFold
or IndexedTraversal
which satisfies a predicate.
findIndex
≡findIndexOf
folded
findIndexOf
::IndexedFold
i s a -> (a ->Bool
) -> s ->Maybe
ifindIndexOf
::IndexedTraversal'
i s a -> (a ->Bool
) -> s ->Maybe
i
elemIndicesOf :: Eq a => IndexedGetting i (Endo [i]) s a -> a -> s -> [i] #
Retrieve the indices of the values targeted by a IndexedFold
or IndexedTraversal
which are equal to a given value.
elemIndices
≡elemIndicesOf
folded
elemIndicesOf
::Eq
a =>IndexedFold
i s a -> a -> s -> [i]elemIndicesOf
::Eq
a =>IndexedTraversal'
i s a -> a -> s -> [i]
elemIndexOf :: Eq a => IndexedGetting i (First i) s a -> a -> s -> Maybe i #
Retrieve the index of the first value targeted by a IndexedFold
or IndexedTraversal
which is equal to a given value.
elemIndex
≡elemIndexOf
folded
elemIndexOf
::Eq
a =>IndexedFold
i s a -> a -> s ->Maybe
ielemIndexOf
::Eq
a =>IndexedTraversal'
i s a -> a -> s ->Maybe
i
(^@?!) :: HasCallStack => s -> IndexedGetting i (Endo (i, a)) s a -> (i, a) infixl 8 #
Perform an *UNSAFE* head
(with index) of an IndexedFold
or IndexedTraversal
assuming that it is there.
(^@?!
) :: s ->IndexedGetter
i s a -> (i, a) (^@?!
) :: s ->IndexedFold
i s a -> (i, a) (^@?!
) :: s ->IndexedLens'
i s a -> (i, a) (^@?!
) :: s ->IndexedTraversal'
i s a -> (i, a)
(^@?) :: s -> IndexedGetting i (Endo (Maybe (i, a))) s a -> Maybe (i, a) infixl 8 #
Perform a safe head
(with index) of an IndexedFold
or IndexedTraversal
or retrieve Just
the index and result
from an IndexedGetter
or IndexedLens
.
When using a IndexedTraversal
as a partial IndexedLens
, or an IndexedFold
as a partial IndexedGetter
this can be a convenient
way to extract the optional value.
(^@?
) :: s ->IndexedGetter
i s a ->Maybe
(i, a) (^@?
) :: s ->IndexedFold
i s a ->Maybe
(i, a) (^@?
) :: s ->IndexedLens'
i s a ->Maybe
(i, a) (^@?
) :: s ->IndexedTraversal'
i s a ->Maybe
(i, a)
(^@..) :: s -> IndexedGetting i (Endo [(i, a)]) s a -> [(i, a)] infixl 8 #
An infix version of itoListOf
.
itoListOf :: IndexedGetting i (Endo [(i, a)]) s a -> s -> [(i, a)] #
Extract the key-value pairs from a structure.
When you don't need access to the indices in the result, then toListOf
is more flexible in what it accepts.
toListOf
l ≡map
snd
.
itoListOf
l
itoListOf
::IndexedGetter
i s a -> s -> [(i,a)]itoListOf
::IndexedFold
i s a -> s -> [(i,a)]itoListOf
::IndexedLens'
i s a -> s -> [(i,a)]itoListOf
::IndexedTraversal'
i s a -> s -> [(i,a)]
ifoldlMOf :: Monad m => IndexedGetting i (Endo (r -> m r)) s a -> (i -> r -> a -> m r) -> r -> s -> m r #
Monadic fold over the elements of a structure with an index, associating to the left.
When you don't need access to the index then foldlMOf
is more flexible in what it accepts.
foldlMOf
l ≡ifoldlMOf
l.
const
ifoldlMOf
::Monad
m =>IndexedGetter
i s a -> (i -> r -> a -> m r) -> r -> s -> m rifoldlMOf
::Monad
m =>IndexedFold
i s a -> (i -> r -> a -> m r) -> r -> s -> m rifoldlMOf
::Monad
m =>IndexedLens'
i s a -> (i -> r -> a -> m r) -> r -> s -> m rifoldlMOf
::Monad
m =>IndexedTraversal'
i s a -> (i -> r -> a -> m r) -> r -> s -> m r
ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (r -> m r))) s a -> (i -> a -> r -> m r) -> r -> s -> m r #
Monadic fold right over the elements of a structure with an index.
When you don't need access to the index then foldrMOf
is more flexible in what it accepts.
foldrMOf
l ≡ifoldrMOf
l.
const
ifoldrMOf
::Monad
m =>IndexedGetter
i s a -> (i -> a -> r -> m r) -> r -> s -> m rifoldrMOf
::Monad
m =>IndexedFold
i s a -> (i -> a -> r -> m r) -> r -> s -> m rifoldrMOf
::Monad
m =>IndexedLens'
i s a -> (i -> a -> r -> m r) -> r -> s -> m rifoldrMOf
::Monad
m =>IndexedTraversal'
i s a -> (i -> a -> r -> m r) -> r -> s -> m r
ifoldlOf' :: IndexedGetting i (Endo (r -> r)) s a -> (i -> r -> a -> r) -> r -> s -> r #
Fold over the elements of a structure with an index, associating to the left, but strictly.
When you don't need access to the index then foldlOf'
is more flexible in what it accepts.
foldlOf'
l ≡ifoldlOf'
l.
const
ifoldlOf'
::IndexedGetter
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf'
::IndexedFold
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf'
::IndexedLens'
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf'
::IndexedTraversal'
i s a -> (i -> r -> a -> r) -> r -> s -> r
ifoldrOf' :: IndexedGetting i (Dual (Endo (r -> r))) s a -> (i -> a -> r -> r) -> r -> s -> r #
Strictly fold right over the elements of a structure with an index.
When you don't need access to the index then foldrOf'
is more flexible in what it accepts.
foldrOf'
l ≡ifoldrOf'
l.
const
ifoldrOf'
::IndexedGetter
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf'
::IndexedFold
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf'
::IndexedLens'
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf'
::IndexedTraversal'
i s a -> (i -> a -> r -> r) -> r -> s -> r
ifindMOf :: Monad m => IndexedGetting i (Endo (m (Maybe a))) s a -> (i -> a -> m Bool) -> s -> m (Maybe a) #
The ifindMOf
function takes an IndexedFold
or IndexedTraversal
, a monadic predicate that is also
supplied the index, a structure and returns in the monad the left-most element of the structure
matching the predicate, or Nothing
if there is no such element.
When you don't need access to the index then findMOf
is more flexible in what it accepts.
findMOf
l ≡ifindMOf
l.
const
ifindMOf
::Monad
m =>IndexedGetter
i s a -> (i -> a -> mBool
) -> s -> m (Maybe
a)ifindMOf
::Monad
m =>IndexedFold
i s a -> (i -> a -> mBool
) -> s -> m (Maybe
a)ifindMOf
::Monad
m =>IndexedLens'
i s a -> (i -> a -> mBool
) -> s -> m (Maybe
a)ifindMOf
::Monad
m =>IndexedTraversal'
i s a -> (i -> a -> mBool
) -> s -> m (Maybe
a)
ifindOf :: IndexedGetting i (Endo (Maybe a)) s a -> (i -> a -> Bool) -> s -> Maybe a #
The ifindOf
function takes an IndexedFold
or IndexedTraversal
, a predicate that is also
supplied the index, a structure and returns the left-most element of the structure
matching the predicate, or Nothing
if there is no such element.
When you don't need access to the index then findOf
is more flexible in what it accepts.
findOf
l ≡ifindOf
l.
const
ifindOf
::IndexedGetter
i s a -> (i -> a ->Bool
) -> s ->Maybe
aifindOf
::IndexedFold
i s a -> (i -> a ->Bool
) -> s ->Maybe
aifindOf
::IndexedLens'
i s a -> (i -> a ->Bool
) -> s ->Maybe
aifindOf
::IndexedTraversal'
i s a -> (i -> a ->Bool
) -> s ->Maybe
a
iconcatMapOf :: IndexedGetting i [r] s a -> (i -> a -> [r]) -> s -> [r] #
Concatenate the results of a function of the elements of an IndexedFold
or IndexedTraversal
with access to the index.
When you don't need access to the index then concatMapOf
is more flexible in what it accepts.
concatMapOf
l ≡iconcatMapOf
l.
const
iconcatMapOf
≡ifoldMapOf
iconcatMapOf
::IndexedGetter
i s a -> (i -> a -> [r]) -> s -> [r]iconcatMapOf
::IndexedFold
i s a -> (i -> a -> [r]) -> s -> [r]iconcatMapOf
::IndexedLens'
i s a -> (i -> a -> [r]) -> s -> [r]iconcatMapOf
::IndexedTraversal'
i s a -> (i -> a -> [r]) -> s -> [r]
iforMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> s -> (i -> a -> m r) -> m () #
Run monadic actions for each target of an IndexedFold
or IndexedTraversal
with access to the index,
discarding the results (with the arguments flipped).
iforMOf_
≡flip
.
imapMOf_
When you don't need access to the index then forMOf_
is more flexible in what it accepts.
forMOf_
l a ≡iforMOf
l a.
const
iforMOf_
::Monad
m =>IndexedGetter
i s a -> s -> (i -> a -> m r) -> m ()iforMOf_
::Monad
m =>IndexedFold
i s a -> s -> (i -> a -> m r) -> m ()iforMOf_
::Monad
m =>IndexedLens'
i s a -> s -> (i -> a -> m r) -> m ()iforMOf_
::Monad
m =>IndexedTraversal'
i s a -> s -> (i -> a -> m r) -> m ()
imapMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> (i -> a -> m r) -> s -> m () #
Run monadic actions for each target of an IndexedFold
or IndexedTraversal
with access to the index,
discarding the results.
When you don't need access to the index then mapMOf_
is more flexible in what it accepts.
mapMOf_
l ≡imapMOf
l.
const
imapMOf_
::Monad
m =>IndexedGetter
i s a -> (i -> a -> m r) -> s -> m ()imapMOf_
::Monad
m =>IndexedFold
i s a -> (i -> a -> m r) -> s -> m ()imapMOf_
::Monad
m =>IndexedLens'
i s a -> (i -> a -> m r) -> s -> m ()imapMOf_
::Monad
m =>IndexedTraversal'
i s a -> (i -> a -> m r) -> s -> m ()
iforOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> s -> (i -> a -> f r) -> f () #
Traverse the targets of an IndexedFold
or IndexedTraversal
with access to the index, discarding the results
(with the arguments flipped).
iforOf_
≡flip
.
itraverseOf_
When you don't need access to the index then forOf_
is more flexible in what it accepts.
forOf_
l a ≡iforOf_
l a.
const
iforOf_
::Functor
f =>IndexedGetter
i s a -> s -> (i -> a -> f r) -> f ()iforOf_
::Applicative
f =>IndexedFold
i s a -> s -> (i -> a -> f r) -> f ()iforOf_
::Functor
f =>IndexedLens'
i s a -> s -> (i -> a -> f r) -> f ()iforOf_
::Applicative
f =>IndexedTraversal'
i s a -> s -> (i -> a -> f r) -> f ()
itraverseOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> (i -> a -> f r) -> s -> f () #
Traverse the targets of an IndexedFold
or IndexedTraversal
with access to the i
, discarding the results.
When you don't need access to the index then traverseOf_
is more flexible in what it accepts.
traverseOf_
l ≡itraverseOf
l.
const
itraverseOf_
::Functor
f =>IndexedGetter
i s a -> (i -> a -> f r) -> s -> f ()itraverseOf_
::Applicative
f =>IndexedFold
i s a -> (i -> a -> f r) -> s -> f ()itraverseOf_
::Functor
f =>IndexedLens'
i s a -> (i -> a -> f r) -> s -> f ()itraverseOf_
::Applicative
f =>IndexedTraversal'
i s a -> (i -> a -> f r) -> s -> f ()
inoneOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool #
Return whether or not none of the elements viewed through an IndexedFold
or IndexedTraversal
satisfy a predicate, with access to the i
.
When you don't need access to the index then noneOf
is more flexible in what it accepts.
noneOf
l ≡inoneOf
l.
const
inoneOf
::IndexedGetter
i s a -> (i -> a ->Bool
) -> s ->Bool
inoneOf
::IndexedFold
i s a -> (i -> a ->Bool
) -> s ->Bool
inoneOf
::IndexedLens'
i s a -> (i -> a ->Bool
) -> s ->Bool
inoneOf
::IndexedTraversal'
i s a -> (i -> a ->Bool
) -> s ->Bool
iallOf :: IndexedGetting i All s a -> (i -> a -> Bool) -> s -> Bool #
Return whether or not all elements viewed through an IndexedFold
or IndexedTraversal
satisfy a predicate, with access to the i
.
When you don't need access to the index then allOf
is more flexible in what it accepts.
allOf
l ≡iallOf
l.
const
iallOf
::IndexedGetter
i s a -> (i -> a ->Bool
) -> s ->Bool
iallOf
::IndexedFold
i s a -> (i -> a ->Bool
) -> s ->Bool
iallOf
::IndexedLens'
i s a -> (i -> a ->Bool
) -> s ->Bool
iallOf
::IndexedTraversal'
i s a -> (i -> a ->Bool
) -> s ->Bool
ianyOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool #
Return whether or not any element viewed through an IndexedFold
or IndexedTraversal
satisfy a predicate, with access to the i
.
When you don't need access to the index then anyOf
is more flexible in what it accepts.
anyOf
l ≡ianyOf
l.
const
ianyOf
::IndexedGetter
i s a -> (i -> a ->Bool
) -> s ->Bool
ianyOf
::IndexedFold
i s a -> (i -> a ->Bool
) -> s ->Bool
ianyOf
::IndexedLens'
i s a -> (i -> a ->Bool
) -> s ->Bool
ianyOf
::IndexedTraversal'
i s a -> (i -> a ->Bool
) -> s ->Bool
ifoldlOf :: IndexedGetting i (Dual (Endo r)) s a -> (i -> r -> a -> r) -> r -> s -> r #
Left-associative fold of the parts of a structure that are viewed through an IndexedFold
or IndexedTraversal
with
access to the i
.
When you don't need access to the index then foldlOf
is more flexible in what it accepts.
foldlOf
l ≡ifoldlOf
l.
const
ifoldlOf
::IndexedGetter
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf
::IndexedFold
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf
::IndexedLens'
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf
::IndexedTraversal'
i s a -> (i -> r -> a -> r) -> r -> s -> r
ifoldrOf :: IndexedGetting i (Endo r) s a -> (i -> a -> r -> r) -> r -> s -> r #
Right-associative fold of parts of a structure that are viewed through an IndexedFold
or IndexedTraversal
with
access to the i
.
When you don't need access to the index then foldrOf
is more flexible in what it accepts.
foldrOf
l ≡ifoldrOf
l.
const
ifoldrOf
::IndexedGetter
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf
::IndexedFold
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf
::IndexedLens'
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf
::IndexedTraversal'
i s a -> (i -> a -> r -> r) -> r -> s -> r
ifoldMapOf :: IndexedGetting i m s a -> (i -> a -> m) -> s -> m #
Fold an IndexedFold
or IndexedTraversal
by mapping indices and values to an arbitrary Monoid
with access
to the i
.
When you don't need access to the index then foldMapOf
is more flexible in what it accepts.
foldMapOf
l ≡ifoldMapOf
l.
const
ifoldMapOf
::IndexedGetter
i s a -> (i -> a -> m) -> s -> mifoldMapOf
::Monoid
m =>IndexedFold
i s a -> (i -> a -> m) -> s -> mifoldMapOf
::IndexedLens'
i s a -> (i -> a -> m) -> s -> mifoldMapOf
::Monoid
m =>IndexedTraversal'
i s a -> (i -> a -> m) -> s -> m
backwards :: (Profunctor p, Profunctor q) => Optical p q (Backwards f) s t a b -> Optical p q f s t a b #
This allows you to traverse
the elements of a pretty much any LensLike
construction in the opposite order.
This will preserve indexes on Indexed
types and will give you the elements of a (finite) Fold
or Traversal
in the opposite order.
This has no practical impact on a Getter
, Setter
, Lens
or Iso
.
NB: To write back through an Iso
, you want to use from
.
Similarly, to write back through an Prism
, you want to use re
.
ipreuses :: MonadState s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r) #
Retrieve a function of the first index and value targeted by an IndexedFold
or
IndexedTraversal
(or a function of Just
the index and result from an IndexedGetter
or IndexedLens
) into the current state.
ipreuses
=uses
.
ipre
ipreuses
::MonadState
s m =>IndexedGetter
i s a -> (i -> a -> r) -> m (Maybe
r)ipreuses
::MonadState
s m =>IndexedFold
i s a -> (i -> a -> r) -> m (Maybe
r)ipreuses
::MonadState
s m =>IndexedLens'
i s a -> (i -> a -> r) -> m (Maybe
r)ipreuses
::MonadState
s m =>IndexedTraversal'
i s a -> (i -> a -> r) -> m (Maybe
r)
preuses :: MonadState s m => Getting (First r) s a -> (a -> r) -> m (Maybe r) #
Retrieve a function of the first value targeted by a Fold
or
Traversal
(or Just
the result from a Getter
or Lens
) into the current state.
preuses
=uses
.
pre
preuses
::MonadState
s m =>Getter
s a -> (a -> r) -> m (Maybe
r)preuses
::MonadState
s m =>Fold
s a -> (a -> r) -> m (Maybe
r)preuses
::MonadState
s m =>Lens'
s a -> (a -> r) -> m (Maybe
r)preuses
::MonadState
s m =>Iso'
s a -> (a -> r) -> m (Maybe
r)preuses
::MonadState
s m =>Traversal'
s a -> (a -> r) -> m (Maybe
r)
ipreuse :: MonadState s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a)) #
Retrieve the first index and value targeted by an IndexedFold
or IndexedTraversal
(or Just
the index
and result from an IndexedGetter
or IndexedLens
) into the current state.
ipreuse
=use
.
ipre
ipreuse
::MonadState
s m =>IndexedGetter
i s a -> m (Maybe
(i, a))ipreuse
::MonadState
s m =>IndexedFold
i s a -> m (Maybe
(i, a))ipreuse
::MonadState
s m =>IndexedLens'
i s a -> m (Maybe
(i, a))ipreuse
::MonadState
s m =>IndexedTraversal'
i s a -> m (Maybe
(i, a))
preuse :: MonadState s m => Getting (First a) s a -> m (Maybe a) #
Retrieve the first value targeted by a Fold
or Traversal
(or Just
the result
from a Getter
or Lens
) into the current state.
preuse
=use
.
pre
preuse
::MonadState
s m =>Getter
s a -> m (Maybe
a)preuse
::MonadState
s m =>Fold
s a -> m (Maybe
a)preuse
::MonadState
s m =>Lens'
s a -> m (Maybe
a)preuse
::MonadState
s m =>Iso'
s a -> m (Maybe
a)preuse
::MonadState
s m =>Traversal'
s a -> m (Maybe
a)
ipreviews :: MonadReader s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r) #
Retrieve a function of the first index and value targeted by an IndexedFold
or
IndexedTraversal
(or Just
the result from an IndexedGetter
or IndexedLens
).
See also (^@?
).
ipreviews
=views
.
ipre
This is usually applied in the Reader
Monad
(->) s
.
ipreviews
::IndexedGetter
i s a -> (i -> a -> r) -> s ->Maybe
ripreviews
::IndexedFold
i s a -> (i -> a -> r) -> s ->Maybe
ripreviews
::IndexedLens'
i s a -> (i -> a -> r) -> s ->Maybe
ripreviews
::IndexedTraversal'
i s a -> (i -> a -> r) -> s ->Maybe
r
However, it may be useful to think of its full generality when working with
a Monad
transformer stack:
ipreviews
::MonadReader
s m =>IndexedGetter
i s a -> (i -> a -> r) -> m (Maybe
r)ipreviews
::MonadReader
s m =>IndexedFold
i s a -> (i -> a -> r) -> m (Maybe
r)ipreviews
::MonadReader
s m =>IndexedLens'
i s a -> (i -> a -> r) -> m (Maybe
r)ipreviews
::MonadReader
s m =>IndexedTraversal'
i s a -> (i -> a -> r) -> m (Maybe
r)
ipreview :: MonadReader s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a)) #
Retrieve the first index and value targeted by a Fold
or Traversal
(or Just
the result
from a Getter
or Lens
). See also (^@?
).
ipreview
=view
.
ipre
This is usually applied in the Reader
Monad
(->) s
.
ipreview
::IndexedGetter
i s a -> s ->Maybe
(i, a)ipreview
::IndexedFold
i s a -> s ->Maybe
(i, a)ipreview
::IndexedLens'
i s a -> s ->Maybe
(i, a)ipreview
::IndexedTraversal'
i s a -> s ->Maybe
(i, a)
However, it may be useful to think of its full generality when working with
a Monad
transformer stack:
ipreview
::MonadReader
s m =>IndexedGetter
s a -> m (Maybe
(i, a))ipreview
::MonadReader
s m =>IndexedFold
s a -> m (Maybe
(i, a))ipreview
::MonadReader
s m =>IndexedLens'
s a -> m (Maybe
(i, a))ipreview
::MonadReader
s m =>IndexedTraversal'
s a -> m (Maybe
(i, a))
preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a) #
Retrieve the first value targeted by a Fold
or Traversal
(or Just
the result
from a Getter
or Lens
). See also firstOf
and ^?
, which are similar with
some subtle differences (explained below).
listToMaybe
.
toList
≡preview
folded
preview
=view
.
pre
Unlike ^?
, this function uses a
MonadReader
to read the value to be focused in on.
This allows one to pass the value as the last argument by using the
MonadReader
instance for (->) s
However, it may also be used as part of some deeply nested transformer stack.
preview
uses a monoidal value to obtain the result.
This means that it generally has good performance, but can occasionally cause space leaks
or even stack overflows on some data types.
There is another function, firstOf
, which avoids these issues at the cost of
a slight constant performance cost and a little less flexibility.
It may be helpful to think of preview
as having one of the following
more specialized types:
preview
::Getter
s a -> s ->Maybe
apreview
::Fold
s a -> s ->Maybe
apreview
::Lens'
s a -> s ->Maybe
apreview
::Iso'
s a -> s ->Maybe
apreview
::Traversal'
s a -> s ->Maybe
a
preview
::MonadReader
s m =>Getter
s a -> m (Maybe
a)preview
::MonadReader
s m =>Fold
s a -> m (Maybe
a)preview
::MonadReader
s m =>Lens'
s a -> m (Maybe
a)preview
::MonadReader
s m =>Iso'
s a -> m (Maybe
a)preview
::MonadReader
s m =>Traversal'
s a -> m (Maybe
a)
ipre :: IndexedGetting i (First (i, a)) s a -> IndexPreservingGetter s (Maybe (i, a)) #
This converts an IndexedFold
to an IndexPreservingGetter
that returns the first index
and element, if they exist, as a Maybe
.
ipre
::IndexedGetter
i s a ->IndexPreservingGetter
s (Maybe
(i, a))ipre
::IndexedFold
i s a ->IndexPreservingGetter
s (Maybe
(i, a))ipre
::IndexedTraversal'
i s a ->IndexPreservingGetter
s (Maybe
(i, a))ipre
::IndexedLens'
i s a ->IndexPreservingGetter
s (Maybe
(i, a))
pre :: Getting (First a) s a -> IndexPreservingGetter s (Maybe a) #
This converts a Fold
to a IndexPreservingGetter
that returns the first element, if it
exists, as a Maybe
.
pre
::Getter
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Fold
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Traversal'
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Lens'
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Iso'
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Prism'
s a ->IndexPreservingGetter
s (Maybe
a)
has :: Getting Any s a -> s -> Bool #
Check to see if this Fold
or Traversal
matches 1 or more entries.
>>>
has (element 0) []
False
>>>
has _Left (Left 12)
True
>>>
has _Right (Left 12)
False
This will always return True
for a Lens
or Getter
.
>>>
has _1 ("hello","world")
True
has
::Getter
s a -> s ->Bool
has
::Fold
s a -> s ->Bool
has
::Iso'
s a -> s ->Bool
has
::Lens'
s a -> s ->Bool
has
::Traversal'
s a -> s ->Bool
foldlMOf :: Monad m => Getting (Endo (r -> m r)) s a -> (r -> a -> m r) -> r -> s -> m r #
Monadic fold over the elements of a structure, associating to the left, i.e. from left to right.
foldlM
≡foldlMOf
folded
foldlMOf
::Monad
m =>Getter
s a -> (r -> a -> m r) -> r -> s -> m rfoldlMOf
::Monad
m =>Fold
s a -> (r -> a -> m r) -> r -> s -> m rfoldlMOf
::Monad
m =>Iso'
s a -> (r -> a -> m r) -> r -> s -> m rfoldlMOf
::Monad
m =>Lens'
s a -> (r -> a -> m r) -> r -> s -> m rfoldlMOf
::Monad
m =>Traversal'
s a -> (r -> a -> m r) -> r -> s -> m r
foldrMOf :: Monad m => Getting (Dual (Endo (r -> m r))) s a -> (a -> r -> m r) -> r -> s -> m r #
Monadic fold over the elements of a structure, associating to the right, i.e. from right to left.
foldrM
≡foldrMOf
folded
foldrMOf
::Monad
m =>Getter
s a -> (a -> r -> m r) -> r -> s -> m rfoldrMOf
::Monad
m =>Fold
s a -> (a -> r -> m r) -> r -> s -> m rfoldrMOf
::Monad
m =>Iso'
s a -> (a -> r -> m r) -> r -> s -> m rfoldrMOf
::Monad
m =>Lens'
s a -> (a -> r -> m r) -> r -> s -> m rfoldrMOf
::Monad
m =>Traversal'
s a -> (a -> r -> m r) -> r -> s -> m r
foldl1Of' :: HasCallStack => Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a #
A variant of foldlOf'
that has no base case and thus may only be applied
to folds and structures such that the fold views at least one element of
the structure.
foldl1Of'
l f ≡foldl1'
f.
toListOf
l
foldl1Of'
::Getter
s a -> (a -> a -> a) -> s -> afoldl1Of'
::Fold
s a -> (a -> a -> a) -> s -> afoldl1Of'
::Iso'
s a -> (a -> a -> a) -> s -> afoldl1Of'
::Lens'
s a -> (a -> a -> a) -> s -> afoldl1Of'
::Traversal'
s a -> (a -> a -> a) -> s -> a
foldr1Of' :: HasCallStack => Getting (Dual (Endo (Endo (Maybe a)))) s a -> (a -> a -> a) -> s -> a #
A variant of foldrOf'
that has no base case and thus may only be applied
to folds and structures such that the fold views at least one element of the
structure.
foldr1Of
l f ≡foldr1
f.
toListOf
l
foldr1Of'
::Getter
s a -> (a -> a -> a) -> s -> afoldr1Of'
::Fold
s a -> (a -> a -> a) -> s -> afoldr1Of'
::Iso'
s a -> (a -> a -> a) -> s -> afoldr1Of'
::Lens'
s a -> (a -> a -> a) -> s -> afoldr1Of'
::Traversal'
s a -> (a -> a -> a) -> s -> a
foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r #
Fold over the elements of a structure, associating to the left, but strictly.
foldl'
≡foldlOf'
folded
foldlOf'
::Getter
s a -> (r -> a -> r) -> r -> s -> rfoldlOf'
::Fold
s a -> (r -> a -> r) -> r -> s -> rfoldlOf'
::Iso'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf'
::Lens'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf'
::Traversal'
s a -> (r -> a -> r) -> r -> s -> r
foldrOf' :: Getting (Dual (Endo (Endo r))) s a -> (a -> r -> r) -> r -> s -> r #
Strictly fold right over the elements of a structure.
foldr'
≡foldrOf'
folded
foldrOf'
::Getter
s a -> (a -> r -> r) -> r -> s -> rfoldrOf'
::Fold
s a -> (a -> r -> r) -> r -> s -> rfoldrOf'
::Iso'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf'
::Lens'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf'
::Traversal'
s a -> (a -> r -> r) -> r -> s -> r
foldl1Of :: HasCallStack => Getting (Dual (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a #
A variant of foldlOf
that has no base case and thus may only be applied to lenses and structures such
that the Lens
views at least one element of the structure.
>>>
foldl1Of each (+) (1,2,3,4)
10
foldl1Of
l f ≡foldl1
f.
toListOf
lfoldl1
≡foldl1Of
folded
foldl1Of
::Getter
s a -> (a -> a -> a) -> s -> afoldl1Of
::Fold
s a -> (a -> a -> a) -> s -> afoldl1Of
::Iso'
s a -> (a -> a -> a) -> s -> afoldl1Of
::Lens'
s a -> (a -> a -> a) -> s -> afoldl1Of
::Traversal'
s a -> (a -> a -> a) -> s -> a
foldr1Of :: HasCallStack => Getting (Endo (Maybe a)) s a -> (a -> a -> a) -> s -> a #
A variant of foldrOf
that has no base case and thus may only be applied
to lenses and structures such that the Lens
views at least one element of
the structure.
>>>
foldr1Of each (+) (1,2,3,4)
10
foldr1Of
l f ≡foldr1
f.
toListOf
lfoldr1
≡foldr1Of
folded
foldr1Of
::Getter
s a -> (a -> a -> a) -> s -> afoldr1Of
::Fold
s a -> (a -> a -> a) -> s -> afoldr1Of
::Iso'
s a -> (a -> a -> a) -> s -> afoldr1Of
::Lens'
s a -> (a -> a -> a) -> s -> afoldr1Of
::Traversal'
s a -> (a -> a -> a) -> s -> a
lookupOf :: Eq k => Getting (Endo (Maybe v)) s (k, v) -> k -> s -> Maybe v #
The lookupOf
function takes a Fold
(or Getter
, Traversal
,
Lens
, Iso
, etc.), a key, and a structure containing key/value pairs.
It returns the first value corresponding to the given key. This function
generalizes lookup
to work on an arbitrary Fold
instead of lists.
>>>
lookupOf folded 4 [(2, 'a'), (4, 'b'), (4, 'c')]
Just 'b'
>>>
lookupOf each 2 [(2, 'a'), (4, 'b'), (4, 'c')]
Just 'a'
lookupOf
::Eq
k =>Fold
s (k,v) -> k -> s ->Maybe
v
findMOf :: Monad m => Getting (Endo (m (Maybe a))) s a -> (a -> m Bool) -> s -> m (Maybe a) #
The findMOf
function takes a Lens
(or Getter
, Iso
, Fold
, or Traversal
),
a monadic predicate and a structure and returns in the monad the leftmost element of the structure
matching the predicate, or Nothing
if there is no such element.
>>>
findMOf each ( \x -> print ("Checking " ++ show x) >> return (even x)) (1,3,4,6)
"Checking 1" "Checking 3" "Checking 4" Just 4
>>>
findMOf each ( \x -> print ("Checking " ++ show x) >> return (even x)) (1,3,5,7)
"Checking 1" "Checking 3" "Checking 5" "Checking 7" Nothing
findMOf
:: (Monad
m,Getter
s a) -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
:: (Monad
m,Fold
s a) -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
:: (Monad
m,Iso'
s a) -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
:: (Monad
m,Lens'
s a) -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
:: (Monad
m,Traversal'
s a) -> (a -> mBool
) -> s -> m (Maybe
a)
findMOf
folded
:: (Monad m, Foldable f) => (a -> m Bool) -> f a -> m (Maybe a)ifindMOf
l ≡findMOf
l.
Indexed
A simpler version that didn't permit indexing, would be:
findMOf
:: Monad m =>Getting
(Endo
(m (Maybe
a))) s a -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
l p =foldrOf
l (a y -> p a >>= x -> if x then return (Just
a) else y) $ returnNothing
findOf :: Getting (Endo (Maybe a)) s a -> (a -> Bool) -> s -> Maybe a #
The findOf
function takes a Lens
(or Getter
, Iso
, Fold
, or Traversal
),
a predicate and a structure and returns the leftmost element of the structure
matching the predicate, or Nothing
if there is no such element.
>>>
findOf each even (1,3,4,6)
Just 4
>>>
findOf folded even [1,3,5,7]
Nothing
findOf
::Getter
s a -> (a ->Bool
) -> s ->Maybe
afindOf
::Fold
s a -> (a ->Bool
) -> s ->Maybe
afindOf
::Iso'
s a -> (a ->Bool
) -> s ->Maybe
afindOf
::Lens'
s a -> (a ->Bool
) -> s ->Maybe
afindOf
::Traversal'
s a -> (a ->Bool
) -> s ->Maybe
a
find
≡findOf
folded
ifindOf
l ≡findOf
l.
Indexed
A simpler version that didn't permit indexing, would be:
findOf
::Getting
(Endo
(Maybe
a)) s a -> (a ->Bool
) -> s ->Maybe
afindOf
l p =foldrOf
l (a y -> if p a thenJust
a else y)Nothing
minimumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a #
Obtain the minimum element (if any) targeted by a Fold
, Traversal
, Lens
, Iso
or Getter
according to a user supplied Ordering
.
In the interest of efficiency, This operation has semantics more strict than strictly necessary.
>>>
minimumByOf traverse (compare `on` length) ["mustard","relish","ham"]
Just "ham"
minimumBy
cmp ≡fromMaybe
(error
"empty").
minimumByOf
folded
cmp
minimumByOf
::Getter
s a -> (a -> a ->Ordering
) -> s ->Maybe
aminimumByOf
::Fold
s a -> (a -> a ->Ordering
) -> s ->Maybe
aminimumByOf
::Iso'
s a -> (a -> a ->Ordering
) -> s ->Maybe
aminimumByOf
::Lens'
s a -> (a -> a ->Ordering
) -> s ->Maybe
aminimumByOf
::Traversal'
s a -> (a -> a ->Ordering
) -> s ->Maybe
a
maximumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a #
Obtain the maximum element (if any) targeted by a Fold
, Traversal
, Lens
, Iso
,
or Getter
according to a user supplied Ordering
.
>>>
maximumByOf traverse (compare `on` length) ["mustard","relish","ham"]
Just "mustard"
In the interest of efficiency, This operation has semantics more strict than strictly necessary.
maximumBy
cmp ≡fromMaybe
(error
"empty").
maximumByOf
folded
cmp
maximumByOf
::Getter
s a -> (a -> a ->Ordering
) -> s ->Maybe
amaximumByOf
::Fold
s a -> (a -> a ->Ordering
) -> s ->Maybe
amaximumByOf
::Iso'
s a -> (a -> a ->Ordering
) -> s ->Maybe
amaximumByOf
::Lens'
s a -> (a -> a ->Ordering
) -> s ->Maybe
amaximumByOf
::Traversal'
s a -> (a -> a ->Ordering
) -> s ->Maybe
a
minimum1Of :: Ord a => Getting (Min a) s a -> s -> a #
Obtain the minimum element targeted by a Fold1
or Traversal1
.
>>>
minimum1Of traverse1 (1 :| [2..10])
1
minimum1Of
::Ord
a =>Getter
s a -> s -> aminimum1Of
::Ord
a =>Fold1
s a -> s -> aminimum1Of
::Ord
a =>Iso'
s a -> s -> aminimum1Of
::Ord
a =>Lens'
s a -> s -> aminimum1Of
::Ord
a =>Traversal1'
s a -> s -> a
minimumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a #
Obtain the minimum element (if any) targeted by a Fold
or Traversal
safely.
Note: minimumOf
on a valid Iso
, Lens
or Getter
will always return Just
a value.
>>>
minimumOf traverse [1..10]
Just 1
>>>
minimumOf traverse []
Nothing
>>>
minimumOf (folded.filtered even) [1,4,3,6,7,9,2]
Just 2
minimum
≡fromMaybe
(error
"empty").
minimumOf
folded
In the interest of efficiency, This operation has semantics more strict than strictly necessary.
has lazier semantics but could leak memory.rmap
getMin
(foldMapOf
l Min
)
minimumOf
::Ord
a =>Getter
s a -> s ->Maybe
aminimumOf
::Ord
a =>Fold
s a -> s ->Maybe
aminimumOf
::Ord
a =>Iso'
s a -> s ->Maybe
aminimumOf
::Ord
a =>Lens'
s a -> s ->Maybe
aminimumOf
::Ord
a =>Traversal'
s a -> s ->Maybe
a
maximum1Of :: Ord a => Getting (Max a) s a -> s -> a #
Obtain the maximum element targeted by a Fold1
or Traversal1
.
>>>
maximum1Of traverse1 (1 :| [2..10])
10
maximum1Of
::Ord
a =>Getter
s a -> s -> amaximum1Of
::Ord
a =>Fold1
s a -> s -> amaximum1Of
::Ord
a =>Iso'
s a -> s -> amaximum1Of
::Ord
a =>Lens'
s a -> s -> amaximum1Of
::Ord
a =>Traversal1'
s a -> s -> a
maximumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a #
Obtain the maximum element (if any) targeted by a Fold
or Traversal
safely.
Note: maximumOf
on a valid Iso
, Lens
or Getter
will always return Just
a value.
>>>
maximumOf traverse [1..10]
Just 10
>>>
maximumOf traverse []
Nothing
>>>
maximumOf (folded.filtered even) [1,4,3,6,7,9,2]
Just 6
maximum
≡fromMaybe
(error
"empty").
maximumOf
folded
In the interest of efficiency, This operation has semantics more strict than strictly necessary.
has lazier semantics but could leak memory.rmap
getMax
(foldMapOf
l Max
)
maximumOf
::Ord
a =>Getter
s a -> s ->Maybe
amaximumOf
::Ord
a =>Fold
s a -> s ->Maybe
amaximumOf
::Ord
a =>Iso'
s a -> s ->Maybe
amaximumOf
::Ord
a =>Lens'
s a -> s ->Maybe
amaximumOf
::Ord
a =>Traversal'
s a -> s ->Maybe
a
notNullOf :: Getting Any s a -> s -> Bool #
Returns True
if this Fold
or Traversal
has any targets in the given container.
A more "conversational" alias for this combinator is has
.
Note: notNullOf
on a valid Iso
, Lens
or Getter
should always return True
.
not
.
null
≡notNullOf
folded
This may be rather inefficient compared to the
check of many containers.not
.
null
>>>
notNullOf _1 (1,2)
True
>>>
notNullOf traverse [1..10]
True
>>>
notNullOf folded []
False
>>>
notNullOf (element 20) [1..10]
False
notNullOf
(folded
.
_1
.
folded
) :: (Foldable
f,Foldable
g) => f (g a, b) ->Bool
notNullOf
::Getter
s a -> s ->Bool
notNullOf
::Fold
s a -> s ->Bool
notNullOf
::Iso'
s a -> s ->Bool
notNullOf
::Lens'
s a -> s ->Bool
notNullOf
::Traversal'
s a -> s ->Bool
nullOf :: Getting All s a -> s -> Bool #
Returns True
if this Fold
or Traversal
has no targets in the given container.
Note: nullOf
on a valid Iso
, Lens
or Getter
should always return False
.
null
≡nullOf
folded
This may be rather inefficient compared to the null
check of many containers.
>>>
nullOf _1 (1,2)
False
>>>
nullOf ignored ()
True
>>>
nullOf traverse []
True
>>>
nullOf (element 20) [1..10]
True
nullOf
(folded
.
_1
.
folded
) :: (Foldable
f,Foldable
g) => f (g a, b) ->Bool
nullOf
::Getter
s a -> s ->Bool
nullOf
::Fold
s a -> s ->Bool
nullOf
::Iso'
s a -> s ->Bool
nullOf
::Lens'
s a -> s ->Bool
nullOf
::Traversal'
s a -> s ->Bool
last1Of :: Getting (Last a) s a -> s -> a #
Retrieve the Last
entry of a Fold1
or Traversal1
or retrieve the result
from a Getter
or Lens
.o
>>>
last1Of traverse1 (1 :| [2..10])
10
>>>
last1Of both1 (1,2)
2
last1Of
::Getter
s a -> s ->Maybe
alast1Of
::Fold1
s a -> s ->Maybe
alast1Of
::Lens'
s a -> s ->Maybe
alast1Of
::Iso'
s a -> s ->Maybe
alast1Of
::Traversal1'
s a -> s ->Maybe
a
lastOf :: Getting (Rightmost a) s a -> s -> Maybe a #
Retrieve the Last
entry of a Fold
or Traversal
or retrieve Just
the result
from a Getter
or Lens
.
The answer is computed in a manner that leaks space less than
and gives you back access to the outermost ala
Last
.
foldMapOf
Just
constructor more quickly, but may have worse
constant factors.
>>>
lastOf traverse [1..10]
Just 10
>>>
lastOf both (1,2)
Just 2
>>>
lastOf ignored ()
Nothing
lastOf
::Getter
s a -> s ->Maybe
alastOf
::Fold
s a -> s ->Maybe
alastOf
::Lens'
s a -> s ->Maybe
alastOf
::Iso'
s a -> s ->Maybe
alastOf
::Traversal'
s a -> s ->Maybe
a
first1Of :: Getting (First a) s a -> s -> a #
Retrieve the First
entry of a Fold1
or Traversal1
or the result from a Getter
or Lens
.
>>>
first1Of traverse1 (1 :| [2..10])
1
>>>
first1Of both1 (1,2)
1
Note: this is different from ^.
.
>>>
first1Of traverse1 ([1,2] :| [[3,4],[5,6]])
[1,2]
>>>
([1,2] :| [[3,4],[5,6]]) ^. traverse1
[1,2,3,4,5,6]
first1Of
::Getter
s a -> s -> afirst1Of
::Fold1
s a -> s -> afirst1Of
::Lens'
s a -> s -> afirst1Of
::Iso'
s a -> s -> afirst1Of
::Traversal1'
s a -> s -> a
firstOf :: Getting (Leftmost a) s a -> s -> Maybe a #
Retrieve the First
entry of a Fold
or Traversal
or retrieve Just
the result
from a Getter
or Lens
.
The answer is computed in a manner that leaks space less than
or preview
^?'
and gives you back access to the outermost Just
constructor more quickly, but does so
in a way that builds an intermediate structure, and thus may have worse
constant factors. This also means that it can not be used in any MonadReader
,
but must instead have s
passed as its last argument, unlike preview
.
Note: this could been named headOf
.
>>>
firstOf traverse [1..10]
Just 1
>>>
firstOf both (1,2)
Just 1
>>>
firstOf ignored ()
Nothing
firstOf
::Getter
s a -> s ->Maybe
afirstOf
::Fold
s a -> s ->Maybe
afirstOf
::Lens'
s a -> s ->Maybe
afirstOf
::Iso'
s a -> s ->Maybe
afirstOf
::Traversal'
s a -> s ->Maybe
a
(^?!) :: HasCallStack => s -> Getting (Endo a) s a -> a infixl 8 #
(^?) :: s -> Getting (First a) s a -> Maybe a infixl 8 #
Perform a safe head
of a Fold
or Traversal
or retrieve Just
the result
from a Getter
or Lens
.
When using a Traversal
as a partial Lens
, or a Fold
as a partial Getter
this can be a convenient
way to extract the optional value.
Note: if you get stack overflows due to this, you may want to use firstOf
instead, which can deal
more gracefully with heavily left-biased trees. This is because ^?
works by using the
First
monoid, which can occasionally cause space leaks.
>>>
Left 4 ^?_Left
Just 4
>>>
Right 4 ^?_Left
Nothing
>>>
"world" ^? ix 3
Just 'l'
>>>
"world" ^? ix 20
Nothing
This operator works as an infix version of preview
.
(^?
) ≡flip
preview
It may be helpful to think of ^?
as having one of the following
more specialized types:
(^?
) :: s ->Getter
s a ->Maybe
a (^?
) :: s ->Fold
s a ->Maybe
a (^?
) :: s ->Lens'
s a ->Maybe
a (^?
) :: s ->Iso'
s a ->Maybe
a (^?
) :: s ->Traversal'
s a ->Maybe
a
lengthOf :: Getting (Endo (Endo Int)) s a -> s -> Int #
Calculate the number of targets there are for a Fold
in a given container.
Note: This can be rather inefficient for large containers and just like length
,
this will not terminate for infinite folds.
length
≡lengthOf
folded
>>>
lengthOf _1 ("hello",())
1
>>>
lengthOf traverse [1..10]
10
>>>
lengthOf (traverse.traverse) [[1,2],[3,4],[5,6]]
6
lengthOf
(folded
.
folded
) :: (Foldable
f,Foldable
g) => f (g a) ->Int
lengthOf
::Getter
s a -> s ->Int
lengthOf
::Fold
s a -> s ->Int
lengthOf
::Lens'
s a -> s ->Int
lengthOf
::Iso'
s a -> s ->Int
lengthOf
::Traversal'
s a -> s ->Int
concatOf :: Getting [r] s [r] -> s -> [r] #
Concatenate all of the lists targeted by a Fold
into a longer list.
>>>
concatOf both ("pan","ama")
"panama"
concat
≡concatOf
folded
concatOf
≡view
concatOf
::Getter
s [r] -> s -> [r]concatOf
::Fold
s [r] -> s -> [r]concatOf
::Iso'
s [r] -> s -> [r]concatOf
::Lens'
s [r] -> s -> [r]concatOf
::Traversal'
s [r] -> s -> [r]
concatMapOf :: Getting [r] s a -> (a -> [r]) -> s -> [r] #
Map a function over all the targets of a Fold
of a container and concatenate the resulting lists.
>>>
concatMapOf both (\x -> [x, x + 1]) (1,3)
[1,2,3,4]
concatMap
≡concatMapOf
folded
concatMapOf
::Getter
s a -> (a -> [r]) -> s -> [r]concatMapOf
::Fold
s a -> (a -> [r]) -> s -> [r]concatMapOf
::Lens'
s a -> (a -> [r]) -> s -> [r]concatMapOf
::Iso'
s a -> (a -> [r]) -> s -> [r]concatMapOf
::Traversal'
s a -> (a -> [r]) -> s -> [r]
notElemOf :: Eq a => Getting All s a -> a -> s -> Bool #
Does the element not occur anywhere within a given Fold
of the structure?
>>>
notElemOf each 'd' ('a','b','c')
True
>>>
notElemOf each 'a' ('a','b','c')
False
notElem
≡notElemOf
folded
notElemOf
::Eq
a =>Getter
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Fold
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Iso'
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Lens'
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Traversal'
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Prism'
s a -> a -> s ->Bool
elemOf :: Eq a => Getting Any s a -> a -> s -> Bool #
Does the element occur anywhere within a given Fold
of the structure?
>>>
elemOf both "hello" ("hello","world")
True
elem
≡elemOf
folded
elemOf
::Eq
a =>Getter
s a -> a -> s ->Bool
elemOf
::Eq
a =>Fold
s a -> a -> s ->Bool
elemOf
::Eq
a =>Lens'
s a -> a -> s ->Bool
elemOf
::Eq
a =>Iso'
s a -> a -> s ->Bool
elemOf
::Eq
a =>Traversal'
s a -> a -> s ->Bool
elemOf
::Eq
a =>Prism'
s a -> a -> s ->Bool
msumOf :: MonadPlus m => Getting (Endo (m a)) s (m a) -> s -> m a #
The sum of a collection of actions, generalizing concatOf
.
>>>
msumOf both ("hello","world")
"helloworld"
>>>
msumOf each (Nothing, Just "hello", Nothing)
Just "hello"
msum
≡msumOf
folded
msumOf
::MonadPlus
m =>Getter
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Fold
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Lens'
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Iso'
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Traversal'
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Prism'
s (m a) -> s -> m a
asumOf :: Alternative f => Getting (Endo (f a)) s (f a) -> s -> f a #
The sum of a collection of actions, generalizing concatOf
.
>>>
asumOf both ("hello","world")
"helloworld"
>>>
asumOf each (Nothing, Just "hello", Nothing)
Just "hello"
asum
≡asumOf
folded
asumOf
::Alternative
f =>Getter
s (f a) -> s -> f aasumOf
::Alternative
f =>Fold
s (f a) -> s -> f aasumOf
::Alternative
f =>Lens'
s (f a) -> s -> f aasumOf
::Alternative
f =>Iso'
s (f a) -> s -> f aasumOf
::Alternative
f =>Traversal'
s (f a) -> s -> f aasumOf
::Alternative
f =>Prism'
s (f a) -> s -> f a
sequenceOf_ :: Monad m => Getting (Sequenced a m) s (m a) -> s -> m () #
Evaluate each monadic action referenced by a Fold
on the structure from left to right, and ignore the results.
>>>
sequenceOf_ both (putStrLn "hello",putStrLn "world")
hello world
sequence_
≡sequenceOf_
folded
sequenceOf_
::Monad
m =>Getter
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Fold
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Lens'
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Iso'
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Traversal'
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Prism'
s (m a) -> s -> m ()
forMOf_ :: Monad m => Getting (Sequenced r m) s a -> s -> (a -> m r) -> m () #
forMOf_
is mapMOf_
with two of its arguments flipped.
>>>
forMOf_ both ("hello","world") putStrLn
hello world
forM_
≡forMOf_
folded
forMOf_
::Monad
m =>Getter
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Fold
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Lens'
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Iso'
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Traversal'
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Prism'
s a -> s -> (a -> m r) -> m ()
mapMOf_ :: Monad m => Getting (Sequenced r m) s a -> (a -> m r) -> s -> m () #
Map each target of a Fold
on a structure to a monadic action, evaluate these actions from left to right, and ignore the results.
>>>
mapMOf_ both putStrLn ("hello","world")
hello world
mapM_
≡mapMOf_
folded
mapMOf_
::Monad
m =>Getter
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Fold
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Lens'
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Iso'
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Traversal'
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Prism'
s a -> (a -> m r) -> s -> m ()
sequence1Of_ :: Functor f => Getting (TraversedF a f) s (f a) -> s -> f () #
See sequenceAOf_
and traverse1Of_
.
sequence1Of_
::Apply
f =>Fold1
s (f a) -> s -> f ()
Since: lens-4.16
for1Of_ :: Functor f => Getting (TraversedF r f) s a -> s -> (a -> f r) -> f () #
See forOf_
and traverse1Of_
.
>>>
for1Of_ both1 ("abc", "bcd") (\ks -> Map.fromList [ (k, ()) | k <- ks ])
fromList [('b',()),('c',())]
for1Of_
::Apply
f =>Fold1
s a -> s -> (a -> f r) -> f ()
Since: lens-4.16
traverse1Of_ :: Functor f => Getting (TraversedF r f) s a -> (a -> f r) -> s -> f () #
Traverse over all of the targets of a Fold1
, computing an Apply
based answer.
As long as you have Applicative
or Functor
effect you are better using traverseOf_
.
The traverse1Of_
is useful only when you have genuine Apply
effect.
>>>
traverse1Of_ both1 (\ks -> Map.fromList [ (k, ()) | k <- ks ]) ("abc", "bcd")
fromList [('b',()),('c',())]
traverse1Of_
::Apply
f =>Fold1
s a -> (a -> f r) -> s -> f ()
Since: lens-4.16
sequenceAOf_ :: Functor f => Getting (Traversed a f) s (f a) -> s -> f () #
Evaluate each action in observed by a Fold
on a structure from left to right, ignoring the results.
sequenceA_
≡sequenceAOf_
folded
>>>
sequenceAOf_ both (putStrLn "hello",putStrLn "world")
hello world
sequenceAOf_
::Functor
f =>Getter
s (f a) -> s -> f ()sequenceAOf_
::Applicative
f =>Fold
s (f a) -> s -> f ()sequenceAOf_
::Functor
f =>Lens'
s (f a) -> s -> f ()sequenceAOf_
::Functor
f =>Iso'
s (f a) -> s -> f ()sequenceAOf_
::Applicative
f =>Traversal'
s (f a) -> s -> f ()sequenceAOf_
::Applicative
f =>Prism'
s (f a) -> s -> f ()
forOf_ :: Functor f => Getting (Traversed r f) s a -> s -> (a -> f r) -> f () #
Traverse over all of the targets of a Fold
(or Getter
), computing an Applicative
(or Functor
)-based answer,
but unlike forOf
do not construct a new structure. forOf_
generalizes
for_
to work over any Fold
.
When passed a Getter
, forOf_
can work over any Functor
, but when passed a Fold
, forOf_
requires
an Applicative
.
for_
≡forOf_
folded
>>>
forOf_ both ("hello","world") putStrLn
hello world
The rather specific signature of forOf_
allows it to be used as if the signature was any of:
iforOf_
l s ≡forOf_
l s.
Indexed
forOf_
::Functor
f =>Getter
s a -> s -> (a -> f r) -> f ()forOf_
::Applicative
f =>Fold
s a -> s -> (a -> f r) -> f ()forOf_
::Functor
f =>Lens'
s a -> s -> (a -> f r) -> f ()forOf_
::Functor
f =>Iso'
s a -> s -> (a -> f r) -> f ()forOf_
::Applicative
f =>Traversal'
s a -> s -> (a -> f r) -> f ()forOf_
::Applicative
f =>Prism'
s a -> s -> (a -> f r) -> f ()
traverseOf_ :: Functor f => Getting (Traversed r f) s a -> (a -> f r) -> s -> f () #
Traverse over all of the targets of a Fold
(or Getter
), computing an Applicative
(or Functor
)-based answer,
but unlike traverseOf
do not construct a new structure. traverseOf_
generalizes
traverse_
to work over any Fold
.
When passed a Getter
, traverseOf_
can work over any Functor
, but when passed a Fold
, traverseOf_
requires
an Applicative
.
>>>
traverseOf_ both putStrLn ("hello","world")
hello world
traverse_
≡traverseOf_
folded
traverseOf_
_2
::Functor
f => (c -> f r) -> (d, c) -> f ()traverseOf_
_Left
::Applicative
f => (a -> f b) ->Either
a c -> f ()
itraverseOf_
l ≡traverseOf_
l.
Indexed
The rather specific signature of traverseOf_
allows it to be used as if the signature was any of:
traverseOf_
::Functor
f =>Getter
s a -> (a -> f r) -> s -> f ()traverseOf_
::Applicative
f =>Fold
s a -> (a -> f r) -> s -> f ()traverseOf_
::Functor
f =>Lens'
s a -> (a -> f r) -> s -> f ()traverseOf_
::Functor
f =>Iso'
s a -> (a -> f r) -> s -> f ()traverseOf_
::Applicative
f =>Traversal'
s a -> (a -> f r) -> s -> f ()traverseOf_
::Applicative
f =>Prism'
s a -> (a -> f r) -> s -> f ()
sumOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a #
Calculate the Sum
of every number targeted by a Fold
.
>>>
sumOf both (5,6)
11>>>
sumOf folded [1,2,3,4]
10>>>
sumOf (folded.both) [(1,2),(3,4)]
10>>>
import Data.Data.Lens
>>>
sumOf biplate [(1::Int,[]),(2,[(3::Int,4::Int)])] :: Int
10
sum
≡sumOf
folded
This operation may be more strict than you would expect. If you
want a lazier version use ala
Sum
.
foldMapOf
sumOf
_1
::Num
a => (a, b) -> asumOf
(folded
.
_1
) :: (Foldable
f,Num
a) => f (a, b) -> a
sumOf
::Num
a =>Getter
s a -> s -> asumOf
::Num
a =>Fold
s a -> s -> asumOf
::Num
a =>Lens'
s a -> s -> asumOf
::Num
a =>Iso'
s a -> s -> asumOf
::Num
a =>Traversal'
s a -> s -> asumOf
::Num
a =>Prism'
s a -> s -> a
productOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a #
Calculate the Product
of every number targeted by a Fold
.
>>>
productOf both (4,5)
20>>>
productOf folded [1,2,3,4,5]
120
product
≡productOf
folded
This operation may be more strict than you would expect. If you
want a lazier version use ala
Product
.
foldMapOf
productOf
::Num
a =>Getter
s a -> s -> aproductOf
::Num
a =>Fold
s a -> s -> aproductOf
::Num
a =>Lens'
s a -> s -> aproductOf
::Num
a =>Iso'
s a -> s -> aproductOf
::Num
a =>Traversal'
s a -> s -> aproductOf
::Num
a =>Prism'
s a -> s -> a
noneOf :: Getting Any s a -> (a -> Bool) -> s -> Bool #
Returns True
only if no targets of a Fold
satisfy a predicate.
>>>
noneOf each (is _Nothing) (Just 3, Just 4, Just 5)
True>>>
noneOf (folded.folded) (<10) [[13,99,20],[3,71,42]]
False
inoneOf
l =noneOf
l.
Indexed
noneOf
::Getter
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Fold
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Lens'
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Iso'
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Traversal'
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Prism'
s a -> (a ->Bool
) -> s ->Bool
allOf :: Getting All s a -> (a -> Bool) -> s -> Bool #
Returns True
if every target of a Fold
satisfies a predicate.
>>>
allOf both (>=3) (4,5)
True>>>
allOf folded (>=2) [1..10]
False
all
≡allOf
folded
iallOf
l =allOf
l.
Indexed
allOf
::Getter
s a -> (a ->Bool
) -> s ->Bool
allOf
::Fold
s a -> (a ->Bool
) -> s ->Bool
allOf
::Lens'
s a -> (a ->Bool
) -> s ->Bool
allOf
::Iso'
s a -> (a ->Bool
) -> s ->Bool
allOf
::Traversal'
s a -> (a ->Bool
) -> s ->Bool
allOf
::Prism'
s a -> (a ->Bool
) -> s ->Bool
anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool #
Returns True
if any target of a Fold
satisfies a predicate.
>>>
anyOf both (=='x') ('x','y')
True>>>
import Data.Data.Lens
>>>
anyOf biplate (== "world") (((),2::Int),"hello",("world",11::Int))
True
any
≡anyOf
folded
ianyOf
l ≡anyOf
l.
Indexed
anyOf
::Getter
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Fold
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Lens'
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Iso'
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Traversal'
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Prism'
s a -> (a ->Bool
) -> s ->Bool
orOf :: Getting Any s Bool -> s -> Bool #
Returns True
if any target of a Fold
is True
.
>>>
orOf both (True,False)
True>>>
orOf both (False,False)
False
or
≡orOf
folded
orOf
::Getter
sBool
-> s ->Bool
orOf
::Fold
sBool
-> s ->Bool
orOf
::Lens'
sBool
-> s ->Bool
orOf
::Iso'
sBool
-> s ->Bool
orOf
::Traversal'
sBool
-> s ->Bool
orOf
::Prism'
sBool
-> s ->Bool
andOf :: Getting All s Bool -> s -> Bool #
Returns True
if every target of a Fold
is True
.
>>>
andOf both (True,False)
False>>>
andOf both (True,True)
True
and
≡andOf
folded
andOf
::Getter
sBool
-> s ->Bool
andOf
::Fold
sBool
-> s ->Bool
andOf
::Lens'
sBool
-> s ->Bool
andOf
::Iso'
sBool
-> s ->Bool
andOf
::Traversal'
sBool
-> s ->Bool
andOf
::Prism'
sBool
-> s ->Bool
(^..) :: s -> Getting (Endo [a]) s a -> [a] infixl 8 #
A convenient infix (flipped) version of toListOf
.
>>>
[[1,2],[3]]^..id
[[[1,2],[3]]]>>>
[[1,2],[3]]^..traverse
[[1,2],[3]]>>>
[[1,2],[3]]^..traverse.traverse
[1,2,3]
>>>
(1,2)^..both
[1,2]
toList
xs ≡ xs^..
folded
(^..
) ≡flip
toListOf
(^..
) :: s ->Getter
s a -> a :: s ->Fold
s a -> a :: s ->Lens'
s a -> a :: s ->Iso'
s a -> a :: s ->Traversal'
s a -> a :: s ->Prism'
s a -> [a]
toNonEmptyOf :: Getting (NonEmptyDList a) s a -> s -> NonEmpty a #
Extract a NonEmpty
of the targets of Fold1
.
>>>
toNonEmptyOf both1 ("hello", "world")
"hello" :| ["world"]
toNonEmptyOf
::Getter
s a -> s -> NonEmpty atoNonEmptyOf
::Fold1
s a -> s -> NonEmpty atoNonEmptyOf
::Lens'
s a -> s -> NonEmpty atoNonEmptyOf
::Iso'
s a -> s -> NonEmpty atoNonEmptyOf
::Traversal1'
s a -> s -> NonEmpty atoNonEmptyOf
::Prism'
s a -> s -> NonEmpty a
foldlOf :: Getting (Dual (Endo r)) s a -> (r -> a -> r) -> r -> s -> r #
Left-associative fold of the parts of a structure that are viewed through a Lens
, Getter
, Fold
or Traversal
.
foldl
≡foldlOf
folded
foldlOf
::Getter
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Fold
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Lens'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Iso'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Traversal'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Prism'
s a -> (r -> a -> r) -> r -> s -> r
foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r #
Right-associative fold of parts of a structure that are viewed through a Lens
, Getter
, Fold
or Traversal
.
foldr
≡foldrOf
folded
foldrOf
::Getter
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Fold
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Lens'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Iso'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Traversal'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Prism'
s a -> (a -> r -> r) -> r -> s -> r
ifoldrOf
l ≡foldrOf
l.
Indexed
foldrOf
::Getting
(Endo
r) s a -> (a -> r -> r) -> r -> s -> r
foldOf :: Getting a s a -> s -> a #
Combine the elements of a structure viewed through a Lens
, Getter
,
Fold
or Traversal
using a monoid.
>>>
foldOf (folded.folded) [[Sum 1,Sum 4],[Sum 8, Sum 8],[Sum 21]]
Sum {getSum = 42}
fold
=foldOf
folded
foldOf
≡view
foldOf
::Getter
s m -> s -> mfoldOf
::Monoid
m =>Fold
s m -> s -> mfoldOf
::Lens'
s m -> s -> mfoldOf
::Iso'
s m -> s -> mfoldOf
::Monoid
m =>Traversal'
s m -> s -> mfoldOf
::Monoid
m =>Prism'
s m -> s -> m
foldMapOf :: Getting r s a -> (a -> r) -> s -> r #
Map each part of a structure viewed through a Lens
, Getter
,
Fold
or Traversal
to a monoid and combine the results.
>>>
foldMapOf (folded . both . _Just) Sum [(Just 21, Just 21)]
Sum {getSum = 42}
foldMap
=foldMapOf
folded
foldMapOf
≡views
ifoldMapOf
l =foldMapOf
l.
Indexed
foldMapOf
::Getter
s a -> (a -> r) -> s -> rfoldMapOf
::Monoid
r =>Fold
s a -> (a -> r) -> s -> rfoldMapOf
::Semigroup
r =>Fold1
s a -> (a -> r) -> s -> rfoldMapOf
::Lens'
s a -> (a -> r) -> s -> rfoldMapOf
::Iso'
s a -> (a -> r) -> s -> rfoldMapOf
::Monoid
r =>Traversal'
s a -> (a -> r) -> s -> rfoldMapOf
::Semigroup
r =>Traversal1'
s a -> (a -> r) -> s -> rfoldMapOf
::Monoid
r =>Prism'
s a -> (a -> r) -> s -> r
foldMapOf
::Getting
r s a -> (a -> r) -> s -> r
lined :: Applicative f => IndexedLensLike' Int f String String #
A Fold
over the individual lines
of a String
.
lined
::Fold
String
String
lined
::Traversal'
String
String
lined
::IndexedFold
Int
String
String
lined
::IndexedTraversal'
Int
String
String
Note: This function type-checks as a Traversal
but it doesn't satisfy the laws. It's only valid to use it
when you don't insert any newline characters while traversing, and if your original String
contains only
isolated newline characters.
worded :: Applicative f => IndexedLensLike' Int f String String #
A Fold
over the individual words
of a String
.
worded
::Fold
String
String
worded
::Traversal'
String
String
worded
::IndexedFold
Int
String
String
worded
::IndexedTraversal'
Int
String
String
Note: This function type-checks as a Traversal
but it doesn't satisfy the laws. It's only valid to use it
when you don't insert any whitespace characters while traversing, and if your original String
contains only
isolated space characters (and no other characters that count as space, such as non-breaking spaces).
droppingWhile :: (Conjoined p, Profunctor q, Applicative f) => (a -> Bool) -> Optical p q (Compose (State Bool) f) s t a a -> Optical p q f s t a a #
Obtain a Fold
by dropping elements from another Fold
, Lens
, Iso
, Getter
or Traversal
while a predicate holds.
dropWhile
p ≡toListOf
(droppingWhile
pfolded
)
>>>
toListOf (droppingWhile (<=3) folded) [1..6]
[4,5,6]
>>>
toListOf (droppingWhile (<=3) folded) [1,6,1]
[6,1]
droppingWhile
:: (a ->Bool
) ->Fold
s a ->Fold
s adroppingWhile
:: (a ->Bool
) ->Getter
s a ->Fold
s adroppingWhile
:: (a ->Bool
) ->Traversal'
s a ->Fold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->Lens'
s a ->Fold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->Prism'
s a ->Fold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->Iso'
s a ->Fold
s a -- see notes
droppingWhile
:: (a ->Bool
) ->IndexPreservingTraversal'
s a ->IndexPreservingFold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->IndexPreservingLens'
s a ->IndexPreservingFold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->IndexPreservingGetter
s a ->IndexPreservingFold
s adroppingWhile
:: (a ->Bool
) ->IndexPreservingFold
s a ->IndexPreservingFold
s a
droppingWhile
:: (a ->Bool
) ->IndexedTraversal'
i s a ->IndexedFold
i s a -- see notesdroppingWhile
:: (a ->Bool
) ->IndexedLens'
i s a ->IndexedFold
i s a -- see notesdroppingWhile
:: (a ->Bool
) ->IndexedGetter
i s a ->IndexedFold
i s adroppingWhile
:: (a ->Bool
) ->IndexedFold
i s a ->IndexedFold
i s a
Note: Many uses of this combinator will yield something that meets the types, but not the laws of a valid
Traversal
or IndexedTraversal
. The Traversal
and IndexedTraversal
laws are only satisfied if the
new values you assign to the first target also does not pass the predicate! Otherwise subsequent traversals
will visit fewer elements and Traversal
fusion is not sound.
So for any traversal t
and predicate p
,
may not be lawful, but
droppingWhile
p t(
is. For example:dropping
1 . droppingWhile
p) t
>>>
let l :: Traversal' [Int] Int; l = droppingWhile (<= 1) traverse
>>>
let l' :: Traversal' [Int] Int; l' = dropping 1 l
l
is not a lawful setter because
:over
l f .
over
l g ≢ over
l (f . g)
>>>
[1,2,3] & l .~ 0 & l .~ 4
[1,0,0]>>>
[1,2,3] & l .~ 4
[1,4,4]
l'
on the other hand behaves lawfully:
>>>
[1,2,3] & l' .~ 0 & l' .~ 4
[1,2,4]>>>
[1,2,3] & l' .~ 4
[1,2,4]
takingWhile :: (Conjoined p, Applicative f) => (a -> Bool) -> Over p (TakingWhile p f a a) s t a a -> Over p f s t a a #
Obtain a Fold
by taking elements from another Fold
, Lens
, Iso
, Getter
or Traversal
while a predicate holds.
takeWhile
p ≡toListOf
(takingWhile
pfolded
)
>>>
timingOut $ toListOf (takingWhile (<=3) folded) [1..]
[1,2,3]
takingWhile
:: (a ->Bool
) ->Fold
s a ->Fold
s atakingWhile
:: (a ->Bool
) ->Getter
s a ->Fold
s atakingWhile
:: (a ->Bool
) ->Traversal'
s a ->Fold
s a -- * See note belowtakingWhile
:: (a ->Bool
) ->Lens'
s a ->Fold
s a -- * See note belowtakingWhile
:: (a ->Bool
) ->Prism'
s a ->Fold
s a -- * See note belowtakingWhile
:: (a ->Bool
) ->Iso'
s a ->Fold
s a -- * See note belowtakingWhile
:: (a ->Bool
) ->IndexedTraversal'
i s a ->IndexedFold
i s a -- * See note belowtakingWhile
:: (a ->Bool
) ->IndexedLens'
i s a ->IndexedFold
i s a -- * See note belowtakingWhile
:: (a ->Bool
) ->IndexedFold
i s a ->IndexedFold
i s atakingWhile
:: (a ->Bool
) ->IndexedGetter
i s a ->IndexedFold
i s a
Note: When applied to a Traversal
, takingWhile
yields something that can be used as if it were a Traversal
, but
which is not a Traversal
per the laws, unless you are careful to ensure that you do not invalidate the predicate when
writing back through it.
filteredBy :: (Indexable i p, Applicative f) => Getting (First i) a i -> p a (f a) -> a -> f a #
Obtain a potentially empty IndexedTraversal
by taking the first element from another,
potentially empty Fold
and using it as an index.
The resulting optic can be composed with to filter another Lens
, Iso
, Getter
, Fold
(or Traversal
).
>>>
[(Just 2, 3), (Nothing, 4)] & mapped . filteredBy (_1 . _Just) <. _2 %@~ (*) :: [(Maybe Int, Int)]
[(Just 2,6),(Nothing,4)]
filteredBy
::Fold
a i ->IndexedTraversal'
i a a
Note: As with filtered
, this is not a legal IndexedTraversal
, unless you are very careful not to invalidate the predicate on the target!
filtered :: (Choice p, Applicative f) => (a -> Bool) -> Optic' p f a a #
Obtain a Fold
that can be composed with to filter another Lens
, Iso
, Getter
, Fold
(or Traversal
).
Note: This is not a legal Traversal
, unless you are very careful not to invalidate the predicate on the target.
Note: This is also not a legal Prism
, unless you are very careful not to inject a value that fails the predicate.
As a counter example, consider that given evens =
the second filtered
even
Traversal
law is violated:
over
evenssucc
.
over
evenssucc
/=
over
evens (succ
.
succ
)
So, in order for this to qualify as a legal Traversal
you can only use it for actions that preserve the result of the predicate!
>>>
[1..10]^..folded.filtered even
[2,4,6,8,10]
This will preserve an index if it is present.
replicated :: Int -> Fold a a #
A Fold
that replicates its input n
times.
replicate
n ≡toListOf
(replicated
n)
>>>
5^..replicated 20
[5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5]
folded64 :: Foldable f => IndexedFold Int64 (f a) a #
folded :: Foldable f => IndexedFold Int (f a) a #
ifoldring :: (Indexable i p, Contravariant f, Applicative f) => ((i -> a -> f a -> f a) -> f a -> s -> f a) -> Over p f s t a b #
Obtain FoldWithIndex
by lifting ifoldr
like function.
foldring :: (Contravariant f, Applicative f) => ((a -> f a -> f a) -> f a -> s -> f a) -> LensLike f s t a b #
ifolding :: (Foldable f, Indexable i p, Contravariant g, Applicative g) => (s -> f (i, a)) -> Over p g s t a b #
_Show :: (Read a, Show a) => Prism' String a #
This is an improper prism for text formatting based on Read
and Show
.
This Prism
is "improper" in the sense that it normalizes the text formatting, but round tripping
is idempotent given sane 'Read'/'Show' instances.
>>>
_Show # 2
"2"
>>>
"EQ" ^? _Show :: Maybe Ordering
Just EQ
_Show
≡prism'
show
readMaybe
nearly :: a -> (a -> Bool) -> Prism' a () #
This Prism
compares for approximate equality with a given value and a predicate for testing,
an example where the value is the empty list and the predicate checks that a list is empty (same
as _Empty
with the AsEmpty
list instance):
>>>
nearly [] null # ()
[]>>>
[1,2,3,4] ^? nearly [] null
Nothing
nearly
[]null
::Prism'
[a] ()
To comply with the Prism
laws the arguments you supply to nearly a p
are somewhat constrained.
We assume p x
holds iff x ≡ a
. Under that assumption then this is a valid Prism
.
This is useful when working with a type where you can test equality for only a subset of its values, and the prism selects such a value.
_Just :: Prism (Maybe a) (Maybe b) a b #
This Prism
provides a Traversal
for tweaking the target of the value of Just
in a Maybe
.
>>>
over _Just (+1) (Just 2)
Just 3
Unlike traverse
this is a Prism
, and so you can use it to inject as well:
>>>
_Just # 5
Just 5
>>>
5^.re _Just
Just 5
Interestingly,
m^?
_Just
≡ m
>>>
Just x ^? _Just
Just x
>>>
Nothing ^? _Just
Nothing
_Right :: Prism (Either c a) (Either c b) a b #
This Prism
provides a Traversal
for tweaking the Right
half of an Either
:
>>>
over _Right (+1) (Left 2)
Left 2
>>>
over _Right (+1) (Right 2)
Right 3
>>>
Right "hello" ^._Right
"hello"
>>>
Left "hello" ^._Right :: [Double]
[]
It also can be turned around to obtain the embedding into the Right
half of an Either
:
>>>
_Right # 5
Right 5
>>>
5^.re _Right
Right 5
_Left :: Prism (Either a c) (Either b c) a b #
This Prism
provides a Traversal
for tweaking the Left
half of an Either
:
>>>
over _Left (+1) (Left 2)
Left 3
>>>
over _Left (+1) (Right 2)
Right 2
>>>
Right 42 ^._Left :: String
""
>>>
Left "hello" ^._Left
"hello"
It also can be turned around to obtain the embedding into the Left
half of an Either
:
>>>
_Left # 5
Left 5
>>>
5^.re _Left
Left 5
matching :: APrism s t a b -> s -> Either t a #
Retrieve the value targeted by a Prism
or return the
original value while allowing the type to change if it does
not match.
>>>
matching _Just (Just 12)
Right 12
>>>
matching _Just (Nothing :: Maybe Int) :: Either (Maybe Bool) Int
Left Nothing
below :: Traversable f => APrism' s a -> Prism' (f s) (f a) #
lift
a Prism
through a Traversable
functor, giving a Prism that matches only if all the elements of the container match the Prism
.
>>>
[Left 1, Right "foo", Left 4, Right "woot"]^..below _Right
[]
>>>
[Right "hail hydra!", Right "foo", Right "blah", Right "woot"]^..below _Right
[["hail hydra!","foo","blah","woot"]]
aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b) #
Use a Prism
to work over part of a structure.
without :: APrism s t a b -> APrism u v c d -> Prism (Either s u) (Either t v) (Either a c) (Either b d) #
outside :: Representable p => APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r) #
clonePrism :: APrism s t a b -> Prism s t a b #
Clone a Prism
so that you can reuse the same monomorphically typed Prism
for different purposes.
See cloneLens
and cloneTraversal
for examples of why you might want to do this.
withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r #
Convert APrism
to the pair of functions that characterize it.
type APrism s t a b = Market a b a (Identity b) -> Market a b s (Identity t) #
If you see this in a signature for a function, the function is expecting a Prism
.
reuses :: MonadState b m => AReview t b -> (t -> r) -> m r #
This can be used to turn an Iso
or Prism
around and use
the current state through it the other way,
applying a function.
reuses
≡uses
.
re
reuses
(unto
f) g ≡gets
(g.
f)
>>>
evalState (reuses _Left isLeft) (5 :: Int)
True
reuses
::MonadState
a m =>Prism'
s a -> (s -> r) -> m rreuses
::MonadState
a m =>Iso'
s a -> (s -> r) -> m r
reuse :: MonadState b m => AReview t b -> m t #
This can be used to turn an Iso
or Prism
around and use
a value (or the current environment) through it the other way.
reuse
≡use
.
re
reuse
.
unto
≡gets
>>>
evalState (reuse _Left) 5
Left 5
>>>
evalState (reuse (unto succ)) 5
6
reuse
::MonadState
a m =>Prism'
s a -> m sreuse
::MonadState
a m =>Iso'
s a -> m s
reviews :: MonadReader b m => AReview t b -> (t -> r) -> m r #
This can be used to turn an Iso
or Prism
around and view
a value (or the current environment) through it the other way,
applying a function.
reviews
≡views
.
re
reviews
(unto
f) g ≡ g.
f
>>>
reviews _Left isRight "mustard"
False
>>>
reviews (unto succ) (*2) 3
8
Usually this function is used in the (->)
Monad
with a Prism
or Iso
, in which case it may be useful to think of
it as having one of these more restricted type signatures:
reviews
::Iso'
s a -> (s -> r) -> a -> rreviews
::Prism'
s a -> (s -> r) -> a -> r
However, when working with a Monad
transformer stack, it is sometimes useful to be able to review
the current environment, in which case
it may be beneficial to think of it as having one of these slightly more liberal type signatures:
reviews
::MonadReader
a m =>Iso'
s a -> (s -> r) -> m rreviews
::MonadReader
a m =>Prism'
s a -> (s -> r) -> m r
(#) :: AReview t b -> b -> t infixr 8 #
An infix alias for review
.
unto
f # x ≡ f x l # x ≡ x^.
re
l
This is commonly used when using a Prism
as a smart constructor.
>>>
_Left # 4
Left 4
But it can be used for any Prism
>>>
base 16 # 123
"7b"
(#) ::Iso'
s a -> a -> s (#) ::Prism'
s a -> a -> s (#) ::Review
s a -> a -> s (#) ::Equality'
s a -> a -> s
review :: MonadReader b m => AReview t b -> m t #
This can be used to turn an Iso
or Prism
around and view
a value (or the current environment) through it the other way.
review
≡view
.
re
review
.unto
≡id
>>>
review _Left "mustard"
Left "mustard"
>>>
review (unto succ) 5
6
Usually review
is used in the (->)
Monad
with a Prism
or Iso
, in which case it may be useful to think of
it as having one of these more restricted type signatures:
review
::Iso'
s a -> a -> sreview
::Prism'
s a -> a -> s
However, when working with a Monad
transformer stack, it is sometimes useful to be able to review
the current environment, in which case
it may be beneficial to think of it as having one of these slightly more liberal type signatures:
review
::MonadReader
a m =>Iso'
s a -> m sreview
::MonadReader
a m =>Prism'
s a -> m s
re :: AReview t b -> Getter b t #
Turn a Prism
or Iso
around to build a Getter
.
If you have an Iso
, from
is a more powerful version of this function
that will return an Iso
instead of a mere Getter
.
>>>
5 ^.re _Left
Left 5
>>>
6 ^.re (_Left.unto succ)
Left 7
review
≡view
.
re
reviews
≡views
.
re
reuse
≡use
.
re
reuses
≡uses
.
re
re
::Prism
s t a b ->Getter
b tre
::Iso
s t a b ->Getter
b t
getting :: (Profunctor p, Profunctor q, Functor f, Contravariant f) => Optical p q f s t a b -> Optical' p q f s a #
Coerce a Getter
-compatible Optical
to an Optical'
. This
is useful when using a Traversal
that is not simple as a Getter
or a
Fold
.
getting
::Traversal
s t a b ->Fold
s agetting
::Lens
s t a b ->Getter
s agetting
::IndexedTraversal
i s t a b ->IndexedFold
i s agetting
::IndexedLens
i s t a b ->IndexedGetter
i s a
(^@.) :: s -> IndexedGetting i (i, a) s a -> (i, a) infixl 8 #
View the index and value of an IndexedGetter
or IndexedLens
.
This is the same operation as iview
with the arguments flipped.
The fixity and semantics are such that subsequent field accesses can be
performed with (.
).
(^@.
) :: s ->IndexedGetter
i s a -> (i, a) (^@.
) :: s ->IndexedLens'
i s a -> (i, a)
The result probably doesn't have much meaning when applied to an IndexedFold
.
iuses :: MonadState s m => IndexedGetting i r s a -> (i -> a -> r) -> m r #
Use a function of the index and value of an IndexedGetter
into the current state.
When applied to an IndexedFold
the result will be a monoidal summary instead of a single answer.
iuse :: MonadState s m => IndexedGetting i (i, a) s a -> m (i, a) #
Use the index and value of an IndexedGetter
into the current state as a pair.
When applied to an IndexedFold
the result will most likely be a nonsensical monoidal summary of
the indices tupled with a monoidal summary of the values and probably not whatever it is you wanted.
iviews :: MonadReader s m => IndexedGetting i r s a -> (i -> a -> r) -> m r #
View a function of the index and value of an IndexedGetter
into the current environment.
When applied to an IndexedFold
the result will be a monoidal summary instead of a single answer.
iviews
≡ifoldMapOf
iview :: MonadReader s m => IndexedGetting i (i, a) s a -> m (i, a) #
View the index and value of an IndexedGetter
into the current environment as a pair.
When applied to an IndexedFold
the result will most likely be a nonsensical monoidal summary of
the indices tupled with a monoidal summary of the values and probably not whatever it is you wanted.
ilistenings :: MonadWriter w m => IndexedGetting i v w u -> (i -> u -> v) -> m a -> m (a, v) #
This is a generalized form of listen
that only extracts the portion of
the log that is focused on by a Getter
. If given a Fold
or a Traversal
then a monoidal summary of the parts of the log that are visited will be
returned.
ilistenings
::MonadWriter
w m =>IndexedGetter
w u -> (i -> u -> v) -> m a -> m (a, v)ilistenings
::MonadWriter
w m =>IndexedLens'
w u -> (i -> u -> v) -> m a -> m (a, v)ilistenings
:: (MonadWriter
w m,Monoid
v) =>IndexedFold
w u -> (i -> u -> v) -> m a -> m (a, v)ilistenings
:: (MonadWriter
w m,Monoid
v) =>IndexedTraversal'
w u -> (i -> u -> v) -> m a -> m (a, v)
listenings :: MonadWriter w m => Getting v w u -> (u -> v) -> m a -> m (a, v) #
This is a generalized form of listen
that only extracts the portion of
the log that is focused on by a Getter
. If given a Fold
or a Traversal
then a monoidal summary of the parts of the log that are visited will be
returned.
listenings
::MonadWriter
w m =>Getter
w u -> (u -> v) -> m a -> m (a, v)listenings
::MonadWriter
w m =>Lens'
w u -> (u -> v) -> m a -> m (a, v)listenings
::MonadWriter
w m =>Iso'
w u -> (u -> v) -> m a -> m (a, v)listenings
:: (MonadWriter
w m,Monoid
v) =>Fold
w u -> (u -> v) -> m a -> m (a, v)listenings
:: (MonadWriter
w m,Monoid
v) =>Traversal'
w u -> (u -> v) -> m a -> m (a, v)listenings
:: (MonadWriter
w m,Monoid
v) =>Prism'
w u -> (u -> v) -> m a -> m (a, v)
ilistening :: MonadWriter w m => IndexedGetting i (i, u) w u -> m a -> m (a, (i, u)) #
This is a generalized form of listen
that only extracts the portion of
the log that is focused on by a Getter
. If given a Fold
or a Traversal
then a monoidal summary of the parts of the log that are visited will be
returned.
ilistening
::MonadWriter
w m =>IndexedGetter
i w u -> m a -> m (a, (i, u))ilistening
::MonadWriter
w m =>IndexedLens'
i w u -> m a -> m (a, (i, u))ilistening
:: (MonadWriter
w m,Monoid
u) =>IndexedFold
i w u -> m a -> m (a, (i, u))ilistening
:: (MonadWriter
w m,Monoid
u) =>IndexedTraversal'
i w u -> m a -> m (a, (i, u))
listening :: MonadWriter w m => Getting u w u -> m a -> m (a, u) #
This is a generalized form of listen
that only extracts the portion of
the log that is focused on by a Getter
. If given a Fold
or a Traversal
then a monoidal summary of the parts of the log that are visited will be
returned.
listening
::MonadWriter
w m =>Getter
w u -> m a -> m (a, u)listening
::MonadWriter
w m =>Lens'
w u -> m a -> m (a, u)listening
::MonadWriter
w m =>Iso'
w u -> m a -> m (a, u)listening
:: (MonadWriter
w m,Monoid
u) =>Fold
w u -> m a -> m (a, u)listening
:: (MonadWriter
w m,Monoid
u) =>Traversal'
w u -> m a -> m (a, u)listening
:: (MonadWriter
w m,Monoid
u) =>Prism'
w u -> m a -> m (a, u)
uses :: MonadState s m => LensLike' (Const r :: Type -> Type) s a -> (a -> r) -> m r #
Use the target of a Lens
, Iso
or
Getter
in the current state, or use a summary of a
Fold
or Traversal
that
points to a monoidal value.
>>>
evalState (uses _1 length) ("hello","world")
5
uses
::MonadState
s m =>Getter
s a -> (a -> r) -> m ruses
:: (MonadState
s m,Monoid
r) =>Fold
s a -> (a -> r) -> m ruses
::MonadState
s m =>Lens'
s a -> (a -> r) -> m ruses
::MonadState
s m =>Iso'
s a -> (a -> r) -> m ruses
:: (MonadState
s m,Monoid
r) =>Traversal'
s a -> (a -> r) -> m r
uses
::MonadState
s m =>Getting
r s t a b -> (a -> r) -> m r
use :: MonadState s m => Getting a s a -> m a #
Use the target of a Lens
, Iso
, or
Getter
in the current state, or use a summary of a
Fold
or Traversal
that points
to a monoidal value.
>>>
evalState (use _1) (a,b)
a
>>>
evalState (use _1) ("hello","world")
"hello"
use
::MonadState
s m =>Getter
s a -> m ause
:: (MonadState
s m,Monoid
r) =>Fold
s r -> m ruse
::MonadState
s m =>Iso'
s a -> m ause
::MonadState
s m =>Lens'
s a -> m ause
:: (MonadState
s m,Monoid
r) =>Traversal'
s r -> m r
(^.) :: s -> Getting a s a -> a infixl 8 #
View the value pointed to by a Getter
or Lens
or the
result of folding over all the results of a Fold
or
Traversal
that points at a monoidal values.
This is the same operation as view
with the arguments flipped.
The fixity and semantics are such that subsequent field accesses can be
performed with (.
).
>>>
(a,b)^._2
b
>>>
("hello","world")^._2
"world"
>>>
import Data.Complex
>>>
((0, 1 :+ 2), 3)^._1._2.to magnitude
2.23606797749979
(^.
) :: s ->Getter
s a -> a (^.
) ::Monoid
m => s ->Fold
s m -> m (^.
) :: s ->Iso'
s a -> a (^.
) :: s ->Lens'
s a -> a (^.
) ::Monoid
m => s ->Traversal'
s m -> m
views :: MonadReader s m => LensLike' (Const r :: Type -> Type) s a -> (a -> r) -> m r #
View a function of the value pointed to by a Getter
or Lens
or the result of
folding over the result of mapping the targets of a Fold
or
Traversal
.
views
l f ≡view
(l.
to
f)
>>>
views (to f) g a
g (f a)
>>>
views _2 length (1,"hello")
5
As views
is commonly used to access the target of a Getter
or obtain a monoidal summary of the targets of a Fold
,
It may be useful to think of it as having one of these more restricted signatures:
views
::Getter
s a -> (a -> r) -> s -> rviews
::Monoid
m =>Fold
s a -> (a -> m) -> s -> mviews
::Iso'
s a -> (a -> r) -> s -> rviews
::Lens'
s a -> (a -> r) -> s -> rviews
::Monoid
m =>Traversal'
s a -> (a -> m) -> s -> m
In a more general setting, such as when working with a Monad
transformer stack you can use:
views
::MonadReader
s m =>Getter
s a -> (a -> r) -> m rviews
:: (MonadReader
s m,Monoid
r) =>Fold
s a -> (a -> r) -> m rviews
::MonadReader
s m =>Iso'
s a -> (a -> r) -> m rviews
::MonadReader
s m =>Lens'
s a -> (a -> r) -> m rviews
:: (MonadReader
s m,Monoid
r) =>Traversal'
s a -> (a -> r) -> m r
views
::MonadReader
s m =>Getting
r s a -> (a -> r) -> m r
view :: MonadReader s m => Getting a s a -> m a #
View the value pointed to by a Getter
, Iso
or
Lens
or the result of folding over all the results of a
Fold
or Traversal
that points
at a monoidal value.
view
.
to
≡id
>>>
view (to f) a
f a
>>>
view _2 (1,"hello")
"hello"
>>>
view (to succ) 5
6
>>>
view (_2._1) ("hello",("world","!!!"))
"world"
As view
is commonly used to access the target of a Getter
or obtain a monoidal summary of the targets of a Fold
,
It may be useful to think of it as having one of these more restricted signatures:
view
::Getter
s a -> s -> aview
::Monoid
m =>Fold
s m -> s -> mview
::Iso'
s a -> s -> aview
::Lens'
s a -> s -> aview
::Monoid
m =>Traversal'
s m -> s -> m
In a more general setting, such as when working with a Monad
transformer stack you can use:
view
::MonadReader
s m =>Getter
s a -> m aview
:: (MonadReader
s m,Monoid
a) =>Fold
s a -> m aview
::MonadReader
s m =>Iso'
s a -> m aview
::MonadReader
s m =>Lens'
s a -> m aview
:: (MonadReader
s m,Monoid
a) =>Traversal'
s a -> m a
ilike :: (Indexable i p, Contravariant f, Functor f) => i -> a -> Over' p f s a #
ilike
:: i -> a ->IndexedGetter
i s a
like :: (Profunctor p, Contravariant f, Functor f) => a -> Optic' p f s a #
ito :: (Indexable i p, Contravariant f) => (s -> (i, a)) -> Over' p f s a #
ito
:: (s -> (i, a)) ->IndexedGetter
i s a
to :: (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a #
type Getting r s a = (a -> Const r a) -> s -> Const r s #
When you see this in a type signature it indicates that you can
pass the function a Lens
, Getter
,
Traversal
, Fold
,
Prism
, Iso
, or one of
the indexed variants, and it will just "do the right thing".
Most Getter
combinators are able to be used with both a Getter
or a
Fold
in limited situations, to do so, they need to be
monomorphic in what we are going to extract with Const
. To be compatible
with Lens
, Traversal
and
Iso
we also restricted choices of the irrelevant t
and
b
parameters.
If a function accepts a
, then when Getting
r s ar
is a Monoid
, then
you can pass a Fold
(or
Traversal
), otherwise you can only pass this a
Getter
or Lens
.
type IndexedGetting i m s a = Indexed i a (Const m a) -> s -> Const m s #
Used to consume an IndexedFold
.
type Accessing (p :: Type -> Type -> Type) m s a = p a (Const m a) -> s -> Const m s #
This is a convenient alias used when consuming (indexed) getters and (indexed) folds in a highly general fashion.
class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to 1st field of a tuple.
Nothing
Access the 1st field of a tuple (and possibly change its type).
>>>
(1,2)^._1
1
>>>
_1 .~ "hello" $ (1,2)
("hello",2)
>>>
(1,2) & _1 .~ "hello"
("hello",2)
>>>
_1 putStrLn ("hello","world")
hello ((),"world")
This can also be used on larger tuples as well:
>>>
(1,2,3,4,5) & _1 +~ 41
(42,2,3,4,5)
_1
::Lens
(a,b) (a',b) a a'_1
::Lens
(a,b,c) (a',b,c) a a'_1
::Lens
(a,b,c,d) (a',b,c,d) a a' ..._1
::Lens
(a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a'
Instances
Field1 (Identity a) (Identity b) a b | |
Field1 (a, b) (a', b) a a' |
|
Defined in Control.Lens.Tuple | |
Field1 (a, b, c) (a', b, c) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d) (a', b, c, d) a a' | |
Defined in Control.Lens.Tuple | |
Field1 ((f :*: g) p) ((f' :*: g) p) (f p) (f' p) | |
Field1 (Product f g a) (Product f' g a) (f a) (f' a) | |
Field1 (a, b, c, d, e) (a', b, c, d, e) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f) (a', b, c, d, e, f) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g) (a', b, c, d, e, f, g) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h) (a', b, c, d, e, f, g, h) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i) (a', b, c, d, e, f, g, h, i) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j) (a', b, c, d, e, f, g, h, i, j) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j, kk) (a', b, c, d, e, f, g, h, i, j, kk) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l) (a', b, c, d, e, f, g, h, i, j, kk, l) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a', b, c, d, e, f, g, h, i, j, kk, l, m) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) a a' | |
Defined in Control.Lens.Tuple | |
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) a a' | |
Defined in Control.Lens.Tuple |
class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 2nd field of a tuple.
Nothing
Access the 2nd field of a tuple.
>>>
_2 .~ "hello" $ (1,(),3,4)
(1,"hello",3,4)
>>>
(1,2,3,4) & _2 *~ 3
(1,6,3,4)
>>>
_2 print (1,2)
2 (1,())
anyOf
_2
:: (s ->Bool
) -> (a, s) ->Bool
traverse
.
_2
:: (Applicative
f,Traversable
t) => (a -> f b) -> t (s, a) -> f (t (s, b))foldMapOf
(traverse
.
_2
) :: (Traversable
t,Monoid
m) => (s -> m) -> t (b, s) -> m
Instances
Field2 (a, b) (a, b') b b' |
|
Defined in Control.Lens.Tuple | |
Field2 (a, b, c) (a, b', c) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d) (a, b', c, d) b b' | |
Defined in Control.Lens.Tuple | |
Field2 ((f :*: g) p) ((f :*: g') p) (g p) (g' p) | |
Field2 (Product f g a) (Product f g' a) (g a) (g' a) | |
Field2 (a, b, c, d, e) (a, b', c, d, e) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f) (a, b', c, d, e, f) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g) (a, b', c, d, e, f, g) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h) (a, b', c, d, e, f, g, h) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i) (a, b', c, d, e, f, g, h, i) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j) (a, b', c, d, e, f, g, h, i, j) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j, kk) (a, b', c, d, e, f, g, h, i, j, kk) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b', c, d, e, f, g, h, i, j, kk, l) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b', c, d, e, f, g, h, i, j, kk, l, m) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o, p) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) b b' | |
Defined in Control.Lens.Tuple | |
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) b b' | |
Defined in Control.Lens.Tuple |
class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 3rd field of a tuple.
Nothing
Instances
Field3 (a, b, c) (a, b, c') c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d) (a, b, c', d) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e) (a, b, c', d, e) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f) (a, b, c', d, e, f) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g) (a, b, c', d, e, f, g) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h) (a, b, c', d, e, f, g, h) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i) (a, b, c', d, e, f, g, h, i) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j) (a, b, c', d, e, f, g, h, i, j) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c', d, e, f, g, h, i, j, kk) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c', d, e, f, g, h, i, j, kk, l) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c', d, e, f, g, h, i, j, kk, l, m) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o, p) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o, p, q) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) c c' | |
Defined in Control.Lens.Tuple | |
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) c c' | |
Defined in Control.Lens.Tuple |
class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provide access to the 4th field of a tuple.
Nothing
Instances
Field4 (a, b, c, d) (a, b, c, d') d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e) (a, b, c, d', e) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f) (a, b, c, d', e, f) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g) (a, b, c, d', e, f, g) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h) (a, b, c, d', e, f, g, h) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i) (a, b, c, d', e, f, g, h, i) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d', e, f, g, h, i, j) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d', e, f, g, h, i, j, kk) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d', e, f, g, h, i, j, kk, l) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d', e, f, g, h, i, j, kk, l, m) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o, p) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o, p, q) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o, p, q, r) d d' | |
Defined in Control.Lens.Tuple | |
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) d d' | |
Defined in Control.Lens.Tuple |
class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 5th field of a tuple.
Nothing
Instances
Field5 (a, b, c, d, e) (a, b, c, d, e') e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f) (a, b, c, d, e', f) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g) (a, b, c, d, e', f, g) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h) (a, b, c, d, e', f, g, h) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e', f, g, h, i) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e', f, g, h, i, j) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e', f, g, h, i, j, kk) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e', f, g, h, i, j, kk, l) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e', f, g, h, i, j, kk, l, m) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o, p) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o, p, q) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o, p, q, r) e e' | |
Defined in Control.Lens.Tuple | |
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o, p, q, r, s) e e' | |
Defined in Control.Lens.Tuple |
class Field6 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 6th element of a tuple.
Nothing
Instances
Field6 (a, b, c, d, e, f) (a, b, c, d, e, f') f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g) (a, b, c, d, e, f', g) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h) (a, b, c, d, e, f', g, h) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f', g, h, i) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f', g, h, i, j) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f', g, h, i, j, kk) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f', g, h, i, j, kk, l) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f', g, h, i, j, kk, l, m) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o, p) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o, p, q) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o, p, q, r) f f' | |
Defined in Control.Lens.Tuple | |
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o, p, q, r, s) f f' | |
Defined in Control.Lens.Tuple |
class Field7 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provide access to the 7th field of a tuple.
Nothing
Instances
Field7 (a, b, c, d, e, f, g) (a, b, c, d, e, f, g') g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h) (a, b, c, d, e, f, g', h) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g', h, i) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g', h, i, j) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g', h, i, j, kk) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g', h, i, j, kk, l) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g', h, i, j, kk, l, m) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o, p) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o, p, q) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o, p, q, r) g g' | |
Defined in Control.Lens.Tuple | |
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o, p, q, r, s) g g' | |
Defined in Control.Lens.Tuple |
class Field8 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provide access to the 8th field of a tuple.
Nothing
Instances
Field8 (a, b, c, d, e, f, g, h) (a, b, c, d, e, f, g, h') h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g, h', i) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g, h', i, j) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g, h', i, j, kk) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h', i, j, kk, l) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h', i, j, kk, l, m) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o, p) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o, p, q) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o, p, q, r) h h' | |
Defined in Control.Lens.Tuple | |
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o, p, q, r, s) h h' | |
Defined in Control.Lens.Tuple |
class Field9 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 9th field of a tuple.
Nothing
Instances
Field9 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g, h, i') i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g, h, i', j) i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g, h, i', j, kk) i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h, i', j, kk, l) i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i', j, kk, l, m) i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n) i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o) i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o, p) i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o, p, q) i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o, p, q, r) i i' | |
Defined in Control.Lens.Tuple | |
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o, p, q, r, s) i i' | |
Defined in Control.Lens.Tuple |
class Field10 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 10th field of a tuple.
Nothing
Instances
Field10 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g, h, i, j') j j' | |
Defined in Control.Lens.Tuple | |
Field10 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g, h, i, j', kk) j j' | |
Defined in Control.Lens.Tuple | |
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h, i, j', kk, l) j j' | |
Defined in Control.Lens.Tuple | |
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i, j', kk, l, m) j j' | |
Defined in Control.Lens.Tuple | |
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n) j j' | |
Defined in Control.Lens.Tuple | |
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o) j j' | |
Defined in Control.Lens.Tuple | |
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o, p) j j' | |
Defined in Control.Lens.Tuple | |
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o, p, q) j j' | |
Defined in Control.Lens.Tuple | |
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o, p, q, r) j j' | |
Defined in Control.Lens.Tuple | |
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o, p, q, r, s) j j' | |
Defined in Control.Lens.Tuple |
class Field11 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 11th field of a tuple.
Nothing
Instances
Field11 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g, h, i, j, kk') kk kk' | |
Defined in Control.Lens.Tuple | |
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h, i, j, kk', l) kk kk' | |
Defined in Control.Lens.Tuple | |
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i, j, kk', l, m) kk kk' | |
Defined in Control.Lens.Tuple | |
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n) kk kk' | |
Defined in Control.Lens.Tuple | |
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o) kk kk' | |
Defined in Control.Lens.Tuple | |
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o, p) kk kk' | |
Defined in Control.Lens.Tuple | |
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o, p, q) kk kk' | |
Defined in Control.Lens.Tuple | |
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o, p, q, r) kk kk' | |
Defined in Control.Lens.Tuple | |
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o, p, q, r, s) kk kk' | |
Defined in Control.Lens.Tuple |
class Field12 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 12th field of a tuple.
Nothing
Instances
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h, i, j, kk, l') l l' | |
Defined in Control.Lens.Tuple | |
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i, j, kk, l', m) l l' | |
Defined in Control.Lens.Tuple | |
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n) l l' | |
Defined in Control.Lens.Tuple | |
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o) l l' | |
Defined in Control.Lens.Tuple | |
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o, p) l l' | |
Defined in Control.Lens.Tuple | |
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o, p, q) l l' | |
Defined in Control.Lens.Tuple | |
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o, p, q, r) l l' | |
Defined in Control.Lens.Tuple | |
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o, p, q, r, s) l l' | |
Defined in Control.Lens.Tuple |
class Field13 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 13th field of a tuple.
Nothing
Instances
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i, j, kk, l, m') m m' | |
Defined in Control.Lens.Tuple | |
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n) m m' | |
Defined in Control.Lens.Tuple | |
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o) m m' | |
Defined in Control.Lens.Tuple | |
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o, p) m m' | |
Defined in Control.Lens.Tuple | |
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o, p, q) m m' | |
Defined in Control.Lens.Tuple | |
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o, p, q, r) m m' | |
Defined in Control.Lens.Tuple | |
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o, p, q, r, s) m m' | |
Defined in Control.Lens.Tuple |
class Field14 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 14th field of a tuple.
Nothing
Instances
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n') n n' | |
Defined in Control.Lens.Tuple | |
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o) n n' | |
Defined in Control.Lens.Tuple | |
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o, p) n n' | |
Defined in Control.Lens.Tuple | |
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o, p, q) n n' | |
Defined in Control.Lens.Tuple | |
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o, p, q, r) n n' | |
Defined in Control.Lens.Tuple | |
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o, p, q, r, s) n n' | |
Defined in Control.Lens.Tuple |
class Field15 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 15th field of a tuple.
Nothing
Instances
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o') o o' | |
Defined in Control.Lens.Tuple | |
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o', p) o o' | |
Defined in Control.Lens.Tuple | |
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o', p, q) o o' | |
Defined in Control.Lens.Tuple | |
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o', p, q, r) o o' | |
Defined in Control.Lens.Tuple | |
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o', p, q, r, s) o o' | |
Defined in Control.Lens.Tuple |
class Field16 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 16th field of a tuple.
Nothing
Instances
Field16 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p') p p' | |
Defined in Control.Lens.Tuple | |
Field16 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p', q) p p' | |
Defined in Control.Lens.Tuple | |
Field16 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p', q, r) p p' | |
Defined in Control.Lens.Tuple | |
Field16 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p', q, r, s) p p' | |
Defined in Control.Lens.Tuple |
class Field17 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 17th field of a tuple.
Nothing
Instances
Field17 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q') q q' | |
Defined in Control.Lens.Tuple | |
Field17 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q', r) q q' | |
Defined in Control.Lens.Tuple | |
Field17 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q', r, s) q q' | |
Defined in Control.Lens.Tuple |
class Field18 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 18th field of a tuple.
Nothing
Instances
Field18 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r') r r' | |
Defined in Control.Lens.Tuple | |
Field18 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r', s) r r' | |
Defined in Control.Lens.Tuple |
class Field19 s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Provides access to the 19th field of a tuple.
Nothing
Instances
Field19 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s') s s' | |
Defined in Control.Lens.Tuple |
fusing :: Functor f => LensLike (Yoneda f) s t a b -> LensLike f s t a b #
Fuse a composition of lenses using Yoneda
to provide fmap
fusion.
In general, given a pair of lenses foo
and bar
fusing (foo.bar) = foo.bar
however, foo
and bar
are either going to fmap
internally or they are trivial.
fusing
exploits the Yoneda
lemma to merge these separate uses into a single fmap
.
This is particularly effective when the choice of functor f
is unknown at compile
time or when the Lens
foo.bar
in the above description is recursive or complex
enough to prevent inlining.
fusing
::Lens
s t a b ->Lens
s t a b
last1 :: Traversable1 t => Lens' (t a) a #
A Lens
focusing on the last element of a Traversable1
container.
>>>
2 :| [3, 4] & last1 +~ 10
2 :| [3,14]
>>>
Node 'a' [Node 'b' [], Node 'c' []] ^. last1
'c'
head1 :: Traversable1 t => Lens' (t a) a #
A Lens
focusing on the first element of a Traversable1
container.
>>>
2 :| [3, 4] & head1 +~ 10
12 :| [3,4]
>>>
Identity True ^. head1
True
We can always retrieve a ()
from any type.
>>>
"hello"^.united
()
>>>
"hello" & united .~ ()
"hello"
(<#=) :: MonadState s m => ALens s s a b -> b -> m b infix 4 #
(#%%=) :: MonadState s m => ALens s s a b -> (a -> (r, b)) -> m r infix 4 #
(<#%=) :: MonadState s m => ALens s s a b -> (a -> b) -> m b infix 4 #
(#%=) :: MonadState s m => ALens s s a b -> (a -> b) -> m () infix 4 #
(#=) :: MonadState s m => ALens s s a b -> b -> m () infix 4 #
(<<%@=) :: MonadState s m => Over (Indexed i) ((,) a) s s a b -> (i -> a -> b) -> m a infix 4 #
Adjust the target of an IndexedLens
returning the old value, or
adjust all of the targets of an IndexedTraversal
within the current state, and
return a monoidal summary of the old values.
(<<%@=
) ::MonadState
s m =>IndexedLens
i s s a b -> (i -> a -> b) -> m a (<<%@=
) :: (MonadState
s m,Monoid
b) =>IndexedTraversal
i s s a b -> (i -> a -> b) -> m a
(<%@=) :: MonadState s m => Over (Indexed i) ((,) b) s s a b -> (i -> a -> b) -> m b infix 4 #
Adjust the target of an IndexedLens
returning the intermediate result, or
adjust all of the targets of an IndexedTraversal
within the current state, and
return a monoidal summary of the intermediate results.
(<%@=
) ::MonadState
s m =>IndexedLens
i s s a b -> (i -> a -> b) -> m b (<%@=
) :: (MonadState
s m,Monoid
b) =>IndexedTraversal
i s s a b -> (i -> a -> b) -> m b
(%%@=) :: MonadState s m => Over (Indexed i) ((,) r) s s a b -> (i -> a -> (r, b)) -> m r infix 4 #
Adjust the target of an IndexedLens
returning a supplementary result, or
adjust all of the targets of an IndexedTraversal
within the current state, and
return a monoidal summary of the supplementary results.
l%%@=
f ≡state
(l%%@~
f)
(%%@=
) ::MonadState
s m =>IndexedLens
i s s a b -> (i -> a -> (r, b)) -> s -> m r (%%@=
) :: (MonadState
s m,Monoid
r) =>IndexedTraversal
i s s a b -> (i -> a -> (r, b)) -> s -> m r
(%%@~) :: Over (Indexed i) f s t a b -> (i -> a -> f b) -> s -> f t infixr 4 #
Adjust the target of an IndexedLens
returning a supplementary result, or
adjust all of the targets of an IndexedTraversal
and return a monoidal summary
of the supplementary results and the answer.
(%%@~
) ≡withIndex
(%%@~
) ::Functor
f =>IndexedLens
i s t a b -> (i -> a -> f b) -> s -> f t (%%@~
) ::Applicative
f =>IndexedTraversal
i s t a b -> (i -> a -> f b) -> s -> f t
In particular, it is often useful to think of this function as having one of these even more restricted type signatures:
(%%@~
) ::IndexedLens
i s t a b -> (i -> a -> (r, b)) -> s -> (r, t) (%%@~
) ::Monoid
r =>IndexedTraversal
i s t a b -> (i -> a -> (r, b)) -> s -> (r, t)
(<<%@~) :: Over (Indexed i) ((,) a) s t a b -> (i -> a -> b) -> s -> (a, t) infixr 4 #
Adjust the target of an IndexedLens
returning the old value, or
adjust all of the targets of an IndexedTraversal
and return a monoidal summary
of the old values along with the answer.
(<<%@~
) ::IndexedLens
i s t a b -> (i -> a -> b) -> s -> (a, t) (<<%@~
) ::Monoid
a =>IndexedTraversal
i s t a b -> (i -> a -> b) -> s -> (a, t)
(<%@~) :: Over (Indexed i) ((,) b) s t a b -> (i -> a -> b) -> s -> (b, t) infixr 4 #
Adjust the target of an IndexedLens
returning the intermediate result, or
adjust all of the targets of an IndexedTraversal
and return a monoidal summary
along with the answer.
l<%~
f ≡ l<%@~
const
f
When you do not need access to the index then (<%~
) is more liberal in what it can accept.
If you do not need the intermediate result, you can use (%@~
) or even (%~
).
(<%@~
) ::IndexedLens
i s t a b -> (i -> a -> b) -> s -> (b, t) (<%@~
) ::Monoid
b =>IndexedTraversal
i s t a b -> (i -> a -> b) -> s -> (b, t)
(<<~) :: MonadState s m => ALens s s a b -> m b -> m b infixr 2 #
Run a monadic action, and set the target of Lens
to its result.
(<<~
) ::MonadState
s m =>Iso
s s a b -> m b -> m b (<<~
) ::MonadState
s m =>Lens
s s a b -> m b -> m b
NB: This is limited to taking an actual Lens
than admitting a Traversal
because
there are potential loss of state issues otherwise.
(<<<>=) :: (MonadState s m, Monoid r) => LensLike' ((,) r) s r -> r -> m r infix 4 #
Modify the target of a Lens
into your Monad'
s state by mappend
ing a value
and return the old value that was replaced.
When you do not need the result of the operation, (<>=
) is more flexible.
(<<<>=
) :: (MonadState
s m,Monoid
r) =>Lens'
s r -> r -> m r (<<<>=
) :: (MonadState
s m,Monoid
r) =>Iso'
s r -> r -> m r
(<<&&=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool infix 4 #
Modify the target of a Lens
into your Monad'
s state by taking its logical &&
with a value
and return the old value that was replaced.
When you do not need the result of the operation, (&&=
) is more flexible.
(<<&&=
) ::MonadState
s m =>Lens'
sBool
->Bool
-> mBool
(<<&&=
) ::MonadState
s m =>Iso'
sBool
->Bool
-> mBool
(<<||=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool infix 4 #
Modify the target of a Lens
into your Monad'
s state by taking its logical ||
with a value
and return the old value that was replaced.
When you do not need the result of the operation, (||=
) is more flexible.
(<<||=
) ::MonadState
s m =>Lens'
sBool
->Bool
-> mBool
(<<||=
) ::MonadState
s m =>Iso'
sBool
->Bool
-> mBool
(<<**=) :: (MonadState s m, Floating a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Modify the target of a Lens
into your Monad'
s state by raising it by an arbitrary power
and return the old value that was replaced.
When you do not need the result of the operation, (**=
) is more flexible.
(<<**=
) :: (MonadState
s m,Floating
a) =>Lens'
s a -> a -> m a (<<**=
) :: (MonadState
s m,Floating
a) =>Iso'
s a -> a -> m a
(<<^^=) :: (MonadState s m, Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> m a infix 4 #
Modify the target of a Lens
into your Monad'
s state by raising it by an integral power
and return the old value that was replaced.
When you do not need the result of the operation, (^^=
) is more flexible.
(<<^^=
) :: (MonadState
s m,Fractional
a,Integral
e) =>Lens'
s a -> e -> m a (<<^^=
) :: (MonadState
s m,Fractional
a,Integral
e) =>Iso'
s a -> e -> m a
(<<^=) :: (MonadState s m, Num a, Integral e) => LensLike' ((,) a) s a -> e -> m a infix 4 #
Modify the target of a Lens
into your Monad'
s state by raising it by a non-negative power
and return the old value that was replaced.
When you do not need the result of the operation, (^=
) is more flexible.
(<<^=
) :: (MonadState
s m,Num
a,Integral
e) =>Lens'
s a -> e -> m a (<<^=
) :: (MonadState
s m,Num
a,Integral
e) =>Iso'
s a -> a -> m a
(<<//=) :: (MonadState s m, Fractional a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Modify the target of a Lens
into your Monad
s state by dividing by a value
and return the old value that was replaced.
When you do not need the result of the operation, (//=
) is more flexible.
(<<//=
) :: (MonadState
s m,Fractional
a) =>Lens'
s a -> a -> m a (<<//=
) :: (MonadState
s m,Fractional
a) =>Iso'
s a -> a -> m a
(<<*=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Modify the target of a Lens
into your Monad'
s state by multipling a value
and return the old value that was replaced.
When you do not need the result of the operation, (*=
) is more flexible.
(<<*=
) :: (MonadState
s m,Num
a) =>Lens'
s a -> a -> m a (<<*=
) :: (MonadState
s m,Num
a) =>Iso'
s a -> a -> m a
(<<-=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Modify the target of a Lens
into your Monad'
s state by subtracting a value
and return the old value that was replaced.
When you do not need the result of the operation, (-=
) is more flexible.
(<<-=
) :: (MonadState
s m,Num
a) =>Lens'
s a -> a -> m a (<<-=
) :: (MonadState
s m,Num
a) =>Iso'
s a -> a -> m a
(<<+=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Modify the target of a Lens
into your Monad'
s state by adding a value
and return the old value that was replaced.
When you do not need the result of the operation, (+=
) is more flexible.
(<<+=
) :: (MonadState
s m,Num
a) =>Lens'
s a -> a -> m a (<<+=
) :: (MonadState
s m,Num
a) =>Iso'
s a -> a -> m a
(<<?=) :: MonadState s m => LensLike ((,) a) s s a (Maybe b) -> b -> m a infix 4 #
Replace the target of a Lens
into your Monad'
s state with Just
a user supplied
value and return the old value that was replaced.
When applied to a Traversal
, this will return a monoidal summary of all of the old values
present.
When you do not need the result of the operation, (?=
) is more flexible.
(<<?=
) ::MonadState
s m =>Lens
s t a (Maybe b) -> b -> m a (<<?=
) ::MonadState
s m =>Iso
s t a (Maybe b) -> b -> m a (<<?=
) :: (MonadState
s m,Monoid
a) =>Traversal
s t a (Maybe b) -> b -> m a
(<<.=) :: MonadState s m => LensLike ((,) a) s s a b -> b -> m a infix 4 #
Replace the target of a Lens
into your Monad'
s state with a user supplied
value and return the old value that was replaced.
When applied to a Traversal
, this will return a monoidal summary of all of the old values
present.
When you do not need the result of the operation, (.=
) is more flexible.
(<<.=
) ::MonadState
s m =>Lens'
s a -> a -> m a (<<.=
) ::MonadState
s m =>Iso'
s a -> a -> m a (<<.=
) :: (MonadState
s m,Monoid
a) =>Traversal'
s a -> a -> m a
(<<%=) :: (Strong p, MonadState s m) => Over p ((,) a) s s a b -> p a b -> m a infix 4 #
Modify the target of a Lens
into your Monad'
s state by a user supplied
function and return the old value that was replaced.
When applied to a Traversal
, this will return a monoidal summary of all of the old values
present.
When you do not need the result of the operation, (%=
) is more flexible.
(<<%=
) ::MonadState
s m =>Lens'
s a -> (a -> a) -> m a (<<%=
) ::MonadState
s m =>Iso'
s a -> (a -> a) -> m a (<<%=
) :: (MonadState
s m,Monoid
a) =>Traversal'
s a -> (a -> a) -> m a
(<<%=
) ::MonadState
s m =>LensLike
((,)a) s s a b -> (a -> b) -> m a
(<**=) :: (MonadState s m, Floating a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Raise the target of a floating-point valued Lens
into your Monad'
s
state to an arbitrary power and return the result.
When you do not need the result of the operation, (**=
) is more flexible.
(<**=
) :: (MonadState
s m,Floating
a) =>Lens'
s a -> a -> m a (<**=
) :: (MonadState
s m,Floating
a) =>Iso'
s a -> a -> m a
(<^^=) :: (MonadState s m, Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> m a infix 4 #
Raise the target of a fractionally valued Lens
into your Monad'
s state
to an Integral
power and return the result.
When you do not need the result of the operation, (^^=
) is more flexible.
(<^^=
) :: (MonadState
s m,Fractional
b,Integral
e) =>Lens'
s a -> e -> m a (<^^=
) :: (MonadState
s m,Fractional
b,Integral
e) =>Iso'
s a -> e -> m a
(<^=) :: (MonadState s m, Num a, Integral e) => LensLike' ((,) a) s a -> e -> m a infix 4 #
Raise the target of a numerically valued Lens
into your Monad'
s state
to a non-negative Integral
power and return the result.
When you do not need the result of the operation, (^=
) is more flexible.
(<^=
) :: (MonadState
s m,Num
a,Integral
e) =>Lens'
s a -> e -> m a (<^=
) :: (MonadState
s m,Num
a,Integral
e) =>Iso'
s a -> e -> m a
(<//=) :: (MonadState s m, Fractional a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Divide the target of a fractionally valued Lens
into your Monad'
s state
and return the result.
When you do not need the result of the division, (//=
) is more flexible.
(<//=
) :: (MonadState
s m,Fractional
a) =>Lens'
s a -> a -> m a (<//=
) :: (MonadState
s m,Fractional
a) =>Iso'
s a -> a -> m a
(<*=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Multiply the target of a numerically valued Lens
into your Monad'
s
state and return the result.
When you do not need the result of the multiplication, (*=
) is more
flexible.
(<*=
) :: (MonadState
s m,Num
a) =>Lens'
s a -> a -> m a (<*=
) :: (MonadState
s m,Num
a) =>Iso'
s a -> a -> m a
(<-=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Subtract from the target of a numerically valued Lens
into your Monad'
s
state and return the result.
When you do not need the result of the subtraction, (-=
) is more
flexible.
(<-=
) :: (MonadState
s m,Num
a) =>Lens'
s a -> a -> m a (<-=
) :: (MonadState
s m,Num
a) =>Iso'
s a -> a -> m a
(<+=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a infix 4 #
Add to the target of a numerically valued Lens
into your Monad'
s state
and return the result.
When you do not need the result of the addition, (+=
) is more
flexible.
(<+=
) :: (MonadState
s m,Num
a) =>Lens'
s a -> a -> m a (<+=
) :: (MonadState
s m,Num
a) =>Iso'
s a -> a -> m a
(<%=) :: MonadState s m => LensLike ((,) b) s s a b -> (a -> b) -> m b infix 4 #
Modify the target of a Lens
into your Monad'
s state by a user supplied
function and return the result.
When applied to a Traversal
, it this will return a monoidal summary of all of the intermediate
results.
When you do not need the result of the operation, (%=
) is more flexible.
(<%=
) ::MonadState
s m =>Lens'
s a -> (a -> a) -> m a (<%=
) ::MonadState
s m =>Iso'
s a -> (a -> a) -> m a (<%=
) :: (MonadState
s m,Monoid
a) =>Traversal'
s a -> (a -> a) -> m a
(<<<>~) :: Monoid r => LensLike' ((,) r) s r -> r -> s -> (r, s) infixr 4 #
Modify the target of a monoidally valued Lens
by mappend
ing a new value and return the old value.
When you do not need the old value, (<>~
) is more flexible.
>>>
(Sum a,b) & _1 <<<>~ Sum c
(Sum {getSum = a},(Sum {getSum = a + c},b))
>>>
_2 <<<>~ ", 007" $ ("James", "Bond")
("Bond",("James","Bond, 007"))
(<<<>~
) ::Monoid
r =>Lens'
s r -> r -> s -> (r, s) (<<<>~
) ::Monoid
r =>Iso'
s r -> r -> s -> (r, s)
(<<&&~) :: LensLike' ((,) Bool) s Bool -> Bool -> s -> (Bool, s) infixr 4 #
Logically &&
the target of a Bool
-valued Lens
and return the old value.
When you do not need the old value, (&&~
) is more flexible.
>>>
(False,6) & _1 <<&&~ True
(False,(False,6))
>>>
("hello",True) & _2 <<&&~ False
(True,("hello",False))
(<<&&~
) ::Lens'
s Bool -> Bool -> s -> (Bool, s) (<<&&~
) ::Iso'
s Bool -> Bool -> s -> (Bool, s)
(<<||~) :: LensLike' ((,) Bool) s Bool -> Bool -> s -> (Bool, s) infixr 4 #
Logically ||
the target of a Bool
-valued Lens
and return the old value.
When you do not need the old value, (||~
) is more flexible.
>>>
(False,6) & _1 <<||~ True
(False,(True,6))
>>>
("hello",True) & _2 <<||~ False
(True,("hello",True))
(<<||~
) ::Lens'
sBool
->Bool
-> s -> (Bool
, s) (<<||~
) ::Iso'
sBool
->Bool
-> s -> (Bool
, s)
(<<**~) :: Floating a => LensLike' ((,) a) s a -> a -> s -> (a, s) infixr 4 #
Raise the target of a floating-point valued Lens
to an arbitrary power and return the old value.
When you do not need the old value, (**~
) is more flexible.
>>>
(a,b) & _1 <<**~ c
(a,(a**c,b))
>>>
(a,b) & _2 <<**~ c
(b,(a,b**c))
(<<**~
) ::Floating
a =>Lens'
s a -> a -> s -> (a, s) (<<**~
) ::Floating
a =>Iso'
s a -> a -> s -> (a, s)
(<<^^~) :: (Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> s -> (a, s) infixr 4 #
Raise the target of a fractionally valued Lens
to an integral power and return the old value.
When you do not need the old value, (^^~
) is more flexible.
(<<^^~
) :: (Fractional
a,Integral
e) =>Lens'
s a -> e -> s -> (a, s) (<<^^~
) :: (Fractional
a,Integral
e) =>Iso'
s a -> e -> S -> (a, s)
(<<//~) :: Fractional a => LensLike' ((,) a) s a -> a -> s -> (a, s) infixr 4 #
Divide the target of a numerically valued Lens
and return the old value.
When you do not need the old value, (//~
) is more flexible.
>>>
(a,b) & _1 <<//~ c
(a,(a / c,b))
>>>
("Hawaii",10) & _2 <<//~ 2
(10.0,("Hawaii",5.0))
(<<//~
) :: Fractional a =>Lens'
s a -> a -> s -> (a, s) (<<//~
) :: Fractional a =>Iso'
s a -> a -> s -> (a, s)
(<<*~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s) infixr 4 #
Multiply the target of a numerically valued Lens
and return the old value.
When you do not need the old value, (-~
) is more flexible.
>>>
(a,b) & _1 <<*~ c
(a,(a * c,b))
>>>
(a,b) & _2 <<*~ c
(b,(a,b * c))
(<<*~
) ::Num
a =>Lens'
s a -> a -> s -> (a, s) (<<*~
) ::Num
a =>Iso'
s a -> a -> s -> (a, s)
(<<-~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s) infixr 4 #
Decrement the target of a numerically valued Lens
and return the old value.
When you do not need the old value, (-~
) is more flexible.
>>>
(a,b) & _1 <<-~ c
(a,(a - c,b))
>>>
(a,b) & _2 <<-~ c
(b,(a,b - c))
(<<-~
) ::Num
a =>Lens'
s a -> a -> s -> (a, s) (<<-~
) ::Num
a =>Iso'
s a -> a -> s -> (a, s)
(<<+~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s) infixr 4 #
Increment the target of a numerically valued Lens
and return the old value.
When you do not need the old value, (+~
) is more flexible.
>>>
(a,b) & _1 <<+~ c
(a,(a + c,b))
>>>
(a,b) & _2 <<+~ c
(b,(a,b + c))
(<<+~
) ::Num
a =>Lens'
s a -> a -> s -> (a, s) (<<+~
) ::Num
a =>Iso'
s a -> a -> s -> (a, s)
(<<?~) :: LensLike ((,) a) s t a (Maybe b) -> b -> s -> (a, t) infixr 4 #
Replace the target of a Lens
with a Just
value, but return the old value.
If you do not need the old value (?~
) is more flexible.
>>>
import Data.Map as Map
>>>
_2.at "hello" <<?~ "world" $ (42,Map.fromList [("goodnight","gracie")])
(Nothing,(42,fromList [("goodnight","gracie"),("hello","world")]))
(<<?~
) ::Iso
s t a (Maybe
b) -> b -> s -> (a, t) (<<?~
) ::Lens
s t a (Maybe
b) -> b -> s -> (a, t) (<<?~
) ::Traversal
s t a (Maybe
b) -> b -> s -> (a, t)
(<^^~) :: (Fractional a, Integral e) => LensLike ((,) a) s t a a -> e -> s -> (a, t) infixr 4 #
Raise the target of a fractionally valued Lens
to an Integral
power
and return the result.
When you do not need the result of the operation, (^^~
) is more flexible.
(<^^~
) :: (Fractional
a,Integral
e) =>Lens'
s a -> e -> s -> (a, s) (<^^~
) :: (Fractional
a,Integral
e) =>Iso'
s a -> e -> s -> (a, s)
(<//~) :: Fractional a => LensLike ((,) a) s t a a -> a -> s -> (a, t) infixr 4 #
Divide the target of a fractionally valued Lens
and return the result.
When you do not need the result of the division, (//~
) is more flexible.
(<//~
) ::Fractional
a =>Lens'
s a -> a -> s -> (a, s) (<//~
) ::Fractional
a =>Iso'
s a -> a -> s -> (a, s)
cloneIndexedLens :: AnIndexedLens i s t a b -> IndexedLens i s t a b #
Clone an IndexedLens
as an IndexedLens
with the same index.
cloneIndexPreservingLens :: ALens s t a b -> IndexPreservingLens s t a b #
Clone a Lens
as an IndexedPreservingLens
that just passes through whatever
index is on any IndexedLens
, IndexedFold
, IndexedGetter
or IndexedTraversal
it is composed with.
cloneLens :: ALens s t a b -> Lens s t a b #
Cloning a Lens
is one way to make sure you aren't given
something weaker, such as a Traversal
and can be
used as a way to pass around lenses that have to be monomorphic in f
.
Note: This only accepts a proper Lens
.
>>>
let example l x = set (cloneLens l) (x^.cloneLens l + 1) x in example _2 ("hello",1,"you")
("hello",2,"you")
locus :: IndexedComonadStore p => Lens (p a c s) (p b c s) a b #
This Lens
lets you view
the current pos
of any indexed
store comonad and seek
to a new position. This reduces the API
for working these instances to a single Lens
.
ipos
w ≡ w^.
locus
iseek
s w ≡ w&
locus
.~
siseeks
f w ≡ w&
locus
%~
f
locus
::Lens'
(Context'
a s) alocus
::Conjoined
p =>Lens'
(Pretext'
p a s) alocus
::Conjoined
p =>Lens'
(PretextT'
p g a s) a
alongside :: LensLike (AlongsideLeft f b') s t a b -> LensLike (AlongsideRight f t) s' t' a' b' -> LensLike f (s, s') (t, t') (a, a') (b, b') #
alongside
makes a Lens
from two other lenses or a Getter
from two other getters
by executing them on their respective halves of a product.
>>>
(Left a, Right b)^.alongside chosen chosen
(a,b)
>>>
(Left a, Right b) & alongside chosen chosen .~ (c,d)
(Left c,Right d)
alongside
::Lens
s t a b ->Lens
s' t' a' b' ->Lens
(s,s') (t,t') (a,a') (b,b')alongside
::Getter
s a ->Getter
s' a' ->Getter
(s,s') (a,a')
chosen :: IndexPreservingLens (Either a a) (Either b b) a b #
This is a Lens
that updates either side of an Either
, where both sides have the same type.
chosen
≡choosing
id
id
>>>
Left a^.chosen
a
>>>
Right a^.chosen
a
>>>
Right "hello"^.chosen
"hello"
>>>
Right a & chosen *~ b
Right (a * b)
chosen
::Lens
(Either
a a) (Either
b b) a bchosen
f (Left
a) =Left
<$>
f achosen
f (Right
a) =Right
<$>
f a
choosing :: Functor f => LensLike f s t a b -> LensLike f s' t' a b -> LensLike f (Either s s') (Either t t') a b #
Merge two lenses, getters, setters, folds or traversals.
chosen
≡choosing
id
id
choosing
::Getter
s a ->Getter
s' a ->Getter
(Either
s s') achoosing
::Fold
s a ->Fold
s' a ->Fold
(Either
s s') achoosing
::Lens'
s a ->Lens'
s' a ->Lens'
(Either
s s') achoosing
::Traversal'
s a ->Traversal'
s' a ->Traversal'
(Either
s s') achoosing
::Setter'
s a ->Setter'
s' a ->Setter'
(Either
s s') a
inside :: Corepresentable p => ALens s t a b -> Lens (p e s) (p e t) (p e a) (p e b) #
(??) :: Functor f => f (a -> b) -> a -> f b infixl 1 #
This is convenient to flip
argument order of composite functions defined as:
fab ?? a = fmap ($ a) fab
For the Functor
instance f = ((->) r)
you can reason about this function as if the definition was (
:??
) ≡ flip
>>>
(h ?? x) a
h a x
>>>
execState ?? [] $ modify (1:)
[1]
>>>
over _2 ?? ("hello","world") $ length
("hello",5)
>>>
over ?? length ?? ("hello","world") $ _2
("hello",5)
(%%=) :: MonadState s m => Over p ((,) r) s s a b -> p a (r, b) -> m r infix 4 #
Modify the target of a Lens
in the current state returning some extra
information of type r
or modify all targets of a
Traversal
in the current state, extracting extra
information of type r
and return a monoidal summary of the changes.
>>>
runState (_1 %%= \x -> (f x, g x)) (a,b)
(f a,(g a,b))
(%%=
) ≡ (state
.
)
It may be useful to think of (%%=
), instead, as having either of the
following more restricted type signatures:
(%%=
) ::MonadState
s m =>Iso
s s a b -> (a -> (r, b)) -> m r (%%=
) ::MonadState
s m =>Lens
s s a b -> (a -> (r, b)) -> m r (%%=
) :: (MonadState
s m,Monoid
r) =>Traversal
s s a b -> (a -> (r, b)) -> m r
(%%~) :: LensLike f s t a b -> (a -> f b) -> s -> f t infixr 4 #
(%%~
) can be used in one of two scenarios:
When applied to a Lens
, it can edit the target of the Lens
in a
structure, extracting a functorial result.
When applied to a Traversal
, it can edit the
targets of the traversals, extracting an applicative summary of its
actions.
>>>
[66,97,116,109,97,110] & each %%~ \a -> ("na", chr a)
("nananananana","Batman")
For all that the definition of this combinator is just:
(%%~
) ≡id
It may be beneficial to think about it as if it had these even more restricted types, however:
(%%~
) ::Functor
f =>Iso
s t a b -> (a -> f b) -> s -> f t (%%~
) ::Functor
f =>Lens
s t a b -> (a -> f b) -> s -> f t (%%~
) ::Applicative
f =>Traversal
s t a b -> (a -> f b) -> s -> f t
When applied to a Traversal
, it can edit the
targets of the traversals, extracting a supplemental monoidal summary
of its actions, by choosing f = ((,) m)
(%%~
) ::Iso
s t a b -> (a -> (r, b)) -> s -> (r, t) (%%~
) ::Lens
s t a b -> (a -> (r, b)) -> s -> (r, t) (%%~
) ::Monoid
m =>Traversal
s t a b -> (a -> (m, b)) -> s -> (m, t)
(&~) :: s -> State s a -> s infixl 1 #
This can be used to chain lens operations using op=
syntax
rather than op~
syntax for simple non-type-changing cases.
>>>
(10,20) & _1 .~ 30 & _2 .~ 40
(30,40)
>>>
(10,20) &~ do _1 .= 30; _2 .= 40
(30,40)
This does not support type-changing assignment, e.g.
>>>
(10,20) & _1 .~ "hello"
("hello",20)
ilens :: (s -> (i, a)) -> (s -> b -> t) -> IndexedLens i s t a b #
Build an IndexedLens
from a Getter
and
a Setter
.
iplens :: (s -> a) -> (s -> b -> t) -> IndexPreservingLens s t a b #
withLens :: ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r #
Obtain a getter and a setter from a lens, reversing lens
.
type AnIndexedLens i s t a b = Optical (Indexed i) ((->) :: Type -> Type -> Type) (Pretext (Indexed i) a b) s t a b #
When you see this as an argument to a function, it expects an IndexedLens
type AnIndexedLens' i s a = AnIndexedLens i s s a a #
typeAnIndexedLens'
=Simple
(AnIndexedLens
i)
imapOf :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t #
Map with index. (Deprecated alias for iover
).
When you do not need access to the index, then mapOf
is more liberal in what it can accept.
mapOf
l ≡imapOf
l.
const
imapOf
::IndexedSetter
i s t a b -> (i -> a -> b) -> s -> timapOf
::IndexedLens
i s t a b -> (i -> a -> b) -> s -> timapOf
::IndexedTraversal
i s t a b -> (i -> a -> b) -> s -> t
assignA :: Arrow p => ASetter s t a b -> p s b -> p s t #
Run an arrow command and use the output to set all the targets of
a Lens
, Setter
or Traversal
to the result.
assignA
can be used very similarly to (<~
), except that the type of
the object being modified can change; for example:
runKleisli action ((), (), ()) where action = assignA _1 (Kleisli (const getVal1)) >>> assignA _2 (Kleisli (const getVal2)) >>> assignA _3 (Kleisli (const getVal3)) getVal1 :: Either String Int getVal1 = ... getVal2 :: Either String Bool getVal2 = ... getVal3 :: Either String Char getVal3 = ...
has the type Either
String
(Int
, Bool
, Char
)
assignA
::Arrow
p =>Iso
s t a b -> p s b -> p s tassignA
::Arrow
p =>Lens
s t a b -> p s b -> p s tassignA
::Arrow
p =>Traversal
s t a b -> p s b -> p s tassignA
::Arrow
p =>Setter
s t a b -> p s b -> p s t
(.@=) :: MonadState s m => AnIndexedSetter i s s a b -> (i -> b) -> m () infix 4 #
Replace every target in the current state of an IndexedSetter
, IndexedLens
or IndexedTraversal
with access to the index.
When you do not need access to the index then (.=
) is more liberal in what it can accept.
l.=
b ≡ l.@=
const
b
(.@=
) ::MonadState
s m =>IndexedSetter
i s s a b -> (i -> b) -> m () (.@=
) ::MonadState
s m =>IndexedLens
i s s a b -> (i -> b) -> m () (.@=
) ::MonadState
s m =>IndexedTraversal
i s t a b -> (i -> b) -> m ()
imodifying :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m () #
This is an alias for (%@=
).
(%@=) :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m () infix 4 #
Adjust every target in the current state of an IndexedSetter
, IndexedLens
or IndexedTraversal
with access to the index.
When you do not need access to the index then (%=
) is more liberal in what it can accept.
l%=
f ≡ l%@=
const
f
(%@=
) ::MonadState
s m =>IndexedSetter
i s s a b -> (i -> a -> b) -> m () (%@=
) ::MonadState
s m =>IndexedLens
i s s a b -> (i -> a -> b) -> m () (%@=
) ::MonadState
s m =>IndexedTraversal
i s t a b -> (i -> a -> b) -> m ()
(.@~) :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t infixr 4 #
Replace every target of an IndexedSetter
, IndexedLens
or IndexedTraversal
with access to the index.
(.@~
) ≡iset
When you do not need access to the index then (.~
) is more liberal in what it can accept.
l.~
b ≡ l.@~
const
b
(.@~
) ::IndexedSetter
i s t a b -> (i -> b) -> s -> t (.@~
) ::IndexedLens
i s t a b -> (i -> b) -> s -> t (.@~
) ::IndexedTraversal
i s t a b -> (i -> b) -> s -> t
(%@~) :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t infixr 4 #
Adjust every target of an IndexedSetter
, IndexedLens
or IndexedTraversal
with access to the index.
(%@~
) ≡iover
When you do not need access to the index then (%~
) is more liberal in what it can accept.
l%~
f ≡ l%@~
const
f
(%@~
) ::IndexedSetter
i s t a b -> (i -> a -> b) -> s -> t (%@~
) ::IndexedLens
i s t a b -> (i -> a -> b) -> s -> t (%@~
) ::IndexedTraversal
i s t a b -> (i -> a -> b) -> s -> t
isets :: ((i -> a -> b) -> s -> t) -> IndexedSetter i s t a b #
Build an IndexedSetter
from an imap
-like function.
Your supplied function f
is required to satisfy:
fid
≡id
f g.
f h ≡ f (g.
h)
Equational reasoning:
isets
.
iover
≡id
iover
.
isets
≡id
Another way to view isets
is that it takes a "semantic editor combinator"
which has been modified to carry an index and transforms it into a IndexedSetter
.
iset :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t #
Set with index. Equivalent to iover
with the current value ignored.
When you do not need access to the index, then set
is more liberal in what it can accept.
set
l ≡iset
l.
const
iset
::IndexedSetter
i s t a b -> (i -> b) -> s -> tiset
::IndexedLens
i s t a b -> (i -> b) -> s -> tiset
::IndexedTraversal
i s t a b -> (i -> b) -> s -> t
iover :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t #
Map with index. This is an alias for imapOf
.
When you do not need access to the index, then over
is more liberal in what it can accept.
over
l ≡iover
l.
const
iover
l ≡over
l.
Indexed
iover
::IndexedSetter
i s t a b -> (i -> a -> b) -> s -> tiover
::IndexedLens
i s t a b -> (i -> a -> b) -> s -> tiover
::IndexedTraversal
i s t a b -> (i -> a -> b) -> s -> t
ilocally :: MonadReader s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m r -> m r #
This is a generalization of locally
that allows one to make indexed
local
changes to a Reader
environment associated with the target of a
Setter
, Lens
, or Traversal
.
locally
l f ≡ilocally
l f . constilocally
l f ≡locally
l f .Indexed
ilocally :: MonadReader s m =>IndexedLens
s s a b -> (i -> a -> b) -> m r -> m r ilocally :: MonadReader s m =>IndexedTraversal
s s a b -> (i -> a -> b) -> m r -> m r ilocally :: MonadReader s m =>IndexedSetter
s s a b -> (i -> a -> b) -> m r -> m r
locally :: MonadReader s m => ASetter s s a b -> (a -> b) -> m r -> m r #
Modify the value of the Reader
environment associated with the target of a
Setter
, Lens
, or Traversal
.
locally
lid
a ≡ alocally
l f.
locally l g ≡locally
l (f.
g)
>>>
(1,1) & locally _1 (+1) (uncurry (+))
3
>>>
"," & locally ($) ("Hello" <>) (<> " world!")
"Hello, world!"
locally :: MonadReader s m =>Iso
s s a b -> (a -> b) -> m r -> m r locally :: MonadReader s m =>Lens
s s a b -> (a -> b) -> m r -> m r locally :: MonadReader s m =>Traversal
s s a b -> (a -> b) -> m r -> m r locally :: MonadReader s m =>Setter
s s a b -> (a -> b) -> m r -> m r
icensoring :: MonadWriter w m => IndexedSetter i w w u v -> (i -> u -> v) -> m a -> m a #
This is a generalization of censor
that allows you to censor
just a
portion of the resulting MonadWriter
, with access to the index of an
IndexedSetter
.
censoring :: MonadWriter w m => Setter w w u v -> (u -> v) -> m a -> m a #
This is a generalization of censor
that allows you to censor
just a
portion of the resulting MonadWriter
.
ipassing :: MonadWriter w m => IndexedSetter i w w u v -> m (a, i -> u -> v) -> m a #
This is a generalization of pass
that allows you to modify just a
portion of the resulting MonadWriter
with access to the index of an
IndexedSetter
.
passing :: MonadWriter w m => Setter w w u v -> m (a, u -> v) -> m a #
This is a generalization of pass
that allows you to modify just a
portion of the resulting MonadWriter
.
scribe :: (MonadWriter t m, Monoid s) => ASetter s t a b -> b -> m () #
Write to a fragment of a larger Writer
format.
(<>=) :: (MonadState s m, Monoid a) => ASetter' s a -> a -> m () infix 4 #
Modify the target(s) of a Lens'
, Iso
, Setter
or Traversal
by mappend
ing a value.
>>>
execState (do _1 <>= Sum c; _2 <>= Product d) (Sum a,Product b)
(Sum {getSum = a + c},Product {getProduct = b * d})
>>>
execState (both <>= "!!!") ("hello","world")
("hello!!!","world!!!")
(<>=
) :: (MonadState
s m,Monoid
a) =>Setter'
s a -> a -> m () (<>=
) :: (MonadState
s m,Monoid
a) =>Iso'
s a -> a -> m () (<>=
) :: (MonadState
s m,Monoid
a) =>Lens'
s a -> a -> m () (<>=
) :: (MonadState
s m,Monoid
a) =>Traversal'
s a -> a -> m ()
(<>~) :: Monoid a => ASetter s t a a -> a -> s -> t infixr 4 #
Modify the target of a monoidally valued by mappend
ing another value.
>>>
(Sum a,b) & _1 <>~ Sum c
(Sum {getSum = a + c},b)
>>>
(Sum a,Sum b) & both <>~ Sum c
(Sum {getSum = a + c},Sum {getSum = b + c})
>>>
both <>~ "!!!" $ ("hello","world")
("hello!!!","world!!!")
(<>~
) ::Monoid
a =>Setter
s t a a -> a -> s -> t (<>~
) ::Monoid
a =>Iso
s t a a -> a -> s -> t (<>~
) ::Monoid
a =>Lens
s t a a -> a -> s -> t (<>~
) ::Monoid
a =>Traversal
s t a a -> a -> s -> t
(<?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m b infix 4 #
Set Just
a value with pass-through
This is useful for chaining assignment without round-tripping through your Monad
stack.
do x <-at
"foo"<?=
ninety_nine_bottles_of_beer_on_the_wall
If you do not need a copy of the intermediate result, then using l
will avoid unused binding warnings.?=
d
(<?=
) ::MonadState
s m =>Setter
s s a (Maybe
b) -> b -> m b (<?=
) ::MonadState
s m =>Iso
s s a (Maybe
b) -> b -> m b (<?=
) ::MonadState
s m =>Lens
s s a (Maybe
b) -> b -> m b (<?=
) ::MonadState
s m =>Traversal
s s a (Maybe
b) -> b -> m b
(<.=) :: MonadState s m => ASetter s s a b -> b -> m b infix 4 #
Set with pass-through
This is useful for chaining assignment without round-tripping through your Monad
stack.
do x <-_2
<.=
ninety_nine_bottles_of_beer_on_the_wall
If you do not need a copy of the intermediate result, then using l
will avoid unused binding warnings..=
d
(<.=
) ::MonadState
s m =>Setter
s s a b -> b -> m b (<.=
) ::MonadState
s m =>Iso
s s a b -> b -> m b (<.=
) ::MonadState
s m =>Lens
s s a b -> b -> m b (<.=
) ::MonadState
s m =>Traversal
s s a b -> b -> m b
(<~) :: MonadState s m => ASetter s s a b -> m b -> m () infixr 2 #
Run a monadic action, and set all of the targets of a Lens
, Setter
or Traversal
to its result.
(<~
) ::MonadState
s m =>Iso
s s a b -> m b -> m () (<~
) ::MonadState
s m =>Lens
s s a b -> m b -> m () (<~
) ::MonadState
s m =>Traversal
s s a b -> m b -> m () (<~
) ::MonadState
s m =>Setter
s s a b -> m b -> m ()
As a reasonable mnemonic, this lets you store the result of a monadic action in a Lens
rather than
in a local variable.
do foo <- bar ...
will store the result in a variable, while
do foo <~
bar
...
(||=) :: MonadState s m => ASetter' s Bool -> Bool -> m () infix 4 #
Modify the target(s) of a Lens'
, 'Iso, Setter
or Traversal
by taking their logical ||
with a value.
>>>
execState (do _1 ||= True; _2 ||= False; _3 ||= True; _4 ||= False) (True,True,False,False)
(True,True,True,False)
(||=
) ::MonadState
s m =>Setter'
sBool
->Bool
-> m () (||=
) ::MonadState
s m =>Iso'
sBool
->Bool
-> m () (||=
) ::MonadState
s m =>Lens'
sBool
->Bool
-> m () (||=
) ::MonadState
s m =>Traversal'
sBool
->Bool
-> m ()
(&&=) :: MonadState s m => ASetter' s Bool -> Bool -> m () infix 4 #
Modify the target(s) of a Lens'
, Iso
, Setter
or Traversal
by taking their logical &&
with a value.
>>>
execState (do _1 &&= True; _2 &&= False; _3 &&= True; _4 &&= False) (True,True,False,False)
(True,False,False,False)
(&&=
) ::MonadState
s m =>Setter'
sBool
->Bool
-> m () (&&=
) ::MonadState
s m =>Iso'
sBool
->Bool
-> m () (&&=
) ::MonadState
s m =>Lens'
sBool
->Bool
-> m () (&&=
) ::MonadState
s m =>Traversal'
sBool
->Bool
-> m ()
(**=) :: (MonadState s m, Floating a) => ASetter' s a -> a -> m () infix 4 #
Raise the target(s) of a numerically valued Lens
, Setter
or Traversal
to an arbitrary power
>>>
execState (do _1 **= c; _2 **= d) (a,b)
(a**c,b**d)
(**=
) :: (MonadState
s m,Floating
a) =>Setter'
s a -> a -> m () (**=
) :: (MonadState
s m,Floating
a) =>Iso'
s a -> a -> m () (**=
) :: (MonadState
s m,Floating
a) =>Lens'
s a -> a -> m () (**=
) :: (MonadState
s m,Floating
a) =>Traversal'
s a -> a -> m ()
(^^=) :: (MonadState s m, Fractional a, Integral e) => ASetter' s a -> e -> m () infix 4 #
Raise the target(s) of a numerically valued Lens
, Setter
or Traversal
to an integral power.
(^^=
) :: (MonadState
s m,Fractional
a,Integral
e) =>Setter'
s a -> e -> m () (^^=
) :: (MonadState
s m,Fractional
a,Integral
e) =>Iso'
s a -> e -> m () (^^=
) :: (MonadState
s m,Fractional
a,Integral
e) =>Lens'
s a -> e -> m () (^^=
) :: (MonadState
s m,Fractional
a,Integral
e) =>Traversal'
s a -> e -> m ()
(^=) :: (MonadState s m, Num a, Integral e) => ASetter' s a -> e -> m () infix 4 #
Raise the target(s) of a numerically valued Lens
, Setter
or Traversal
to a non-negative integral power.
(^=
) :: (MonadState
s m,Num
a,Integral
e) =>Setter'
s a -> e -> m () (^=
) :: (MonadState
s m,Num
a,Integral
e) =>Iso'
s a -> e -> m () (^=
) :: (MonadState
s m,Num
a,Integral
e) =>Lens'
s a -> e -> m () (^=
) :: (MonadState
s m,Num
a,Integral
e) =>Traversal'
s a -> e -> m ()
(//=) :: (MonadState s m, Fractional a) => ASetter' s a -> a -> m () infix 4 #
Modify the target(s) of a Lens'
, Iso
, Setter
or Traversal
by dividing by a value.
>>>
execState (do _1 //= c; _2 //= d) (a,b)
(a / c,b / d)
(//=
) :: (MonadState
s m,Fractional
a) =>Setter'
s a -> a -> m () (//=
) :: (MonadState
s m,Fractional
a) =>Iso'
s a -> a -> m () (//=
) :: (MonadState
s m,Fractional
a) =>Lens'
s a -> a -> m () (//=
) :: (MonadState
s m,Fractional
a) =>Traversal'
s a -> a -> m ()
(*=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m () infix 4 #
Modify the target(s) of a Lens'
, Iso
, Setter
or Traversal
by multiplying by value.
>>>
execState (do _1 *= c; _2 *= d) (a,b)
(a * c,b * d)
(*=
) :: (MonadState
s m,Num
a) =>Setter'
s a -> a -> m () (*=
) :: (MonadState
s m,Num
a) =>Iso'
s a -> a -> m () (*=
) :: (MonadState
s m,Num
a) =>Lens'
s a -> a -> m () (*=
) :: (MonadState
s m,Num
a) =>Traversal'
s a -> a -> m ()
(-=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m () infix 4 #
Modify the target(s) of a Lens'
, Iso
, Setter
or Traversal
by subtracting a value.
>>>
execState (do _1 -= c; _2 -= d) (a,b)
(a - c,b - d)
(-=
) :: (MonadState
s m,Num
a) =>Setter'
s a -> a -> m () (-=
) :: (MonadState
s m,Num
a) =>Iso'
s a -> a -> m () (-=
) :: (MonadState
s m,Num
a) =>Lens'
s a -> a -> m () (-=
) :: (MonadState
s m,Num
a) =>Traversal'
s a -> a -> m ()
(+=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m () infix 4 #
Modify the target(s) of a Lens'
, Iso
, Setter
or Traversal
by adding a value.
Example:
fresh
::MonadState
Int
m => mInt
fresh
= doid
+=
1use
id
>>>
execState (do _1 += c; _2 += d) (a,b)
(a + c,b + d)
>>>
execState (do _1.at 1.non 0 += 10) (Map.fromList [(2,100)],"hello")
(fromList [(1,10),(2,100)],"hello")
(+=
) :: (MonadState
s m,Num
a) =>Setter'
s a -> a -> m () (+=
) :: (MonadState
s m,Num
a) =>Iso'
s a -> a -> m () (+=
) :: (MonadState
s m,Num
a) =>Lens'
s a -> a -> m () (+=
) :: (MonadState
s m,Num
a) =>Traversal'
s a -> a -> m ()
(?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m () infix 4 #
Replace the target of a Lens
or all of the targets of a Setter
or Traversal
in our monadic
state with Just
a new value, irrespective of the old.
>>>
execState (do at 1 ?= a; at 2 ?= b) Map.empty
fromList [(1,a),(2,b)]
>>>
execState (do _1 ?= b; _2 ?= c) (Just a, Nothing)
(Just b,Just c)
(?=
) ::MonadState
s m =>Iso'
s (Maybe
a) -> a -> m () (?=
) ::MonadState
s m =>Lens'
s (Maybe
a) -> a -> m () (?=
) ::MonadState
s m =>Traversal'
s (Maybe
a) -> a -> m () (?=
) ::MonadState
s m =>Setter'
s (Maybe
a) -> a -> m ()
modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m () #
This is an alias for (%=
).
(%=) :: MonadState s m => ASetter s s a b -> (a -> b) -> m () infix 4 #
Map over the target of a Lens
or all of the targets of a Setter
or Traversal
in our monadic state.
>>>
execState (do _1 %= f;_2 %= g) (a,b)
(f a,g b)
>>>
execState (do both %= f) (a,b)
(f a,f b)
(%=
) ::MonadState
s m =>Iso'
s a -> (a -> a) -> m () (%=
) ::MonadState
s m =>Lens'
s a -> (a -> a) -> m () (%=
) ::MonadState
s m =>Traversal'
s a -> (a -> a) -> m () (%=
) ::MonadState
s m =>Setter'
s a -> (a -> a) -> m ()
(%=
) ::MonadState
s m =>ASetter
s s a b -> (a -> b) -> m ()
assign :: MonadState s m => ASetter s s a b -> b -> m () #
Replace the target of a Lens
or all of the targets of a Setter
or Traversal
in our monadic
state with a new value, irrespective of the old.
This is an alias for (.=
).
>>>
execState (do assign _1 c; assign _2 d) (a,b)
(c,d)
>>>
execState (both .= c) (a,b)
(c,c)
assign
::MonadState
s m =>Iso'
s a -> a -> m ()assign
::MonadState
s m =>Lens'
s a -> a -> m ()assign
::MonadState
s m =>Traversal'
s a -> a -> m ()assign
::MonadState
s m =>Setter'
s a -> a -> m ()
(&&~) :: ASetter s t Bool Bool -> Bool -> s -> t infixr 4 #
Logically &&
the target(s) of a Bool
-valued Lens
or Setter
.
>>>
both &&~ True $ (False, True)
(False,True)
>>>
both &&~ False $ (False, True)
(False,False)
(&&~
) ::Setter'
sBool
->Bool
-> s -> s (&&~
) ::Iso'
sBool
->Bool
-> s -> s (&&~
) ::Lens'
sBool
->Bool
-> s -> s (&&~
) ::Traversal'
sBool
->Bool
-> s -> s
(||~) :: ASetter s t Bool Bool -> Bool -> s -> t infixr 4 #
Logically ||
the target(s) of a Bool
-valued Lens
or Setter
.
>>>
both ||~ True $ (False,True)
(True,True)
>>>
both ||~ False $ (False,True)
(False,True)
(||~
) ::Setter'
sBool
->Bool
-> s -> s (||~
) ::Iso'
sBool
->Bool
-> s -> s (||~
) ::Lens'
sBool
->Bool
-> s -> s (||~
) ::Traversal'
sBool
->Bool
-> s -> s
(**~) :: Floating a => ASetter s t a a -> a -> s -> t infixr 4 #
Raise the target(s) of a floating-point valued Lens
, Setter
or Traversal
to an arbitrary power.
>>>
(a,b) & _1 **~ c
(a**c,b)
>>>
(a,b) & both **~ c
(a**c,b**c)
>>>
_2 **~ 10 $ (3,2)
(3,1024.0)
(**~
) ::Floating
a =>Setter'
s a -> a -> s -> s (**~
) ::Floating
a =>Iso'
s a -> a -> s -> s (**~
) ::Floating
a =>Lens'
s a -> a -> s -> s (**~
) ::Floating
a =>Traversal'
s a -> a -> s -> s
(^^~) :: (Fractional a, Integral e) => ASetter s t a a -> e -> s -> t infixr 4 #
Raise the target(s) of a fractionally valued Lens
, Setter
or Traversal
to an integral power.
>>>
(1,2) & _2 ^^~ (-1)
(1,0.5)
(^^~
) :: (Fractional
a,Integral
e) =>Setter'
s a -> e -> s -> s (^^~
) :: (Fractional
a,Integral
e) =>Iso'
s a -> e -> s -> s (^^~
) :: (Fractional
a,Integral
e) =>Lens'
s a -> e -> s -> s (^^~
) :: (Fractional
a,Integral
e) =>Traversal'
s a -> e -> s -> s
(^~) :: (Num a, Integral e) => ASetter s t a a -> e -> s -> t infixr 4 #
Raise the target(s) of a numerically valued Lens
, Setter
or Traversal
to a non-negative integral power.
>>>
(1,3) & _2 ^~ 2
(1,9)
(^~
) :: (Num
a,Integral
e) =>Setter'
s a -> e -> s -> s (^~
) :: (Num
a,Integral
e) =>Iso'
s a -> e -> s -> s (^~
) :: (Num
a,Integral
e) =>Lens'
s a -> e -> s -> s (^~
) :: (Num
a,Integral
e) =>Traversal'
s a -> e -> s -> s
(//~) :: Fractional a => ASetter s t a a -> a -> s -> t infixr 4 #
Divide the target(s) of a numerically valued Lens
, Iso
, Setter
or Traversal
.
>>>
(a,b) & _1 //~ c
(a / c,b)
>>>
(a,b) & both //~ c
(a / c,b / c)
>>>
("Hawaii",10) & _2 //~ 2
("Hawaii",5.0)
(//~
) ::Fractional
a =>Setter'
s a -> a -> s -> s (//~
) ::Fractional
a =>Iso'
s a -> a -> s -> s (//~
) ::Fractional
a =>Lens'
s a -> a -> s -> s (//~
) ::Fractional
a =>Traversal'
s a -> a -> s -> s
(-~) :: Num a => ASetter s t a a -> a -> s -> t infixr 4 #
Decrement the target(s) of a numerically valued Lens
, Iso
, Setter
or Traversal
.
>>>
(a,b) & _1 -~ c
(a - c,b)
>>>
(a,b) & both -~ c
(a - c,b - c)
>>>
_1 -~ 2 $ (1,2)
(-1,2)
>>>
mapped.mapped -~ 1 $ [[4,5],[6,7]]
[[3,4],[5,6]]
(-~
) ::Num
a =>Setter'
s a -> a -> s -> s (-~
) ::Num
a =>Iso'
s a -> a -> s -> s (-~
) ::Num
a =>Lens'
s a -> a -> s -> s (-~
) ::Num
a =>Traversal'
s a -> a -> s -> s
(*~) :: Num a => ASetter s t a a -> a -> s -> t infixr 4 #
Multiply the target(s) of a numerically valued Lens
, Iso
, Setter
or Traversal
.
>>>
(a,b) & _1 *~ c
(a * c,b)
>>>
(a,b) & both *~ c
(a * c,b * c)
>>>
(1,2) & _2 *~ 4
(1,8)
>>>
Just 24 & mapped *~ 2
Just 48
(*~
) ::Num
a =>Setter'
s a -> a -> s -> s (*~
) ::Num
a =>Iso'
s a -> a -> s -> s (*~
) ::Num
a =>Lens'
s a -> a -> s -> s (*~
) ::Num
a =>Traversal'
s a -> a -> s -> s
(+~) :: Num a => ASetter s t a a -> a -> s -> t infixr 4 #
Increment the target(s) of a numerically valued Lens
, Setter
or Traversal
.
>>>
(a,b) & _1 +~ c
(a + c,b)
>>>
(a,b) & both +~ c
(a + c,b + c)
>>>
(1,2) & _2 +~ 1
(1,3)
>>>
[(a,b),(c,d)] & traverse.both +~ e
[(a + e,b + e),(c + e,d + e)]
(+~
) ::Num
a =>Setter'
s a -> a -> s -> s (+~
) ::Num
a =>Iso'
s a -> a -> s -> s (+~
) ::Num
a =>Lens'
s a -> a -> s -> s (+~
) ::Num
a =>Traversal'
s a -> a -> s -> s
(<?~) :: ASetter s t a (Maybe b) -> b -> s -> (b, t) infixr 4 #
Set to Just
a value with pass-through.
This is mostly present for consistency, but may be useful for for chaining assignments.
If you do not need a copy of the intermediate result, then using l
directly is a good idea.?~
d
>>>
import Data.Map as Map
>>>
_2.at "hello" <?~ "world" $ (42,Map.fromList [("goodnight","gracie")])
("world",(42,fromList [("goodnight","gracie"),("hello","world")]))
(<?~
) ::Setter
s t a (Maybe
b) -> b -> s -> (b, t) (<?~
) ::Iso
s t a (Maybe
b) -> b -> s -> (b, t) (<?~
) ::Lens
s t a (Maybe
b) -> b -> s -> (b, t) (<?~
) ::Traversal
s t a (Maybe
b) -> b -> s -> (b, t)
(<.~) :: ASetter s t a b -> b -> s -> (b, t) infixr 4 #
Set with pass-through.
This is mostly present for consistency, but may be useful for chaining assignments.
If you do not need a copy of the intermediate result, then using l
directly is a good idea..~
t
>>>
(a,b) & _1 <.~ c
(c,(c,b))
>>>
("good","morning","vietnam") & _3 <.~ "world"
("world",("good","morning","world"))
>>>
(42,Map.fromList [("goodnight","gracie")]) & _2.at "hello" <.~ Just "world"
(Just "world",(42,fromList [("goodnight","gracie"),("hello","world")]))
(<.~
) ::Setter
s t a b -> b -> s -> (b, t) (<.~
) ::Iso
s t a b -> b -> s -> (b, t) (<.~
) ::Lens
s t a b -> b -> s -> (b, t) (<.~
) ::Traversal
s t a b -> b -> s -> (b, t)
(?~) :: ASetter s t a (Maybe b) -> b -> s -> t infixr 4 #
Set the target of a Lens
, Traversal
or Setter
to Just
a value.
l?~
t ≡set
l (Just
t)
>>>
Nothing & id ?~ a
Just a
>>>
Map.empty & at 3 ?~ x
fromList [(3,x)]
?~
can be used type-changily:
>>>
('a', ('b', 'c')) & _2.both ?~ 'x'
('a',(Just 'x',Just 'x'))
(?~
) ::Setter
s t a (Maybe
b) -> b -> s -> t (?~
) ::Iso
s t a (Maybe
b) -> b -> s -> t (?~
) ::Lens
s t a (Maybe
b) -> b -> s -> t (?~
) ::Traversal
s t a (Maybe
b) -> b -> s -> t
(.~) :: ASetter s t a b -> b -> s -> t infixr 4 #
Replace the target of a Lens
or all of the targets of a Setter
or Traversal
with a constant value.
This is an infix version of set
, provided for consistency with (.=
).
f<$
a ≡mapped
.~
f$
a
>>>
(a,b,c,d) & _4 .~ e
(a,b,c,e)
>>>
(42,"world") & _1 .~ "hello"
("hello","world")
>>>
(a,b) & both .~ c
(c,c)
(.~
) ::Setter
s t a b -> b -> s -> t (.~
) ::Iso
s t a b -> b -> s -> t (.~
) ::Lens
s t a b -> b -> s -> t (.~
) ::Traversal
s t a b -> b -> s -> t
(%~) :: ASetter s t a b -> (a -> b) -> s -> t infixr 4 #
Modifies the target of a Lens
or all of the targets of a Setter
or
Traversal
with a user supplied function.
This is an infix version of over
.
fmap
f ≡mapped
%~
ffmapDefault
f ≡traverse
%~
f
>>>
(a,b,c) & _3 %~ f
(a,b,f c)
>>>
(a,b) & both %~ f
(f a,f b)
>>>
_2 %~ length $ (1,"hello")
(1,5)
>>>
traverse %~ f $ [a,b,c]
[f a,f b,f c]
>>>
traverse %~ even $ [1,2,3]
[False,True,False]
>>>
traverse.traverse %~ length $ [["hello","world"],["!!!"]]
[[5,5],[3]]
(%~
) ::Setter
s t a b -> (a -> b) -> s -> t (%~
) ::Iso
s t a b -> (a -> b) -> s -> t (%~
) ::Lens
s t a b -> (a -> b) -> s -> t (%~
) ::Traversal
s t a b -> (a -> b) -> s -> t
set' :: ASetter' s a -> a -> s -> s #
Replace the target of a Lens
or all of the targets of a Setter'
or Traversal
with a constant value, without changing its type.
This is a type restricted version of set
, which retains the type of the original.
>>>
set' mapped x [a,b,c,d]
[x,x,x,x]
>>>
set' _2 "hello" (1,"world")
(1,"hello")
>>>
set' mapped 0 [1,2,3,4]
[0,0,0,0]
Note: Attempting to adjust set'
a Fold
or Getter
will fail at compile time with an
relatively nice error message.
set'
::Setter'
s a -> a -> s -> sset'
::Iso'
s a -> a -> s -> sset'
::Lens'
s a -> a -> s -> sset'
::Traversal'
s a -> a -> s -> s
set :: ASetter s t a b -> b -> s -> t #
Replace the target of a Lens
or all of the targets of a Setter
or Traversal
with a constant value.
(<$
) ≡set
mapped
>>>
set _2 "hello" (1,())
(1,"hello")
>>>
set mapped () [1,2,3,4]
[(),(),(),()]
Note: Attempting to set
a Fold
or Getter
will fail at compile time with an
relatively nice error message.
set
::Setter
s t a b -> b -> s -> tset
::Iso
s t a b -> b -> s -> tset
::Lens
s t a b -> b -> s -> tset
::Traversal
s t a b -> b -> s -> t
over :: ASetter s t a b -> (a -> b) -> s -> t #
Modify the target of a Lens
or all the targets of a Setter
or Traversal
with a function.
fmap
≡over
mapped
fmapDefault
≡over
traverse
sets
.
over
≡id
over
.
sets
≡id
Given any valid Setter
l
, you can also rely on the law:
over
l f.
over
l g =over
l (f.
g)
e.g.
>>>
over mapped f (over mapped g [a,b,c]) == over mapped (f . g) [a,b,c]
True
Another way to view over
is to say that it transforms a Setter
into a
"semantic editor combinator".
>>>
over mapped f (Just a)
Just (f a)
>>>
over mapped (*10) [1,2,3]
[10,20,30]
>>>
over _1 f (a,b)
(f a,b)
>>>
over _1 show (10,20)
("10",20)
over
::Setter
s t a b -> (a -> b) -> s -> tover
::ASetter
s t a b -> (a -> b) -> s -> t
cloneIndexedSetter :: AnIndexedSetter i s t a b -> IndexedSetter i s t a b #
Clone an IndexedSetter
.
cloneIndexPreservingSetter :: ASetter s t a b -> IndexPreservingSetter s t a b #
Build an IndexPreservingSetter
from any Setter
.
sets :: (Profunctor p, Profunctor q, Settable f) => (p a b -> q s t) -> Optical p q f s t a b #
Build a Setter
, IndexedSetter
or IndexPreservingSetter
depending on your choice of Profunctor
.
sets
:: ((a -> b) -> s -> t) ->Setter
s t a b
setting :: ((a -> b) -> s -> t) -> IndexPreservingSetter s t a b #
Build an index-preserving Setter
from a map-like function.
Your supplied function f
is required to satisfy:
fid
≡id
f g.
f h ≡ f (g.
h)
Equational reasoning:
setting
.
over
≡id
over
.
setting
≡id
Another way to view sets
is that it takes a "semantic editor combinator"
and transforms it into a Setter
.
setting
:: ((a -> b) -> s -> t) ->Setter
s t a b
argument :: Profunctor p => Setter (p b r) (p a r) a b #
This Setter
can be used to map over the input of a Profunctor
.
The most common Profunctor
to use this with is (->)
.
>>>
(argument %~ f) g x
g (f x)
>>>
(argument %~ show) length [1,2,3]
7
>>>
(argument %~ f) h x y
h (f x) y
Map over the argument of the result of a function -- i.e., its second argument:
>>>
(mapped.argument %~ f) h x y
h x (f y)
argument
::Setter
(b -> r) (a -> r) a b
contramapped :: Contravariant f => Setter (f b) (f a) a b #
This Setter
can be used to map over all of the inputs to a Contravariant
.
contramap
≡over
contramapped
>>>
getPredicate (over contramapped (*2) (Predicate even)) 5
True
>>>
getOp (over contramapped (*5) (Op show)) 100
"500"
>>>
Prelude.map ($ 1) $ over (mapped . _Unwrapping' Op . contramapped) (*12) [(*2),(+1),(^3)]
[24,13,1728]
lifted :: Monad m => Setter (m a) (m b) a b #
This setter
can be used to modify all of the values in a Monad
.
You sometimes have to use this rather than mapped
-- due to
temporary insanity Functor
was not a superclass of Monad
until
GHC 7.10.
liftM
≡over
lifted
>>>
over lifted f [a,b,c]
[f a,f b,f c]
>>>
set lifted b (Just a)
Just b
If you want an IndexPreservingSetter
use
.setting
liftM
mapped :: Functor f => Setter (f a) (f b) a b #
This Setter
can be used to map over all of the values in a Functor
.
fmap
≡over
mapped
fmapDefault
≡over
traverse
(<$
) ≡set
mapped
>>>
over mapped f [a,b,c]
[f a,f b,f c]
>>>
over mapped (+1) [1,2,3]
[2,3,4]
>>>
set mapped x [a,b,c]
[x,x,x]
>>>
[[a,b],[c]] & mapped.mapped +~ x
[[a + x,b + x],[c + x]]
>>>
over (mapped._2) length [("hello","world"),("leaders","!!!")]
[("hello",5),("leaders",3)]
mapped
::Functor
f =>Setter
(f a) (f b) a b
If you want an IndexPreservingSetter
use
.setting
fmap
type ASetter s t a b = (a -> Identity b) -> s -> Identity t #
Running a Setter
instantiates it to a concrete type.
When consuming a setter directly to perform a mapping, you can use this type, but most user code will not need to use this type.
type AnIndexedSetter i s t a b = Indexed i a (Identity b) -> s -> Identity t #
Running an IndexedSetter
instantiates it to a concrete type.
When consuming a setter directly to perform a mapping, you can use this type, but most user code will not need to use this type.
type AnIndexedSetter' i s a = AnIndexedSetter i s s a a #
typeAnIndexedSetter'
i =Simple
(AnIndexedSetter
i)
type Setting (p :: Type -> Type -> Type) s t a b = p a (Identity b) -> s -> Identity t #
This is a convenient alias when defining highly polymorphic code that takes both
ASetter
and AnIndexedSetter
as appropriate. If a function takes this it is
expecting one of those two things based on context.
type Setting' (p :: Type -> Type -> Type) s a = Setting p s s a a #
This is a convenient alias when defining highly polymorphic code that takes both
ASetter'
and AnIndexedSetter'
as appropriate. If a function takes this it is
expecting one of those two things based on context.
type Lens s t a b = forall (f :: Type -> Type). Functor f => (a -> f b) -> s -> f t #
A Lens
is actually a lens family as described in
http://comonad.com/reader/2012/mirrored-lenses/.
With great power comes great responsibility and a Lens
is subject to the
three common sense Lens
laws:
1) You get back what you put in:
view
l (set
l v s) ≡ v
2) Putting back what you got doesn't change anything:
set
l (view
l s) s ≡ s
3) Setting twice is the same as setting once:
set
l v' (set
l v s) ≡set
l v' s
These laws are strong enough that the 4 type parameters of a Lens
cannot
vary fully independently. For more on how they interact, read the "Why is
it a Lens Family?" section of
http://comonad.com/reader/2012/mirrored-lenses/.
There are some emergent properties of these laws:
1)
must be injective for every set
l ss
This is a consequence of law #1
2)
must be surjective, because of law #2, which indicates that it is possible to obtain any set
lv
from some s
such that set
s v = s
3) Given just the first two laws you can prove a weaker form of law #3 where the values v
that you are setting match:
set
l v (set
l v s) ≡set
l v s
Every Lens
can be used directly as a Setter
or Traversal
.
You can also use a Lens
for Getting
as if it were a
Fold
or Getter
.
Since every Lens
is a valid Traversal
, the
Traversal
laws are required of any Lens
you create:
lpure
≡pure
fmap
(l f).
l g ≡getCompose
.
l (Compose
.
fmap
f.
g)
typeLens
s t a b = forall f.Functor
f =>LensLike
f s t a b
type IndexedLens i s t a b = forall (f :: Type -> Type) (p :: Type -> Type -> Type). (Indexable i p, Functor f) => p a (f b) -> s -> f t #
Every IndexedLens
is a valid Lens
and a valid IndexedTraversal
.
type IndexedLens' i s a = IndexedLens i s s a a #
typeIndexedLens'
i =Simple
(IndexedLens
i)
type IndexPreservingLens s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Functor f) => p a (f b) -> p s (f t) #
An IndexPreservingLens
leaves any index it is composed with alone.
type IndexPreservingLens' s a = IndexPreservingLens s s a a #
type Traversal s t a b = forall (f :: Type -> Type). Applicative f => (a -> f b) -> s -> f t #
A Traversal
can be used directly as a Setter
or a Fold
(but not as a Lens
) and provides
the ability to both read and update multiple fields, subject to some relatively weak Traversal
laws.
These have also been known as multilenses, but they have the signature and spirit of
traverse
::Traversable
f =>Traversal
(f a) (f b) a b
and the more evocative name suggests their application.
Most of the time the Traversal
you will want to use is just traverse
, but you can also pass any
Lens
or Iso
as a Traversal
, and composition of a Traversal
(or Lens
or Iso
) with a Traversal
(or Lens
or Iso
)
using (.
) forms a valid Traversal
.
The laws for a Traversal
t
follow from the laws for Traversable
as stated in "The Essence of the Iterator Pattern".
tpure
≡pure
fmap
(t f).
t g ≡getCompose
.
t (Compose
.
fmap
f.
g)
One consequence of this requirement is that a Traversal
needs to leave the same number of elements as a
candidate for subsequent Traversal
that it started with. Another testament to the strength of these laws
is that the caveat expressed in section 5.5 of the "Essence of the Iterator Pattern" about exotic
Traversable
instances that traverse
the same entry multiple times was actually already ruled out by the
second law in that same paper!
type Traversal' s a = Traversal s s a a #
typeTraversal'
=Simple
Traversal
type Traversal1 s t a b = forall (f :: Type -> Type). Apply f => (a -> f b) -> s -> f t #
type Traversal1' s a = Traversal1 s s a a #
type IndexedTraversal i s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Applicative f) => p a (f b) -> s -> f t #
Every IndexedTraversal
is a valid Traversal
or
IndexedFold
.
The Indexed
constraint is used to allow an IndexedTraversal
to be used
directly as a Traversal
.
The Traversal
laws are still required to hold.
In addition, the index i
should satisfy the requirement that it stays
unchanged even when modifying the value a
, otherwise traversals like
indices
break the Traversal
laws.
type IndexedTraversal' i s a = IndexedTraversal i s s a a #
typeIndexedTraversal'
i =Simple
(IndexedTraversal
i)
type IndexedTraversal1 i s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Apply f) => p a (f b) -> s -> f t #
type IndexedTraversal1' i s a = IndexedTraversal1 i s s a a #
type IndexPreservingTraversal s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Applicative f) => p a (f b) -> p s (f t) #
An IndexPreservingLens
leaves any index it is composed with alone.
type IndexPreservingTraversal' s a = IndexPreservingTraversal s s a a #
type IndexPreservingTraversal1 s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Apply f) => p a (f b) -> p s (f t) #
type IndexPreservingTraversal1' s a = IndexPreservingTraversal1 s s a a #
type Setter s t a b = forall (f :: Type -> Type). Settable f => (a -> f b) -> s -> f t #
The only LensLike
law that can apply to a Setter
l
is that
set
l y (set
l x a) ≡set
l y a
You can't view
a Setter
in general, so the other two laws are irrelevant.
However, two Functor
laws apply to a Setter
:
over
lid
≡id
over
l f.
over
l g ≡over
l (f.
g)
These can be stated more directly:
lpure
≡pure
l f.
untainted
.
l g ≡ l (f.
untainted
.
g)
You can compose a Setter
with a Lens
or a Traversal
using (.
) from the Prelude
and the result is always only a Setter
and nothing more.
>>>
over traverse f [a,b,c,d]
[f a,f b,f c,f d]
>>>
over _1 f (a,b)
(f a,b)
>>>
over (traverse._1) f [(a,b),(c,d)]
[(f a,b),(f c,d)]
>>>
over both f (a,b)
(f a,f b)
>>>
over (traverse.both) f [(a,b),(c,d)]
[(f a,f b),(f c,f d)]
type IndexedSetter i s t a b = forall (f :: Type -> Type) (p :: Type -> Type -> Type). (Indexable i p, Settable f) => p a (f b) -> s -> f t #
Every IndexedSetter
is a valid Setter
.
The Setter
laws are still required to hold.
type IndexedSetter' i s a = IndexedSetter i s s a a #
typeIndexedSetter'
i =Simple
(IndexedSetter
i)
type IndexPreservingSetter s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Settable f) => p a (f b) -> p s (f t) #
An IndexPreservingSetter
can be composed with a IndexedSetter
, IndexedTraversal
or IndexedLens
and leaves the index intact, yielding an IndexedSetter
.
type IndexPreservingSetter' s a = IndexPreservingSetter s s a a #
typeIndexedPreservingSetter'
i =Simple
IndexedPreservingSetter
type Iso s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Profunctor p, Functor f) => p a (f b) -> p s (f t) #
type Review t b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Choice p, Bifunctor p, Settable f) => Optic' p f t b #
type Prism s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Choice p, Applicative f) => p a (f b) -> p s (f t) #
A Prism
l
is a Traversal
that can also be turned
around with re
to obtain a Getter
in the
opposite direction.
There are three laws that a Prism
should satisfy:
First, if I re
or review
a value with a Prism
and then preview
or use (^?
), I will get it back:
preview
l (review
l b) ≡Just
b
Second, if you can extract a value a
using a Prism
l
from a value s
, then the value s
is completely described by l
and a
:
preview
l s ≡Just
a ⟹review
l a ≡ s
Third, if you get non-match t
, you can convert it result back to s
:
matching
l s ≡Left
t ⟹matching
l t ≡Left
s
The first two laws imply that the Traversal
laws hold for every Prism
and that we traverse
at most 1 element:
lengthOf
l x<=
1
It may help to think of this as an Iso
that can be partial in one direction.
Every Prism
is a valid Traversal
.
For example, you might have a
allows you to always
go from a Prism'
Integer
Natural
Natural
to an Integer
, and provide you with tools to check if an Integer
is
a Natural
and/or to edit one if it is.
nat
::Prism'
Integer
Natural
nat
=prism
toInteger
$
\ i -> if i<
0 thenLeft
i elseRight
(fromInteger
i)
Now we can ask if an Integer
is a Natural
.
>>>
5^?nat
Just 5
>>>
(-5)^?nat
Nothing
We can update the ones that are:
>>>
(-3,4) & both.nat *~ 2
(-3,8)
And we can then convert from a Natural
to an Integer
.
>>>
5 ^. re nat -- :: Natural
5
Similarly we can use a Prism
to traverse
the Left
half of an Either
:
>>>
Left "hello" & _Left %~ length
Left 5
or to construct an Either
:
>>>
5^.re _Left
Left 5
such that if you query it with the Prism
, you will get your original input back.
>>>
5^.re _Left ^? _Left
Just 5
Another interesting way to think of a Prism
is as the categorical dual of a Lens
-- a co-Lens
, so to speak. This is what permits the construction of outside
.
Note: Composition with a Prism
is index-preserving.
type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall k3 (p :: k1 -> k3 -> Type) (f :: k2 -> k3). p a (f b) -> p s (f t) #
A witness that (a ~ s, b ~ t)
.
Note: Composition with an Equality
is index-preserving.
type As (a :: k2) = Equality' a a #
Composable asTypeOf
. Useful for constraining excess
polymorphism, foo . (id :: As Int) . bar
.
type Getter s a = forall (f :: Type -> Type). (Contravariant f, Functor f) => (a -> f a) -> s -> f s #
A Getter
describes how to retrieve a single value in a way that can be
composed with other LensLike
constructions.
Unlike a Lens
a Getter
is read-only. Since a Getter
cannot be used to write back there are no Lens
laws that can be applied to
it. In fact, it is isomorphic to an arbitrary function from (s -> a)
.
Moreover, a Getter
can be used directly as a Fold
,
since it just ignores the Applicative
.
type IndexedGetter i s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Contravariant f, Functor f) => p a (f a) -> s -> f s #
Every IndexedGetter
is a valid IndexedFold
and can be used for Getting
like a Getter
.
type IndexPreservingGetter s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Contravariant f, Functor f) => p a (f a) -> p s (f s) #
An IndexPreservingGetter
can be used as a Getter
, but when composed with an IndexedTraversal
,
IndexedFold
, or IndexedLens
yields an IndexedFold
, IndexedFold
or IndexedGetter
respectively.
type Fold s a = forall (f :: Type -> Type). (Contravariant f, Applicative f) => (a -> f a) -> s -> f s #
A Fold
describes how to retrieve multiple values in a way that can be composed
with other LensLike
constructions.
A
provides a structure with operations very similar to those of the Fold
s aFoldable
typeclass, see foldMapOf
and the other Fold
combinators.
By convention, if there exists a foo
method that expects a
, then there should be a
Foldable
(f a)fooOf
method that takes a
and a value of type Fold
s as
.
A Getter
is a legal Fold
that just ignores the supplied Monoid
.
Unlike a Traversal
a Fold
is read-only. Since a Fold
cannot be used to write back
there are no Lens
laws that apply.
type IndexedFold i s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Contravariant f, Applicative f) => p a (f a) -> s -> f s #
Every IndexedFold
is a valid Fold
and can be used for Getting
.
type IndexPreservingFold s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Contravariant f, Applicative f) => p a (f a) -> p s (f s) #
An IndexPreservingFold
can be used as a Fold
, but when composed with an IndexedTraversal
,
IndexedFold
, or IndexedLens
yields an IndexedFold
respectively.
type Fold1 s a = forall (f :: Type -> Type). (Contravariant f, Apply f) => (a -> f a) -> s -> f s #
A relevant Fold (aka Fold1
) has one or more targets.
type IndexedFold1 i s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Contravariant f, Apply f) => p a (f a) -> s -> f s #
type IndexPreservingFold1 s a = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Conjoined p, Contravariant f, Apply f) => p a (f a) -> p s (f s) #
type Simple (f :: k -> k -> k1 -> k1 -> k2) (s :: k) (a :: k1) = f s s a a #
A Simple
Lens
, Simple
Traversal
, ... can
be used instead of a Lens
,Traversal
, ...
whenever the type variables don't change upon setting a value.
_imagPart
::Simple
Lens
(Complex
a) atraversed
::Simple
(IndexedTraversal
Int
) [a] a
Note: To use this alias in your own code with
or
LensLike
fSetter
, you may have to turn on LiberalTypeSynonyms
.
This is commonly abbreviated as a "prime" marker, e.g. Lens'
= Simple
Lens
.
type Optic (p :: k1 -> k -> Type) (f :: k2 -> k) (s :: k1) (t :: k2) (a :: k1) (b :: k2) = p a (f b) -> p s (f t) #
A valid Optic
l
should satisfy the laws:
lpure
≡pure
l (Procompose
f g) =Procompose
(l f) (l g)
This gives rise to the laws for Equality
, Iso
, Prism
, Lens
,
Traversal
, Traversal1
, Setter
, Fold
, Fold1
, and Getter
as well
along with their index-preserving variants.
typeLensLike
f s t a b =Optic
(->) f s t a b
type Optical (p :: k2 -> k -> Type) (q :: k1 -> k -> Type) (f :: k3 -> k) (s :: k1) (t :: k3) (a :: k2) (b :: k3) = p a (f b) -> q s (f t) #
type Optical' (p :: k1 -> k -> Type) (q :: k1 -> k -> Type) (f :: k1 -> k) (s :: k1) (a :: k1) = Optical p q f s s a a #
type LensLike (f :: k -> Type) s (t :: k) a (b :: k) = (a -> f b) -> s -> f t #
Many combinators that accept a Lens
can also accept a
Traversal
in limited situations.
They do so by specializing the type of Functor
that they require of the
caller.
If a function accepts a
for some LensLike
f s t a bFunctor
f
,
then they may be passed a Lens
.
Further, if f
is an Applicative
, they may also be passed a
Traversal
.
type IndexedLensLike i (f :: k -> Type) s (t :: k) a (b :: k) = forall (p :: Type -> Type -> Type). Indexable i p => p a (f b) -> s -> f t #
Convenient alias for constructing indexed lenses and their ilk.
type IndexedLensLike' i (f :: Type -> Type) s a = IndexedLensLike i f s s a a #
Convenient alias for constructing simple indexed lenses and their ilk.
type Over (p :: k -> Type -> Type) (f :: k1 -> Type) s (t :: k1) (a :: k) (b :: k1) = p a (f b) -> s -> f t #
This is a convenient alias for use when you need to consume either indexed or non-indexed lens-likes based on context.
class (Applicative f, Distributive f, Traversable f) => Settable (f :: Type -> Type) #
Instances
Settable Identity | So you can pass our |
Defined in Control.Lens.Internal.Setter untainted :: Identity a -> a # untaintedDot :: Profunctor p => p a (Identity b) -> p a b # taintedDot :: Profunctor p => p a b -> p a (Identity b) # | |
Settable f => Settable (Backwards f) | |
Defined in Control.Lens.Internal.Setter untainted :: Backwards f a -> a # untaintedDot :: Profunctor p => p a (Backwards f b) -> p a b # taintedDot :: Profunctor p => p a b -> p a (Backwards f b) # | |
(Settable f, Settable g) => Settable (Compose f g) | |
Defined in Control.Lens.Internal.Setter untainted :: Compose f g a -> a # untaintedDot :: Profunctor p => p a (Compose f g b) -> p a b # taintedDot :: Profunctor p => p a b -> p a (Compose f g b) # |
retagged :: (Profunctor p, Bifunctor p) => p a b -> p s b #
This is a profunctor used internally to implement Review
It plays a role similar to that of Accessor
or Const
do for Control.Lens.Getter
class (Profunctor p, Bifunctor p) => Reviewable (p :: Type -> Type -> Type) #
This class is provided mostly for backwards compatibility with lens 3.8, but it can also shorten type signatures.
Instances
(Profunctor p, Bifunctor p) => Reviewable p | |
Defined in Control.Lens.Internal.Review |
This provides a way to peek at the internal structure of a
Traversal
or IndexedTraversal
Instances
FunctorWithIndex i (Magma i t b) | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex i (Magma i t b) | |
Defined in Control.Lens.Indexed ifoldMap :: Monoid m => (i -> a -> m) -> Magma i t b a -> m # ifolded :: IndexedFold i (Magma i t b a) a # ifoldr :: (i -> a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 # ifoldl :: (i -> b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 # ifoldr' :: (i -> a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 # ifoldl' :: (i -> b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 # | |
TraversableWithIndex i (Magma i t b) | |
Defined in Control.Lens.Indexed itraverse :: Applicative f => (i -> a -> f b0) -> Magma i t b a -> f (Magma i t b b0) # itraversed :: IndexedTraversal i (Magma i t b a) (Magma i t b b0) a b0 # | |
Functor (Magma i t b) | |
Foldable (Magma i t b) | |
Defined in Control.Lens.Internal.Magma fold :: Monoid m => Magma i t b m -> m # foldMap :: Monoid m => (a -> m) -> Magma i t b a -> m # foldr :: (a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 # foldr' :: (a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 # foldl :: (b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 # foldl' :: (b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 # foldr1 :: (a -> a -> a) -> Magma i t b a -> a # foldl1 :: (a -> a -> a) -> Magma i t b a -> a # toList :: Magma i t b a -> [a] # null :: Magma i t b a -> Bool # length :: Magma i t b a -> Int # elem :: Eq a => a -> Magma i t b a -> Bool # maximum :: Ord a => Magma i t b a -> a # minimum :: Ord a => Magma i t b a -> a # | |
Traversable (Magma i t b) | |
Defined in Control.Lens.Internal.Magma | |
(Show i, Show a) => Show (Magma i t b a) | |
This data type represents a path-compressed copy of one level of a source data structure. We can safely use path-compression because we know the depth of the tree.
Path compression is performed by viewing a Level
as a PATRICIA trie of the
paths into the structure to leaves at a given depth, similar in many ways
to a IntMap
, but unlike a regular PATRICIA trie we do not need
to store the mask bits merely the depth of the fork.
One invariant of this structure is that underneath a Two
node you will not
find any Zero
nodes, so Zero
can only occur at the root.
Instances
FunctorWithIndex i (Level i) | |
Defined in Control.Lens.Indexed | |
FoldableWithIndex i (Level i) | |
TraversableWithIndex i (Level i) | |
Defined in Control.Lens.Indexed itraverse :: Applicative f => (i -> a -> f b) -> Level i a -> f (Level i b) # itraversed :: IndexedTraversal i (Level i a) (Level i b) a b # | |
Functor (Level i) | |
Foldable (Level i) | |
Defined in Control.Lens.Internal.Level fold :: Monoid m => Level i m -> m # foldMap :: Monoid m => (a -> m) -> Level i a -> m # foldr :: (a -> b -> b) -> b -> Level i a -> b # foldr' :: (a -> b -> b) -> b -> Level i a -> b # foldl :: (b -> a -> b) -> b -> Level i a -> b # foldl' :: (b -> a -> b) -> b -> Level i a -> b # foldr1 :: (a -> a -> a) -> Level i a -> a # foldl1 :: (a -> a -> a) -> Level i a -> a # elem :: Eq a => a -> Level i a -> Bool # maximum :: Ord a => Level i a -> a # minimum :: Ord a => Level i a -> a # | |
Traversable (Level i) | |
(Eq i, Eq a) => Eq (Level i a) | |
(Ord i, Ord a) => Ord (Level i a) | |
Defined in Control.Lens.Internal.Level | |
(Read i, Read a) => Read (Level i a) | |
(Show i, Show a) => Show (Level i a) | |
This class provides a generalized notion of list reversal extended to other containers.
Instances
Reversing ByteString | |
Defined in Control.Lens.Internal.Iso reversing :: ByteString -> ByteString # | |
Reversing ByteString | |
Defined in Control.Lens.Internal.Iso reversing :: ByteString -> ByteString # | |
Reversing Text | |
Defined in Control.Lens.Internal.Iso | |
Reversing Text | |
Defined in Control.Lens.Internal.Iso | |
Reversing [a] | |
Defined in Control.Lens.Internal.Iso | |
Storable a => Reversing (Vector a) | |
Defined in Control.Lens.Internal.Iso | |
Reversing (NonEmpty a) | |
Defined in Control.Lens.Internal.Iso | |
Reversing (Seq a) | |
Defined in Control.Lens.Internal.Iso | |
Prim a => Reversing (Vector a) | |
Defined in Control.Lens.Internal.Iso | |
Unbox a => Reversing (Vector a) | |
Defined in Control.Lens.Internal.Iso | |
Reversing (Vector a) | |
Defined in Control.Lens.Internal.Iso |
newtype Bazaar (p :: Type -> Type -> Type) a b t #
This is used to characterize a Traversal
.
a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed FunList
.
http://twanvl.nl/blog/haskell/non-regular1
A Bazaar
is like a Traversal
that has already been applied to some structure.
Where a
holds an Context
a b ta
and a function from b
to
t
, a
holds Bazaar
a b tN
a
s and a function from N
b
s to t
, (where N
might be infinite).
Mnemonically, a Bazaar
holds many stores and you can easily add more.
This is a final encoding of Bazaar
.
Bazaar | |
|
Instances
Profunctor p => Bizarre p (Bazaar p) | |
Defined in Control.Lens.Internal.Bazaar bazaar :: Applicative f => p a (f b) -> Bazaar p a b t -> f t # | |
Corepresentable p => Sellable p (Bazaar p) | |
Defined in Control.Lens.Internal.Bazaar | |
IndexedFunctor (Bazaar p) | |
Defined in Control.Lens.Internal.Bazaar | |
Conjoined p => IndexedComonad (Bazaar p) | |
Functor (Bazaar p a b) | |
Applicative (Bazaar p a b) | |
Defined in Control.Lens.Internal.Bazaar pure :: a0 -> Bazaar p a b a0 # (<*>) :: Bazaar p a b (a0 -> b0) -> Bazaar p a b a0 -> Bazaar p a b b0 # liftA2 :: (a0 -> b0 -> c) -> Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b c # (*>) :: Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b b0 # (<*) :: Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b a0 # | |
(a ~ b, Conjoined p) => Comonad (Bazaar p a b) | |
(a ~ b, Conjoined p) => ComonadApply (Bazaar p a b) | |
Apply (Bazaar p a b) | |
Defined in Control.Lens.Internal.Bazaar |
newtype Bazaar1 (p :: Type -> Type -> Type) a b t #
This is used to characterize a Traversal
.
a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed FunList
.
http://twanvl.nl/blog/haskell/non-regular1
A Bazaar1
is like a Traversal
that has already been applied to some structure.
Where a
holds an Context
a b ta
and a function from b
to
t
, a
holds Bazaar1
a b tN
a
s and a function from N
b
s to t
, (where N
might be infinite).
Mnemonically, a Bazaar1
holds many stores and you can easily add more.
This is a final encoding of Bazaar1
.
Bazaar1 | |
|
Instances
Profunctor p => Bizarre1 p (Bazaar1 p) | |
Defined in Control.Lens.Internal.Bazaar | |
Corepresentable p => Sellable p (Bazaar1 p) | |
Defined in Control.Lens.Internal.Bazaar | |
IndexedFunctor (Bazaar1 p) | |
Defined in Control.Lens.Internal.Bazaar | |
Conjoined p => IndexedComonad (Bazaar1 p) | |
Functor (Bazaar1 p a b) | |
(a ~ b, Conjoined p) => Comonad (Bazaar1 p a b) | |
(a ~ b, Conjoined p) => ComonadApply (Bazaar1 p a b) | |
Apply (Bazaar1 p a b) | |
Defined in Control.Lens.Internal.Bazaar |
The indexed store can be used to characterize a Lens
and is used by cloneLens
.
is isomorphic to
Context
a b tnewtype
,
and to Context
a b t = Context
{ runContext :: forall f. Functor
f => (a -> f b) -> f t }exists s. (s,
.Lens
s t a b)
A Context
is like a Lens
that has already been applied to a some structure.
Context (b -> t) a |
Instances
IndexedFunctor Context | |
Defined in Control.Lens.Internal.Context | |
IndexedComonad Context | |
IndexedComonadStore Context | |
a ~ b => ComonadStore a (Context a b) | |
Defined in Control.Lens.Internal.Context | |
Functor (Context a b) | |
a ~ b => Comonad (Context a b) | |
Sellable ((->) :: Type -> Type -> Type) Context | |
Defined in Control.Lens.Internal.Context |
asIndex :: (Indexable i p, Contravariant f, Functor f) => p i (f i) -> Indexed i s (f s) #
When composed with an IndexedFold
or IndexedTraversal
this yields an
(Indexed
) Fold
of the indices.
withIndex :: (Indexable i p, Functor f) => p (i, s) (f (j, t)) -> Indexed i s (f t) #
Fold a container with indices returning both the indices and the values.
The result is only valid to compose in a Traversal
, if you don't edit the
index as edits to the index have no effect.
>>>
[10, 20, 30] ^.. ifolded . withIndex
[(0,10),(1,20),(2,30)]
>>>
[10, 20, 30] ^.. ifolded . withIndex . alongside negated (re _Show)
[(0,"10"),(-1,"20"),(-2,"30")]
indexing64 :: Indexable Int64 p => ((a -> Indexing64 f b) -> s -> Indexing64 f t) -> p a (f b) -> s -> f t #
Transform a Traversal
into an IndexedTraversal
or
a Fold
into an IndexedFold
, etc.
This combinator is like indexing
except that it handles large traversals and folds gracefully.
indexing64
::Traversal
s t a b ->IndexedTraversal
Int64
s t a bindexing64
::Prism
s t a b ->IndexedTraversal
Int64
s t a bindexing64
::Lens
s t a b ->IndexedLens
Int64
s t a bindexing64
::Iso
s t a b ->IndexedLens
Int64
s t a bindexing64
::Fold
s a ->IndexedFold
Int64
s aindexing64
::Getter
s a ->IndexedGetter
Int64
s a
indexing64
::Indexable
Int64
p =>LensLike
(Indexing64
f) s t a b ->Over
p f s t a b
indexing :: Indexable Int p => ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t #
Transform a Traversal
into an IndexedTraversal
or
a Fold
into an IndexedFold
, etc.
indexing
::Traversal
s t a b ->IndexedTraversal
Int
s t a bindexing
::Prism
s t a b ->IndexedTraversal
Int
s t a bindexing
::Lens
s t a b ->IndexedLens
Int
s t a bindexing
::Iso
s t a b ->IndexedLens
Int
s t a bindexing
::Fold
s a ->IndexedFold
Int
s aindexing
::Getter
s a ->IndexedGetter
Int
s a
indexing
::Indexable
Int
p =>LensLike
(Indexing
f) s t a b ->Over
p f s t a b
class (Choice p, Corepresentable p, Comonad (Corep p), Traversable (Corep p), Strong p, Representable p, Monad (Rep p), MonadFix (Rep p), Distributive (Rep p), Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p, Closed p) => Conjoined (p :: Type -> Type -> Type) where #
This is a Profunctor
that is both Corepresentable
by f
and Representable
by g
such
that f
is left adjoint to g
. From this you can derive a lot of structure due
to the preservation of limits and colimits.
Nothing
distrib :: Functor f => p a b -> p (f a) (f b) #
Conjoined
is strong enough to let us distribute every Conjoined
Profunctor
over every Haskell Functor
. This is effectively a
generalization of fmap
.
conjoined :: ((p ~ ((->) :: Type -> Type -> Type)) -> q (a -> b) r) -> q (p a b) r -> q (p a b) r #
This permits us to make a decision at an outermost point about whether or not we use an index.
Ideally any use of this function should be done in such a way so that you compute the same answer, but this cannot be enforced at the type level.
Instances
Conjoined ReifiedGetter | |
Defined in Control.Lens.Reified distrib :: Functor f => ReifiedGetter a b -> ReifiedGetter (f a) (f b) # conjoined :: ((ReifiedGetter ~ (->)) -> q (a -> b) r) -> q (ReifiedGetter a b) r -> q (ReifiedGetter a b) r # | |
Conjoined (Indexed i) | |
Conjoined ((->) :: Type -> Type -> Type) | |
class Conjoined p => Indexable i (p :: Type -> Type -> Type) where #
This class permits overloading of function application for things that also admit a notion of a key or index.
A function with access to a index. This constructor may be useful when you need to store
an Indexable
in a container to avoid ImpredicativeTypes
.
index :: Indexed i a b -> i -> a -> b
Indexed | |
|
Instances
data Traversed a (f :: Type -> Type) #
Used internally by traverseOf_
and the like.
The argument a
of the result should not be used!
Instances
Applicative f => Semigroup (Traversed a f) | |
Applicative f => Monoid (Traversed a f) | |
data Sequenced a (m :: Type -> Type) #
Used internally by mapM_
and the like.
The argument a
of the result should not be used!
See 4.16 Changelog entry for the explanation of "why not Apply f =>"?
class (Foldable1 t, Traversable t) => Traversable1 (t :: Type -> Type) where #
Instances
traverseBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b) #
Traverse a container using its Traversable
instance using
explicitly provided Applicative
operations. This is like traverse
where the Applicative
instance can be manually specified.
sequenceBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a) #
Sequence a container using its Traversable
instance using
explicitly provided Applicative
operations. This is like sequence
where the Applicative
instance can be manually specified.
class Profunctor p => Choice (p :: Type -> Type -> Type) where #
The generalization of Costar
of Functor
that is strong with respect
to Either
.
Note: This is also a notion of strength, except with regards to another monoidal structure that we can choose to equip Hask with: the cocartesian coproduct.
left' :: p a b -> p (Either a c) (Either b c) #
Laws:
left'
≡dimap
swapE swapE.
right'
where swapE ::Either
a b ->Either
b a swapE =either
Right
Left
rmap
Left
≡lmap
Left
.
left'
lmap
(right
f).
left'
≡rmap
(right
f).
left'
left'
.
left'
≡dimap
assocE unassocE.
left'
where assocE ::Either
(Either
a b) c ->Either
a (Either
b c) assocE (Left
(Left
a)) =Left
a assocE (Left
(Right
b)) =Right
(Left
b) assocE (Right
c) =Right
(Right
c) unassocE ::Either
a (Either
b c) ->Either
(Either
a b) c unassocE (Left
a) =Left
(Left
a) unassocE (Right
(Left
b)) =Left
(Right
b) unassocE (Right
(Right
c)) =Right
c
right' :: p a b -> p (Either c a) (Either c b) #
Laws:
right'
≡dimap
swapE swapE.
left'
where swapE ::Either
a b ->Either
b a swapE =either
Right
Left
rmap
Right
≡lmap
Right
.
right'
lmap
(left
f).
right'
≡rmap
(left
f).
right'
right'
.
right'
≡dimap
unassocE assocE.
right'
where assocE ::Either
(Either
a b) c ->Either
a (Either
b c) assocE (Left
(Left
a)) =Left
a assocE (Left
(Right
b)) =Right
(Left
b) assocE (Right
c) =Right
(Right
c) unassocE ::Either
a (Either
b c) ->Either
(Either
a b) c unassocE (Left
a) =Left
(Left
a) unassocE (Right
(Left
b)) =Left
(Right
b) unassocE (Right
(Right
c)) =Right
c
Instances
values :: AsValue t => IndexedTraversal' Int t Value #
An indexed Traversal into Array elements
>>>
"[1,2,3]" ^.. values
[Number 1.0,Number 2.0,Number 3.0]
>>>
"[1,2,3]" & values . _Number *~ 10
"[10,20,30]"
nth :: AsValue t => Int -> Traversal' t Value #
Like ix
, but for Arrays with Int indexes
>>>
"[1,2,3]" ^? nth 1
Just (Number 2.0)
>>>
"{\"a\": 100, \"b\": 200}" ^? nth 1
Nothing
>>>
"[1,2,3]" & nth 1 .~ Number 20
"[1,20,3]"
members :: AsValue t => IndexedTraversal' Text t Value #
An indexed Traversal into Object properties
>>>
Data.List.sort ("{\"a\": 4, \"b\": 7}" ^@.. members . _Number)
[("a",4.0),("b",7.0)]
>>>
"{\"a\": 4}" & members . _Number *~ 10
"{\"a\":40}"
nonNull :: Prism' Value Value #
Prism into non-Null
values
>>>
"{\"a\": \"xyz\", \"b\": null}" ^? key "a" . nonNull
Just (String "xyz")
>>>
"{\"a\": {}, \"b\": null}" ^? key "a" . nonNull
Just (Object (fromList []))
>>>
"{\"a\": \"xyz\", \"b\": null}" ^? key "b" . nonNull
Nothing
_Integral :: (AsNumber t, Integral a) => Prism' t a #
Access Integer Value
s as Integrals.
>>>
"[10]" ^? nth 0 . _Integral
Just 10
>>>
"[10.5]" ^? nth 0 . _Integral
Just 10
pattern Number_ :: forall t. AsNumber t => Scientific -> t #
pattern Primitive :: forall t. AsPrimitive t => Primitive -> t #
pattern Bool_ :: forall t. AsPrimitive t => Bool -> t #
pattern String_ :: forall t. AsPrimitive t => Text -> t #
pattern Null_ :: forall t. AsPrimitive t => t #
Nothing
_Number :: Prism' t Scientific #
>>>
"[1, \"x\"]" ^? nth 0 . _Number
Just 1.0
>>>
"[1, \"x\"]" ^? nth 1 . _Number
Nothing
Prism into an Double
over a Value
, Primitive
or Scientific
>>>
"[10.2]" ^? nth 0 . _Double
Just 10.2
_Integer :: Prism' t Integer #
Prism into an Integer
over a Value
, Primitive
or Scientific
>>>
"[10]" ^? nth 0 . _Integer
Just 10
>>>
"[10.5]" ^? nth 0 . _Integer
Just 10
>>>
"42" ^? _Integer
Just 42
Instances
AsNumber String | |
AsNumber ByteString | |
Defined in Data.Aeson.Lens | |
AsNumber ByteString | |
Defined in Data.Aeson.Lens | |
AsNumber Text | |
AsNumber Scientific | |
Defined in Data.Aeson.Lens | |
AsNumber Value | |
AsNumber Text | |
AsNumber Primitive | |
Primitives of Value
Instances
Eq Primitive | |
Data Primitive | |
Defined in Data.Aeson.Lens gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Primitive -> c Primitive # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Primitive # toConstr :: Primitive -> Constr # dataTypeOf :: Primitive -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Primitive) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Primitive) # gmapT :: (forall b. Data b => b -> b) -> Primitive -> Primitive # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Primitive -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Primitive -> r # gmapQ :: (forall d. Data d => d -> u) -> Primitive -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Primitive -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Primitive -> m Primitive # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Primitive -> m Primitive # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Primitive -> m Primitive # | |
Ord Primitive | |
Defined in Data.Aeson.Lens | |
Show Primitive | |
AsNumber Primitive | |
AsPrimitive Primitive | |
class AsNumber t => AsPrimitive t where #
Nothing
_Primitive :: Prism' t Primitive #
>>>
"[1, \"x\", null, true, false]" ^? nth 0 . _Primitive
Just (NumberPrim 1.0)
>>>
"[1, \"x\", null, true, false]" ^? nth 1 . _Primitive
Just (StringPrim "x")
>>>
"[1, \"x\", null, true, false]" ^? nth 2 . _Primitive
Just NullPrim
>>>
"[1, \"x\", null, true, false]" ^? nth 3 . _Primitive
Just (BoolPrim True)
>>>
"[1, \"x\", null, true, false]" ^? nth 4 . _Primitive
Just (BoolPrim False)
>>>
"{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String
Just "xyz"
>>>
"{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String
Nothing
>>>
_Object._Wrapped # [("key" :: Text, _String # "value")] :: String
"{\"key\":\"value\"}"
>>>
"{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _Bool
Just True
>>>
"{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _Bool
Nothing
>>>
_Bool # True :: String
"true"
>>>
_Bool # False :: String
"false"
>>>
"{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null
Just ()
>>>
"{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null
Nothing
>>>
_Null # () :: String
"null"
Instances
AsPrimitive String | |
AsPrimitive ByteString | |
Defined in Data.Aeson.Lens _Primitive :: Prism' ByteString Primitive # _String :: Prism' ByteString Text # _Bool :: Prism' ByteString Bool # _Null :: Prism' ByteString () # | |
AsPrimitive ByteString | |
Defined in Data.Aeson.Lens _Primitive :: Prism' ByteString Primitive # _String :: Prism' ByteString Text # _Bool :: Prism' ByteString Bool # _Null :: Prism' ByteString () # | |
AsPrimitive Text | |
AsPrimitive Value | |
AsPrimitive Text | |
AsPrimitive Primitive | |
class AsPrimitive t => AsValue t where #
>>>
preview _Value "[1,2,3]" == Just (Array (Vector.fromList [Number 1.0,Number 2.0,Number 3.0]))
True
_Object :: Prism' t (HashMap Text Value) #
>>>
"{\"a\": {}, \"b\": null}" ^? key "a" . _Object
Just (fromList [])
>>>
"{\"a\": {}, \"b\": null}" ^? key "b" . _Object
Nothing
>>>
_Object._Wrapped # [("key" :: Text, _String # "value")] :: String
"{\"key\":\"value\"}"
_Array :: Prism' t (Vector Value) #
>>>
preview _Array "[1,2,3]" == Just (Vector.fromList [Number 1.0,Number 2.0,Number 3.0])
True
Instances
AsValue String | |
AsValue ByteString | |
Defined in Data.Aeson.Lens | |
AsValue ByteString | |
Defined in Data.Aeson.Lens | |
AsValue Text | |
AsValue Value | |
AsValue Text | |
Instances
AsJSON String | |
AsJSON ByteString | |
Defined in Data.Aeson.Lens _JSON :: (FromJSON a, ToJSON b) => Prism ByteString ByteString a b # | |
AsJSON ByteString | |
Defined in Data.Aeson.Lens _JSON :: (FromJSON a, ToJSON b) => Prism ByteString ByteString a b # | |
AsJSON Text | |
AsJSON Value | |
AsJSON Text | |