diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,10 @@
+0.4.5
+-------------------------------------------------
+* Added `nothingEff`
+* Added `happend`
+* Added `Arbitrary` instances for `:*`, `:|`, and wrappers
+* Added `Data.Extensible.Bits`
+
 0.4.4
 -------------------------------------------------
 * Added `contEff` and `runContEff`
diff --git a/extensible.cabal b/extensible.cabal
--- a/extensible.cabal
+++ b/extensible.cabal
@@ -1,5 +1,5 @@
 name:                extensible
-version:             0.4.4
+version:             0.4.5
 synopsis:            Extensible, efficient, optics-friendly data types and effects
 homepage:            https://github.com/fumieval/extensible
 bug-reports:         http://github.com/fumieval/extensible/issues
@@ -29,6 +29,7 @@
 library
   exposed-modules:
     Data.Extensible
+    Data.Extensible.Bits
     Data.Extensible.Class
     Data.Extensible.Dictionary
     Data.Extensible.Field
@@ -76,6 +77,7 @@
     , mtl
     , monad-skeleton >= 0.1.2
     , StateVar
+    , QuickCheck
   hs-source-dirs:      src
   ghc-options: -Wall
   default-language:    Haskell2010
@@ -84,5 +86,12 @@
   type: exitcode-stdio-1.0
   main-is: effects.hs
   build-depends: base, extensible
+  hs-source-dirs: tests
+  default-language:    Haskell2010
+
+test-suite bits
+  type: exitcode-stdio-1.0
+  main-is: bits.hs
+  build-depends: base, extensible, lens, QuickCheck, template-haskell
   hs-source-dirs: tests
   default-language:    Haskell2010
