Copyright | (C) 2012-16 Edward Kmett |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Edward Kmett <ekmett@gmail.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
Synopsis
- class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where
- (<|) :: Cons s s a a => a -> s -> s
- cons :: Cons s s a a => a -> s -> s
- uncons :: Cons s s a a => s -> Maybe (a, s)
- _head :: Cons s s a a => Traversal' s a
- _tail :: Cons s s a a => Traversal' s s
- pattern (:<) :: Cons b b a a => a -> b -> b
- class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where
- (|>) :: Snoc s s a a => s -> a -> s
- snoc :: Snoc s s a a => s -> a -> s
- unsnoc :: Snoc s s a a => s -> Maybe (s, a)
- _init :: Snoc s s a a => Traversal' s s
- _last :: Snoc s s a a => Traversal' s a
- pattern (:>) :: Snoc a a b b => a -> b -> a
Cons
class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
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 Source # | |
Defined in Control.Lens.Cons _Cons :: Prism ByteString ByteString (Word8, ByteString) (Word8, ByteString) Source # | |
Cons ByteString ByteString Word8 Word8 Source # | |
Defined in Control.Lens.Cons _Cons :: Prism ByteString ByteString (Word8, ByteString) (Word8, ByteString) Source # | |
Cons Text Text Char Char Source # | |
Cons Text Text Char Char Source # | |
Cons [a] [b] a b Source # | |
Defined in Control.Lens.Cons | |
Cons (ZipList a) (ZipList b) a b Source # | |
Cons (Seq a) (Seq b) a b Source # | |
(Unbox a, Unbox b) => Cons (Vector a) (Vector b) a b Source # | |
(Storable a, Storable b) => Cons (Vector a) (Vector b) a b Source # | |
(Prim a, Prim b) => Cons (Vector a) (Vector b) a b Source # | |
Cons (Vector a) (Vector b) a b Source # | |
Cons (Deque a) (Deque b) a b Source # | |
cons :: Cons s s a a => a -> s -> s infixr 5 Source #
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]
uncons :: Cons s s a a => s -> Maybe (a, s) Source #
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])
_head :: Cons s s a a => Traversal' s a Source #
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
_tail :: Cons s s a a => Traversal' s s Source #
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)
Snoc
class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
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 Source # | |
Defined in Control.Lens.Cons _Snoc :: Prism ByteString ByteString (ByteString, Word8) (ByteString, Word8) Source # | |
Snoc ByteString ByteString Word8 Word8 Source # | |
Defined in Control.Lens.Cons _Snoc :: Prism ByteString ByteString (ByteString, Word8) (ByteString, Word8) Source # | |
Snoc Text Text Char Char Source # | |
Snoc Text Text Char Char Source # | |
Snoc [a] [b] a b Source # | |
Defined in Control.Lens.Cons | |
Snoc (ZipList a) (ZipList b) a b Source # | |
Snoc (Seq a) (Seq b) a b Source # | |
(Unbox a, Unbox b) => Snoc (Vector a) (Vector b) a b Source # | |
(Storable a, Storable b) => Snoc (Vector a) (Vector b) a b Source # | |
(Prim a, Prim b) => Snoc (Vector a) (Vector b) a b Source # | |
Snoc (Vector a) (Vector b) a b Source # | |
Snoc (Deque a) (Deque b) a b Source # | |
snoc :: Snoc s s a a => s -> a -> s infixl 5 Source #
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!"
unsnoc :: Snoc s s a a => s -> Maybe (s, a) Source #
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
_init :: Snoc s s a a => Traversal' s s Source #
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)
_last :: Snoc s s a a => Traversal' s a Source #
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