{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module FastTags.LensBlaze
( Lens
, Lens'
, lens
, view
, over
, set
, int16L
, int32L
, intL
) where
import Control.Applicative
import Data.Bits
import Data.Functor.Identity
import Data.Int
type Lens' s a = Lens s s a a
type Lens s t a b = forall f. Functor f => (a -> f b) -> (s -> f t)
{-# INLINE lens #-}
lens :: (s -> a) -> (b -> s -> t) -> Lens s t a b
lens :: (s -> a) -> (b -> s -> t) -> Lens s t a b
lens s -> a
access b -> s -> t
write = \a -> f b
f s
s -> (\b
b -> b -> s -> t
write b
b s
s) (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f (s -> a
access s
s)
{-# INLINE view #-}
view :: Lens s t a b -> s -> a
view :: Lens s t a b -> s -> a
view Lens s t a b
l = Const a t -> a
forall a k (b :: k). Const a b -> a
getConst (Const a t -> a) -> (s -> Const a t) -> s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a b) -> s -> Const a t
Lens s t a b
l a -> Const a b
forall k a (b :: k). a -> Const a b
Const
{-# INLINE set #-}
set :: Lens s t a b -> b -> s -> t
set :: Lens s t a b -> b -> s -> t
set Lens s t a b
l = Lens s t a b -> (a -> b) -> s -> t
forall s t a b. Lens s t a b -> (a -> b) -> s -> t
over Lens s t a b
l ((a -> b) -> s -> t) -> (b -> a -> b) -> b -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
forall a b. a -> b -> a
const
{-# INLINE over #-}
over :: Lens s t a b -> (a -> b) -> s -> t
over :: Lens s t a b -> (a -> b) -> s -> t
over Lens s t a b
l a -> b
f = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity b) -> s -> Identity t
Lens s t a b
l (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
{-# INLINE int16L #-}
int16L :: (Bits b, Integral b) => Int -> Lens' b Int16
int16L :: Int -> Lens' b Int16
int16L Int
offset = Int -> b -> Lens' b Int16
forall a b.
(Integral a, Bits b, Integral b) =>
Int -> b -> Lens' b a
intL Int
offset b
0xffff
{-# INLINE int32L #-}
int32L :: (Bits b, Integral b) => Int -> Lens' b Int32
int32L :: Int -> Lens' b Int32
int32L Int
offset = Int -> b -> Lens' b Int32
forall a b.
(Integral a, Bits b, Integral b) =>
Int -> b -> Lens' b a
intL Int
offset b
0xffffffff
{-# INLINE intL #-}
intL :: forall a b. (Integral a, Bits b, Integral b) => Int -> b -> Lens' b a
intL :: Int -> b -> Lens' b a
intL !Int
offset !b
mask = \a -> f a
f b
x ->
(\a
x' -> (a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x' b -> Int -> b
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
offset) b -> b -> b
forall a. Bits a => a -> a -> a
.|. (b
x b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
reverseMask)) (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
a -> f a
f (b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((b
x b -> Int -> b
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
offset) b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
mask :: b))
where
reverseMask :: b
!reverseMask :: b
reverseMask = b -> b
forall a. Bits a => a -> a
complement (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
mask b -> Int -> b
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
offset