diff --git a/src/Data/Extensible/Bits.hs b/src/Data/Extensible/Bits.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Extensible/Bits.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE UndecidableInstances, ScopedTypeVariables, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-}
+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
+
+module Data.Extensible.Bits (BitProd(..)
+  , FromBits(..)
+  , TotalBits
+  , BitFields
+  , blookup
+  , bupdate
+  , toBitProd
+  , BitRecordOf
+  , BitRecord) where
+
+import Control.Comonad
+import Data.Bits
+import Data.Extensible.Class
+import Data.Extensible.Dictionary
+import Data.Extensible.Product
+import Data.Extensible.Internal (getMemberId)
+import Data.Extensible.Field
+import Data.Functor.Identity
+import Data.Ix
+import Data.Profunctor.Rep
+import Data.Profunctor.Sieve
+import Data.Proxy
+import Data.Word
+import Data.Int
+import GHC.Generics (Generic)
+import GHC.TypeLits
+
+-- | Bit-vector product. It has similar interface as @(:*)@ but fields are packed into @r@.
+newtype BitProd r (h :: k -> *) (xs :: [k]) = BitProd { unBitProd :: r }
+  deriving (Eq, Ord, Enum, Bounded, Ix, Generic)
+
+type family TotalBits h xs where
+  TotalBits h '[] = 0
+  TotalBits h (x ': xs) = BitWidth (h x) + TotalBits h xs
+
+-- | Conversion between a value and a bit representation.
+--
+-- Instances of `FromBits` must satisfy the following laws:
+--
+-- > fromBits (x `shiftL` W .|. toBits a) ≡ a
+-- > toBits a `shiftR` W == zeroBits
+--
+-- where W is the 'BitWidth'.
+class (Bits r, KnownNat (BitWidth a)) => FromBits r a where
+  type BitWidth a :: Nat
+  fromBits :: r -> a
+  toBits :: a -> r
+
+instance FromBits Word64 Word64 where
+  type BitWidth Word64 = 64
+  fromBits = id
+  toBits = id
+
+instance FromBits Word64 Bool where
+  type BitWidth Bool = 1
+  fromBits = flip testBit 0
+  toBits False = 0
+  toBits True = 1
+
+instance FromBits Word64 Word8 where
+  type BitWidth Word8 = 8
+  fromBits = fromIntegral
+  toBits = fromIntegral
+
+instance FromBits Word64 Word16 where
+  type BitWidth Word16 = 16
+  fromBits = fromIntegral
+  toBits = fromIntegral
+
+instance FromBits Word64 Word32 where
+  type BitWidth Word32 = 32
+  fromBits = fromIntegral
+  toBits = fromIntegral
+
+instance FromBits Word64 Int8 where
+  type BitWidth Int8 = 8
+  fromBits = fromIntegral
+  toBits = fromIntegral . (fromIntegral :: Int8 -> Word8)
+
+instance FromBits Word64 Int16 where
+  type BitWidth Int16 = 16
+  fromBits = fromIntegral
+  toBits = fromIntegral . (fromIntegral :: Int16 -> Word16)
+
+instance FromBits Word64 Int32 where
+  type BitWidth Int32 = 32
+  fromBits = fromIntegral
+  toBits = fromIntegral . (fromIntegral :: Int32 -> Word32)
+
+instance FromBits r a => FromBits r (Identity a) where
+  type BitWidth (Identity a) = BitWidth a
+  fromBits = Identity . fromBits
+  toBits = toBits . runIdentity
+
+instance (Bits r, FromBits r (h (AssocValue x))) => FromBits r (Field h x) where
+  type BitWidth (Field h x) = BitWidth (h (AssocValue x))
+  fromBits = Field . fromBits
+  toBits = toBits . getField
+
+instance (Bits r, KnownNat (TotalBits h xs)) => FromBits r (BitProd r h xs) where
+  type BitWidth (BitProd r h xs) = TotalBits h xs
+  fromBits = BitProd
+  toBits = unBitProd
+
+-- | Fields are instances of 'FromBits' and fit in the representation.
+type BitFields r h xs = (FromBits r r
+  , TotalBits h xs <= BitWidth r
+  , Forall (Instance1 (FromBits r) h) xs)
+
+-- | Convert a normal extensible record into a bit record.
+toBitProd :: forall r h xs. BitFields r h xs => h :* xs -> BitProd r h xs
+toBitProd p = hfoldrWithIndexFor (Proxy :: Proxy (Instance1 (FromBits r) h))
+  (\i v f r -> f $! bupdate i r v) id p (BitProd zeroBits)
+
+-- | 'hlookup' for 'BitProd'
+blookup :: forall x r h xs.
+  (BitFields r h xs, FromBits r (h x))
+  => Membership xs x -> BitProd r h xs -> h x
+blookup i (BitProd r) = fromBits $ unsafeShiftR r
+  $ bitOffsetAt (Proxy :: Proxy r) (Proxy :: Proxy h) (Proxy :: Proxy xs)
+  $ getMemberId i
+{-# INLINE blookup #-}
+
+-- | Update a field of a 'BitProd'.
+bupdate :: forall x r h xs.
+  (BitFields r h xs, FromBits r (h x))
+  => Membership xs x -> BitProd r h xs -> h x -> BitProd r h xs
+bupdate i (BitProd r) a = BitProd $ r .&. mask
+  .|. unsafeShiftL (toBits a) offset
+  where
+    mask = unsafeShiftL (complement zeroBits) width `rotateL` offset
+    width = fromInteger $ natVal (Proxy :: Proxy (BitWidth (h x)))
+    offset = bitOffsetAt (Proxy :: Proxy r) (Proxy :: Proxy h) (Proxy :: Proxy xs) $ getMemberId i
+{-# INLINE bupdate #-}
+
+bitOffsetAt :: forall r h xs. Forall (Instance1 (FromBits r) h) xs
+  => Proxy (r :: *) -> Proxy (h :: k -> *) -> Proxy (xs :: [k]) -> Int -> Int
+bitOffsetAt _ ph _ = henumerateFor
+  (Proxy :: Proxy (Instance1 (FromBits r) h))
+  (Proxy :: Proxy xs)
+  (\m r o i -> if i == 0
+    then o
+    else r (fromInteger (natVal (proxyBitWidth ph m)) + o) (i - 1))
+  (error "Impossible") 0
+
+proxyBitWidth :: Proxy h -> proxy x -> Proxy (BitWidth (h x))
+proxyBitWidth _ _ = Proxy
+
+type BitRecordOf r h = BitProd r (Field h)
+type BitRecord r = BitRecordOf r Identity
+
+instance (Corepresentable p, Comonad (Corep p), Functor f) => Extensible f p (BitProd r) where
+  type ExtensibleConstr (BitProd r) h xs x
+    = (BitFields r h xs, FromBits r (h x))
+  pieceAt i pafb = cotabulate $ \ws -> bupdate i (extract ws) <$> cosieve pafb (blookup i <$> ws)
+  {-# INLINE pieceAt #-}
diff --git a/src/Data/Extensible/Class.hs b/src/Data/Extensible/Class.hs
--- a/src/Data/Extensible/Class.hs
+++ b/src/Data/Extensible/Class.hs
@@ -59,30 +59,32 @@
 
 -- | This class allows us to use 'pieceAt' for both sums and products.
 class (Functor f, Profunctor p) => Extensible f p (t :: (k -> *) -> [k] -> *) where
-  pieceAt :: Membership xs x -> Optic' p f (t h xs) (h x)
+  type ExtensibleConstr t (h :: k -> *) (xs :: [k]) (x :: k) :: Constraint
+  type ExtensibleConstr t h xs x = ()
+  pieceAt :: ExtensibleConstr t h xs x => Membership xs x -> Optic' p f (t h xs) (h x)
 
 -- | Accessor for an element.
-piece :: (x ∈ xs, Extensible f p t) => Optic' p f (t h xs) (h x)
+piece :: (x ∈ xs, Extensible f p t, ExtensibleConstr t h xs x) => Optic' p f (t h xs) (h x)
 piece = pieceAt membership
 {-# INLINE piece #-}
 
 -- | Like 'piece', but reckon membership from its key.
-pieceAssoc :: (Associate k v xs, Extensible f p t) => Optic' p f (t h xs) (h (k ':> v))
+pieceAssoc :: (Associate k v xs, Extensible f p t, ExtensibleConstr t h xs (k ':> v)) => Optic' p f (t h xs) (h (k ':> v))
 pieceAssoc = pieceAt association
 {-# INLINE pieceAssoc #-}
 
 -- | Access a specified element through a wrapper.
-itemAt :: (Wrapper h, Extensible f p t) => Membership xs x -> Optic' p f (t h xs) (Repr h x)
+itemAt :: (Wrapper h, Extensible f p t, ExtensibleConstr t h xs x) => Membership xs x -> Optic' p f (t h xs) (Repr h x)
 itemAt m = pieceAt m . _Wrapper
 {-# INLINE itemAt #-}
 
 -- | Access an element through a wrapper.
-item :: (Wrapper h, Extensible f p t, x ∈ xs) => proxy x -> Optic' p f (t h xs) (Repr h x)
+item :: (Wrapper h, Extensible f p t, x ∈ xs, ExtensibleConstr t h xs x) => proxy x -> Optic' p f (t h xs) (Repr h x)
 item p = piece . _WrapperAs p
 {-# INLINE item #-}
 
 -- | Access an element specified by the key type through a wrapper.
-itemAssoc :: (Wrapper h, Extensible f p t, Associate k v xs)
+itemAssoc :: (Wrapper h, Extensible f p t, Associate k v xs, ExtensibleConstr t h xs (k ':> v))
   => proxy k -> Optic' p f (t h xs) (Repr h (k ':> v))
 itemAssoc p = pieceAssoc . _WrapperAs (proxyKey p)
 {-# INLINE itemAssoc #-}
diff --git a/src/Data/Extensible/Dictionary.hs b/src/Data/Extensible/Dictionary.hs
--- a/src/Data/Extensible/Dictionary.hs
+++ b/src/Data/Extensible/Dictionary.hs
@@ -24,8 +24,11 @@
 import Data.Extensible.Internal
 import Data.Extensible.Internal.Rig
 import Data.Constraint
+import Data.Extensible.Struct
 import Data.Extensible.Wrapper
 import Data.Semigroup
+import Test.QuickCheck.Arbitrary
+import Test.QuickCheck.Gen
 
 -- | Reify a collection of dictionaries, as you wish.
 library :: forall c xs. Forall c xs => Comp Dict c :* xs
@@ -64,6 +67,13 @@
   minBound = hrepeatFor (Proxy :: Proxy (Instance1 Bounded h)) minBound
   maxBound = hrepeatFor (Proxy :: Proxy (Instance1 Bounded h)) maxBound
 
+instance WrapForall Arbitrary h xs => Arbitrary (h :* xs) where
+  arbitrary = hgenerateFor (Proxy :: Proxy (Instance1 Arbitrary h)) (const arbitrary)
+  shrink xs = henumerateFor (Proxy :: Proxy (Instance1 Arbitrary h))
+    (Proxy :: Proxy xs) (\i -> (++)
+    $ map (\x -> hmodify (\s -> set s i x) xs) $ shrink $ hindex xs i)
+    []
+
 instance WrapForall NFData h xs => NFData (h :* xs) where
   rnf xs = henumerateFor (Proxy :: Proxy (Instance1 NFData h)) (Proxy :: Proxy xs)
     (\i -> deepseq (hlookup i xs)) ()
@@ -90,6 +100,18 @@
 instance WrapForall NFData h xs => NFData (h :| xs) where
   rnf (EmbedAt i h) = views (pieceAt i) (\(Comp Dict) -> rnf h) (library :: Comp Dict (Instance1 NFData h) :* xs)
   {-# INLINE rnf #-}
+
+instance WrapForall Arbitrary h xs => Arbitrary (h :| xs) where
+  arbitrary = choose (0, hcount (Proxy :: Proxy xs)) >>= henumerateFor
+      (Proxy :: Proxy (Instance1 Arbitrary h))
+      (Proxy :: Proxy xs)
+      (\m r i -> if i == 0
+        then EmbedAt m <$> arbitrary
+        else r (i - 1))
+        (error "Impossible")
+  shrink (EmbedAt i h) = views (pieceAt i)
+    (\(Comp Dict) -> EmbedAt i <$> shrink h)
+    (library :: Comp Dict (Instance1 Arbitrary h) :* xs)
 
 -- | Forall upon a wrapper
 type WrapForall c h = Forall (Instance1 c h)
diff --git a/src/Data/Extensible/Effect.hs b/src/Data/Extensible/Effect.hs
--- a/src/Data/Extensible/Effect.hs
+++ b/src/Data/Extensible/Effect.hs
@@ -66,6 +66,7 @@
   , execWriterEff
   -- ** Maybe
   , MaybeEff
+  , nothingEff
   , runMaybeEff
   -- ** Either
   , EitherEff
@@ -398,6 +399,10 @@
 
 -- | An effect with no result
 type MaybeEff = Const ()
+
+-- | Break out of the computation. Similar to 'Nothing'.
+nothingEff :: Associate k MaybeEff xs => Proxy k -> Eff xs a
+nothingEff = flip throwEff ()
 
 -- | Run an effect which may fail in the name of @k@.
 runMaybeEff :: forall k xs a. Eff (k >: MaybeEff ': xs) a -> Eff xs (Maybe a)
diff --git a/src/Data/Extensible/Field.hs b/src/Data/Extensible/Field.hs
--- a/src/Data/Extensible/Field.hs
+++ b/src/Data/Extensible/Field.hs
@@ -61,6 +61,7 @@
 import Foreign.Storable (Storable)
 import GHC.Generics (Generic)
 import GHC.TypeLits hiding (Nat)
+import Test.QuickCheck.Arbitrary
 
 -- | Take the type of the key
 type family AssocKey (kv :: Assoc k v) :: k where
@@ -102,6 +103,7 @@
 ND_Field(Enum)
 ND_Field(Bounded)
 ND_Field(NFData)
+ND_Field(Arbitrary)
 
 -- | Lift a function for the content.
 liftField :: (g (AssocValue kv) -> h (AssocValue kv)) -> Field g kv -> Field h kv
@@ -179,6 +181,7 @@
 type FieldOptic k = forall f p t xs (h :: kind -> *) (v :: kind).
 #endif
   (Extensible f p t
+  , ExtensibleConstr t (Field h) xs (k ':> v)
   , Associate k v xs
   , Labelling k p
   , Wrapper h)
diff --git a/src/Data/Extensible/Label.hs b/src/Data/Extensible/Label.hs
--- a/src/Data/Extensible/Label.hs
+++ b/src/Data/Extensible/Label.hs
@@ -35,6 +35,7 @@
   , Associate k v xs
   , Labelling k p
   , Wrapper h
+  , ExtensibleConstr e (Field h) xs (k ':> v)
   , rep ~ Repr h v
   , s ~ e (Field h) xs
   , s ~ t
diff --git a/src/Data/Extensible/Nullable.hs b/src/Data/Extensible/Nullable.hs
--- a/src/Data/Extensible/Nullable.hs
+++ b/src/Data/Extensible/Nullable.hs
@@ -28,10 +28,11 @@
 import Data.Profunctor.Unsafe
 import Data.Semigroup
 import GHC.Generics (Generic)
+import Test.QuickCheck.Arbitrary
 
 -- | Wrapped Maybe
 newtype Nullable h x = Nullable { getNullable :: Maybe (h x) }
-  deriving (Show, Eq, Ord, Typeable, Generic, NFData)
+  deriving (Show, Eq, Ord, Typeable, Generic, NFData, Arbitrary)
 
 instance Wrapper h => Wrapper (Nullable h) where
   type Repr (Nullable h) x = Maybe (Repr h x)
diff --git a/src/Data/Extensible/Plain.hs b/src/Data/Extensible/Plain.hs
--- a/src/Data/Extensible/Plain.hs
+++ b/src/Data/Extensible/Plain.hs
@@ -56,6 +56,6 @@
 infixr 1 <%|
 
 -- | An accessor for newtype constructors.
-accessing :: (Coercible x a, x ∈ xs, Extensible f p t) => (a -> x) -> Optic' p f (t Identity xs) a
+accessing :: (Coercible x a, x ∈ xs, Extensible f p t, ExtensibleConstr t Identity xs x) => (a -> x) -> Optic' p f (t Identity xs) a
 accessing c = piece . _Wrapper . dimap coerce (fmap c)
 {-# INLINE accessing #-}
diff --git a/src/Data/Extensible/Product.hs b/src/Data/Extensible/Product.hs
--- a/src/Data/Extensible/Product.hs
+++ b/src/Data/Extensible/Product.hs
@@ -18,6 +18,8 @@
   , (<:)
   , (<!)
   , hlength
+  , type (++)
+  , happend
   , hmap
   , hmapWithIndex
   , hzipWith
diff --git a/src/Data/Extensible/Struct.hs b/src/Data/Extensible/Struct.hs
--- a/src/Data/Extensible/Struct.hs
+++ b/src/Data/Extensible/Struct.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns, BangPatterns #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE MagicHash, UnboxedTuples #-}
+{-# LANGUAGE TypeFamilies #-}
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Extensible.Struct
@@ -34,6 +36,8 @@
   , newFrom
   , hlookup
   , hlength
+  , type (++)
+  , happend
   , hfoldrWithIndex
   , thaw
   , hfrozen
@@ -212,6 +216,23 @@
 hlength :: h :* xs -> Int
 hlength (HProduct ar) = I# (sizeofSmallArray# ar)
 {-# INLINE hlength #-}
+
+type family (++) (xs :: [k]) (ys :: [k]) :: [k] where
+  '[] ++ ys = ys
+  (x ': xs) ++ ys = x ': xs ++ ys
+
+infixr 5 ++
+
+-- | Combine products.
+happend :: (h :* xs) -> (h :* ys) -> (h :* (xs ++ ys))
+happend (HProduct lhs) (HProduct rhs) = runST $ primitive $ \s0 ->
+  let lhsSz = sizeofSmallArray# lhs
+      rhsSz = sizeofSmallArray# rhs
+  in  case newSmallArray# (lhsSz +# rhsSz) undefined s0 of { (# s1, a #) ->
+      case copySmallArray# lhs 0# a 0# lhsSz s1 of { s2 ->
+      case copySmallArray# rhs 0# a lhsSz rhsSz s2 of { s3 ->
+      case unsafeFreezeSmallArray# a s3 of { (# s4, frz #) ->
+      (# s4, HProduct frz #) }}}}
 
 unsafeMembership :: Int -> Membership xs x
 unsafeMembership = unsafeCoerce#
diff --git a/src/Data/Extensible/Wrapper.hs b/src/Data/Extensible/Wrapper.hs
--- a/src/Data/Extensible/Wrapper.hs
+++ b/src/Data/Extensible/Wrapper.hs
@@ -26,6 +26,7 @@
 import Data.Extensible.Internal.Rig
 import Data.Semigroup
 import GHC.Generics (Generic)
+import Test.QuickCheck.Arbitrary
 
 -- | The extensible data types should take @k -> *@ as a parameter.
 -- This class allows us to take a shortcut for direct representation.
@@ -60,7 +61,7 @@
 
 -- | Poly-kinded composition
 newtype Comp (f :: j -> *) (g :: i -> j) (a :: i) = Comp { getComp :: f (g a) }
-  deriving (Show, Eq, Ord, Typeable, NFData, Generic, Semigroup, Monoid)
+  deriving (Show, Eq, Ord, Typeable, NFData, Generic, Semigroup, Monoid, Arbitrary)
 
 deriving instance (Functor f, Functor g) => Functor (Comp f g)
 deriving instance (Foldable f, Foldable g) => Foldable (Comp f g)
@@ -78,7 +79,7 @@
 
 -- | Poly-kinded Const
 newtype Const' a x = Const' { getConst' :: a }
-  deriving (Show, Eq, Ord, Typeable, Generic, NFData, Functor, Foldable, Traversable)
+  deriving (Show, Eq, Ord, Typeable, Generic, NFData, Functor, Foldable, Traversable, Arbitrary)
 
 instance Wrapper (Const' a) where
   type Repr (Const' a) b = a
@@ -107,3 +108,7 @@
 instance (Monoid (f a), Monoid (g a)) => Monoid (Prod f g a) where
   mempty = Prod mempty mempty
   Prod a b `mappend` Prod c d = Prod (mappend a c) (mappend b d)
+
+instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Prod f g a) where
+  arbitrary = Prod <$> arbitrary <*> arbitrary
+  shrink (Prod a b) = Prod a `map` shrink b ++ flip Prod b `map` shrink a
diff --git a/tests/bits.hs b/tests/bits.hs
new file mode 100644
--- /dev/null
+++ b/tests/bits.hs
@@ -0,0 +1,94 @@
+{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+import Control.Lens
+import Data.Bits
+import Data.Extensible
+import Data.Extensible.Bits
+import Data.Int
+import Data.Proxy
+import Data.Word
+import GHC.TypeLits
+import Language.Haskell.TH (mkName)
+import Test.QuickCheck
+
+type Fields = ["a" >: Bool, "b" >: Word8, "c" >: Bool]
+
+mkFieldAs (mkName "_a") "a"
+mkFieldAs (mkName "_b") "b"
+mkFieldAs (mkName "_c") "c"
+
+
+prop_lensA1 x r = set _a x (BitProd r :: Rec) ^. _a == x
+prop_lensA2 b = let r = BitProd b :: Rec
+  in set _a (r ^. _a) r == r
+prop_lensA3 b x y = let r = BitProd b :: Rec
+  in set _a x (set _a y r) == set _a x r
+
+prop_lensB1 x r = set _b x (BitProd r :: Rec) ^. _b == x
+prop_lensB2 b = let r = BitProd b :: Rec
+  in set _b (r ^. _b) r == r
+prop_lensB3 b x y = let r = BitProd b :: Rec
+  in set _b x (set _b y r) == set _b x r
+
+prop_lensC1 x r = set _c x (BitProd r :: Rec) ^. _c == x
+prop_lensC2 b = let r = BitProd b :: Rec
+  in set _c (r ^. _c) r == r
+prop_lensC3 b x y = let r = BitProd b :: Rec
+  in set _c x (set _c y r) == set _c x r
+
+type Rec = BitRecord Word64 Fields
+
+focus :: forall a. (Eq a, Show a) => FromBits Word64 a => Word64 -> a -> Property
+focus x a = let w = fromIntegral $ natVal (Proxy :: Proxy (BitWidth a))
+  in fromBits (x `shiftL` w .|. toBits a) === a
+
+clean :: forall a. Eq a => FromBits Word64 a => a -> Property
+clean a = let w = fromIntegral $ natVal (Proxy :: Proxy (BitWidth a))
+  in toBits a `shiftR` w === (zeroBits :: Word64)
+
+prop_focus_Word8 :: Word64 -> Word8 -> Property
+prop_focus_Word8 = focus
+
+prop_clean_Word8 :: Word8 -> Property
+prop_clean_Word8 = clean
+
+prop_focus_Word16 :: Word64 -> Word16 -> Property
+prop_focus_Word16 = focus
+
+prop_clean_Word16 :: Word16 -> Property
+prop_clean_Word16 = clean
+
+prop_focus_Word32 :: Word64 -> Word32 -> Property
+prop_focus_Word32 = focus
+
+prop_clean_Word32 :: Word32 -> Property
+prop_clean_Word32 = clean
+
+prop_focus_Int8 :: Word64 -> Int8 -> Property
+prop_focus_Int8 = focus
+
+prop_clean_Int8 :: Int8 -> Property
+prop_clean_Int8 = clean
+
+prop_focus_Int16 :: Word64 -> Int16 -> Property
+prop_focus_Int16 = focus
+
+prop_clean_Int16 :: Int16 -> Property
+prop_clean_Int16 = clean
+
+prop_focus_Int32 :: Word64 -> Int32 -> Property
+prop_focus_Int32 = focus
+
+prop_clean_Int32 :: Int32 -> Property
+prop_clean_Int32 = clean
+
+prop_focus_Bool :: Word64 -> Bool -> Property
+prop_focus_Bool = focus
+
+prop_clean_Bool :: Bool -> Property
+prop_clean_Bool = clean
+
+return []
+main = $quickCheckAll