{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
module Data.Bits.Lens
( (.|.~), (.&.~), (<.|.~), (<.&.~), (<<.|.~), (<<.&.~)
, (.|.=), (.&.=), (<.|.=), (<.&.=), (<<.|.=), (<<.&.=)
, bitAt
, bits
, byteAt
, bytewise
) where
import Prelude ()
import Control.Lens
import Control.Lens.Internal.Prelude
import Control.Monad.State
import Data.Bits
import Data.Word
infixr 4 .|.~, .&.~, <.|.~, <.&.~, <<.|.~, <<.&.~
infix 4 .|.=, .&.=, <.|.=, <.&.=, <<.|.=, <<.&.=
(.|.~):: Bits a => ASetter s t a a -> a -> s -> t
ASetter s t a a
l .|.~ :: ASetter s t a a -> a -> s -> t
.|.~ a
n = ASetter s t a a -> (a -> a) -> s -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s t a a
l (a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
n)
{-# INLINE (.|.~) #-}
(.&.~) :: Bits a => ASetter s t a a -> a -> s -> t
ASetter s t a a
l .&.~ :: ASetter s t a a -> a -> s -> t
.&.~ a
n = ASetter s t a a -> (a -> a) -> s -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s t a a
l (a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
n)
{-# INLINE (.&.~) #-}
(.&.=):: (MonadState s m, Bits a) => ASetter' s a -> a -> m ()
ASetter' s a
l .&.= :: ASetter' s a -> a -> m ()
.&.= a
a = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter' s a
l ASetter' s a -> a -> s -> s
forall a s t. Bits a => ASetter s t a a -> a -> s -> t
.&.~ a
a)
{-# INLINE (.&.=) #-}
(.|.=) :: (MonadState s m, Bits a) => ASetter' s a -> a -> m ()
ASetter' s a
l .|.= :: ASetter' s a -> a -> m ()
.|.= a
a = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter' s a
l ASetter' s a -> a -> s -> s
forall a s t. Bits a => ASetter s t a a -> a -> s -> t
.|.~ a
a)
{-# INLINE (.|.=) #-}
(<.|.~):: Bits a => LensLike ((,) a) s t a a -> a -> s -> (a, t)
LensLike ((,) a) s t a a
l <.|.~ :: LensLike ((,) a) s t a a -> a -> s -> (a, t)
<.|.~ a
n = LensLike ((,) a) s t a a
l LensLike ((,) a) s t a a -> (a -> a) -> s -> (a, t)
forall b s t a. LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
<%~ (a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
n)
{-# INLINE (<.|.~) #-}
(<.&.~) :: Bits a => LensLike ((,) a) s t a a -> a -> s -> (a, t)
LensLike ((,) a) s t a a
l <.&.~ :: LensLike ((,) a) s t a a -> a -> s -> (a, t)
<.&.~ a
n = LensLike ((,) a) s t a a
l LensLike ((,) a) s t a a -> (a -> a) -> s -> (a, t)
forall b s t a. LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
<%~ (a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
n)
{-# INLINE (<.&.~) #-}
(<.&.=):: (MonadState s m, Bits a) => LensLike' ((,)a) s a -> a -> m a
LensLike' ((,) a) s a
l <.&.= :: LensLike' ((,) a) s a -> a -> m a
<.&.= a
b = LensLike' ((,) a) s a
l LensLike' ((,) a) s a -> (a -> a) -> m a
forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= (a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
b)
{-# INLINE (<.&.=) #-}
(<.|.=) :: (MonadState s m, Bits a) => LensLike' ((,)a) s a -> a -> m a
LensLike' ((,) a) s a
l <.|.= :: LensLike' ((,) a) s a -> a -> m a
<.|.= a
b = LensLike' ((,) a) s a
l LensLike' ((,) a) s a -> (a -> a) -> m a
forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= (a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
b)
{-# INLINE (<.|.=) #-}
(<<.&.~) :: Bits a => Optical' (->) q ((,)a) s a -> a -> q s (a, s)
Optical' (->) q ((,) a) s a
l <<.&.~ :: Optical' (->) q ((,) a) s a -> a -> q s (a, s)
<<.&.~ a
b = Optical' (->) q ((,) a) s a
l Optical' (->) q ((,) a) s a -> Optical' (->) q ((,) a) s a
forall a b. (a -> b) -> a -> b
$ \a
a -> (a
a, a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
b)
{-# INLINE (<<.&.~) #-}
(<<.|.~) :: Bits a => Optical' (->) q ((,)a) s a -> a -> q s (a, s)
Optical' (->) q ((,) a) s a
l <<.|.~ :: Optical' (->) q ((,) a) s a -> a -> q s (a, s)
<<.|.~ a
b = Optical' (->) q ((,) a) s a
l Optical' (->) q ((,) a) s a -> Optical' (->) q ((,) a) s a
forall a b. (a -> b) -> a -> b
$ \a
a -> (a
a, a
a a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
b)
{-# INLINE (<<.|.~) #-}
(<<.&.=) :: (MonadState s m, Bits a) => LensLike' ((,) a) s a -> a -> m a
LensLike' ((,) a) s a
l <<.&.= :: LensLike' ((,) a) s a -> a -> m a
<<.&.= a
b = LensLike' ((,) a) s a
l LensLike' ((,) a) s a -> (a -> (a, a)) -> m a
forall k s (m :: * -> *) (p :: k -> * -> *) r (a :: k) b.
MonadState s m =>
Over p ((,) r) s s a b -> p a (r, b) -> m r
%%= \a
a -> (a
a, a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
b)
{-# INLINE (<<.&.=) #-}
(<<.|.=) :: (MonadState s m, Bits a) => LensLike' ((,) a) s a -> a -> m a
LensLike' ((,) a) s a
l <<.|.= :: LensLike' ((,) a) s a -> a -> m a
<<.|.= a
b = LensLike' ((,) a) s a
l LensLike' ((,) a) s a -> (a -> (a, a)) -> m a
forall k s (m :: * -> *) (p :: k -> * -> *) r (a :: k) b.
MonadState s m =>
Over p ((,) r) s s a b -> p a (r, b) -> m r
%%= \a
a -> (a
a, a
a a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
b)
{-# INLINE (<<.|.=) #-}
bitAt :: Bits b => Int -> IndexedLens' Int b Bool
bitAt :: Int -> IndexedLens' Int b Bool
bitAt Int
n p Bool (f Bool)
f b
b = p Bool (f Bool) -> Int -> Bool -> f Bool
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p Bool (f Bool)
f Int
n (b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
b Int
n) f Bool -> (Bool -> b) -> f b
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
x -> if Bool
x then b -> Int -> b
forall a. Bits a => a -> Int -> a
setBit b
b Int
n else b -> Int -> b
forall a. Bits a => a -> Int -> a
clearBit b
b Int
n
{-# INLINE bitAt #-}
byteAt :: (Integral b, Bits b) => Int -> IndexedLens' Int b Word8
byteAt :: Int -> IndexedLens' Int b Word8
byteAt Int
i p Word8 (f Word8)
f b
b = Word8 -> b
forall a. Integral a => a -> b
back (Word8 -> b) -> f Word8 -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p Word8 (f Word8) -> Int -> Word8 -> f Word8
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p Word8 (f Word8)
f Int
i (b -> Word8
forward b
b) where
back :: a -> b
back a
w8 = (a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w8 b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftL` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8))
b -> b -> b
forall a. Bits a => a -> a -> a
.|. (b -> b
forall a. Bits a => a -> a
complement (b
255 b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftL` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
b)
forward :: b -> Word8
forward = b -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> Word8) -> (b -> b) -> b -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> b
forall a. Bits a => a -> a -> a
(.&.) b
0xff (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Int -> b) -> Int -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> Int -> b
forall a. Bits a => a -> Int -> a
shiftR (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
bits :: (Num b, Bits b) => IndexedTraversal' Int b Bool
bits :: IndexedTraversal' Int b Bool
bits p Bool (f Bool)
f b
b = ((Int, Bool) -> b -> b) -> b -> [(Int, Bool)] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Bool) -> b -> b
forall p. Bits p => (Int, Bool) -> p -> p
step b
0 ([(Int, Bool)] -> b) -> f [(Int, Bool)] -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> f (Int, Bool)) -> [Int] -> f [(Int, Bool)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Int -> f (Int, Bool)
g [Int]
bs where
g :: Int -> f (Int, Bool)
g Int
n = (,) Int
n (Bool -> (Int, Bool)) -> f Bool -> f (Int, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p Bool (f Bool) -> Int -> Bool -> f Bool
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p Bool (f Bool)
f Int
n (b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
b Int
n)
bs :: [Int]
bs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Int -> Bool
hasBit [Int
0..]
hasBit :: Int -> Bool
hasBit Int
n = b -> Int -> b
forall a. Bits a => a -> Int -> a
complementBit b
b Int
n b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
b
step :: (Int, Bool) -> p -> p
step (Int
n,Bool
True) p
r = p -> Int -> p
forall a. Bits a => a -> Int -> a
setBit p
r Int
n
step (Int, Bool)
_ p
r = p
r
{-# INLINE bits #-}
bytewise :: (Integral b, Bits b) => IndexedTraversal' Int b Word8
bytewise :: IndexedTraversal' Int b Word8
bytewise p Word8 (f Word8)
f b
b = ((Int, Word8) -> b -> b) -> b -> [(Int, Word8)] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Word8) -> b -> b
forall a a. (Bits a, Integral a, Num a) => (Int, a) -> a -> a
step b
0 ([(Int, Word8)] -> b) -> f [(Int, Word8)] -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> f (Int, Word8)) -> [Int] -> f [(Int, Word8)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Int -> f (Int, Word8)
g [Int]
bs where
g :: Int -> f (Int, Word8)
g Int
n = (,) Int
n (Word8 -> (Int, Word8)) -> f Word8 -> f (Int, Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p Word8 (f Word8) -> Int -> Word8 -> f Word8
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p Word8 (f Word8)
f Int
n (b -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> Word8) -> b -> Word8
forall a b. (a -> b) -> a -> b
$ b
b b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8))
bs :: [Int]
bs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Int -> Bool
hasByte [Int
0..]
hasByte :: Int -> Bool
hasByte Int
n = b -> Int -> b
forall a. Bits a => a -> Int -> a
complementBit b
b (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
b
step :: (Int, a) -> a -> a
step (Int
n,a
x) a
r = a
r a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8))
{-# INLINE bytewise #-}