diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,11 @@
+# Changelog for `bitarray-bs`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright 2025 Yoshikuni Jujo
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1.  Redistributions of source code must retain the above copyright notice, this
+    list of conditions and the following disclaimer.
+
+2.  Redistributions in binary form must reproduce the above copyright notice,
+    this list of conditions and the following disclaimer in the documentation
+    and/or other materials provided with the distribution.
+
+3.  Neither the name of the copyright holder nor the names of its contributors
+    may be used to endorse or promote products derived from this software
+    without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,4 @@
+# bitarray-bs
+
+Bit array based on ByteString.
+This package used by package yaftee-conduit-bytestring.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bitarray-bs.cabal b/bitarray-bs.cabal
new file mode 100644
--- /dev/null
+++ b/bitarray-bs.cabal
@@ -0,0 +1,60 @@
+cabal-version: 2.2
+
+-- This file has been generated from package.yaml by hpack version 0.38.1.
+--
+-- see: https://github.com/sol/hpack
+
+name:           bitarray-bs
+version:        0.1.0.0
+synopsis:       Bit array based on ByteString
+description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/bitarray-bs#readme>
+category:       Data
+homepage:       https://github.com/YoshikuniJujo/bitarray-bs#readme
+bug-reports:    https://github.com/YoshikuniJujo/bitarray-bs/issues
+author:         Yoshikuni Jujo
+maintainer:     yoshikuni.jujo@gmail.com
+copyright:      (c) 2025 Yoshikuni Jujo
+license:        BSD-3-Clause
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+extra-doc-files:
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/YoshikuniJujo/bitarray-bs
+
+library
+  exposed-modules:
+      Data.ByteString.Bit
+      Data.ByteString.BitArray
+      Data.ByteString.Lazy.BitArray
+  other-modules:
+      Paths_bitarray_bs
+  autogen-modules:
+      Paths_bitarray_bs
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , bytestring ==0.12.*
+  default-language: Haskell2010
+
+test-suite bitarray-bs-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_bitarray_bs
+  autogen-modules:
+      Paths_bitarray_bs
+  hs-source-dirs:
+      test
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , bitarray-bs
+    , bytestring ==0.12.*
+  default-language: Haskell2010
diff --git a/src/Data/ByteString/Bit.hs b/src/Data/ByteString/Bit.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ByteString/Bit.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
+
+module Data.ByteString.Bit (
+
+	-- * BIT
+
+	B(..), bit,
+
+	-- * LIST
+
+	listToNum, listFromNum,
+
+	-- * QUEUE
+
+	Queue, empty, append, uncons, popByte
+
+	) where
+
+import Control.Arrow
+import Data.Bits hiding (bit)
+import Data.Bool
+import Data.Word
+
+data B = O | I deriving (Show, Eq, Ord)
+
+bit :: a -> a -> B -> a
+bit x y = \case O -> x; I -> y
+
+listToNum :: Bits n => [B] -> n
+listToNum = foldr (\b s -> bit id (`setBit` 0) b $ s `shiftL` 1) zeroBits
+
+listFromNum :: Bits n => Int -> n -> [B]
+listFromNum ln n = bool O I . (n `testBit`) <$> [0 .. ln - 1]
+
+type Queue = ([B], [B])
+
+empty :: Queue
+empty = ([], [])
+
+append :: Queue -> [B] -> Queue
+append (xs, ys) bs = (xs, reverse bs ++ ys)
+
+uncons :: Queue -> Maybe (B, Queue)
+uncons = \case
+	([], []) -> Nothing
+	([], ys) -> uncons (reverse ys, [])
+	(x : xs, ys) -> Just (x, (xs, ys))
+
+popByte :: Queue -> Maybe (Word8, Queue)
+popByte = ((listToNum `first`) <$>) . unfoldrN 8 uncons
+
+unfoldrN :: Int -> (a -> Maybe (b, a)) -> a -> Maybe ([b], a)
+unfoldrN 0 _ x = Just ([], x)
+unfoldrN n f x = case f x of
+	Nothing -> Nothing
+	Just (y, x') -> ((y :) `first`) <$> unfoldrN (n - 1) f x'
diff --git a/src/Data/ByteString/BitArray.hs b/src/Data/ByteString/BitArray.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ByteString/BitArray.hs
@@ -0,0 +1,189 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
+
+module Data.ByteString.BitArray (
+
+	-- * BIT ARRAY
+
+	B, null, length, empty,
+
+	-- * FROM/TO BYTE STRING
+
+	fromByteString, toByteString,
+
+	-- * APPEND
+
+	append, appendByteString,
+
+	-- * SPLIT
+
+	pop, popBits, splitAt, byteBoundary,
+
+	-- * CONVERT
+
+	toBits, toBits'
+
+	) where
+
+import Prelude hiding (null, length, splitAt)
+import Control.Arrow
+import Data.Bits
+import Data.Bool
+import Data.ByteString qualified as BS
+import Data.ByteString.Bit qualified as Bit
+
+data B = B { unB :: [B1] } deriving Show
+
+empty :: B
+empty = B []
+
+null :: B -> Bool
+null = \case (B []) -> True; _ -> False
+
+length :: B -> Int
+length  = sum . (length1 <$>) . unB
+
+data B1 = B1 { zero :: Int, length1 :: Int, body :: BS.ByteString }
+	deriving Show
+
+empty1 :: B1
+empty1 = B1 { zero = 0, length1 = 0, body = "" }
+
+null1 :: B1 -> Bool
+null1 = \case B1 { length1 = 0 } -> True; _ -> False
+
+fromByteString :: BS.ByteString -> B
+fromByteString "" = B []
+fromByteString bs = B [B1 { zero = 0, length1 = 8 * BS.length bs, body = bs }]
+
+toByteString :: B -> Either B BS.ByteString
+toByteString b@(B b1s) = case b1s of
+	[] -> Right ""
+	[b1] -> either (Left . B . (: [])) Right $ toByteString1 b1
+	_ -> Left b
+
+toByteString1 :: B1 -> Either B1 BS.ByteString
+toByteString1 ba@B1 { zero = z, length1 = ln, body = bs } =
+	case (z, ln `mod` 8) of (0, 0) -> Right bs; _ -> Left ba
+
+append :: B -> B -> B
+B b1 `append` B b2 = B . normalize $ b1 ++ b2
+
+appendByteString :: B -> BS.ByteString -> B
+appendByteString b = append b . fromByteString
+
+normalize :: [B1] -> [B1]
+normalize = go empty1 . (normalize1 <$>)
+	where
+	go B1 { length1 = 0 } = \case
+		[] -> []
+		b1' : b1s -> go b1' b1s
+	go b1@B1 { zero = z1, length1 = ln1, body = bs1 } = \case
+		[]	| ln1 > 0 -> [b1]
+			| otherwise -> []
+		B1 { length1 = 0 } : b1s -> go b1 b1s
+		b1'@B1 { zero = z2, length1 = ln2, body = bs2 } : b1s
+			| (z1 + ln1) `mod` 8 == 0, z2 == 0 ->
+				go B1 {	zero = z1, length1 = ln1 + ln2,
+					body = bs1 `BS.append` bs2 } b1s
+			| (z1 + ln1 - z2) `mod` 8 == 0 ->
+				go B1 { zero = z1, length1 = ln1 + ln2,
+					body = BS.init bs1 `BS.append` (
+						(	BS.last bs1 .&. bitMask 0 (z2 - 1) .|.
+							BS.head bs2 .&. bitMask z2 7) `BS.cons`
+						BS.tail bs2 ) } b1s
+			| otherwise -> b1 : go b1' b1s
+
+bitMask :: Bits n => Int -> Int -> n
+bitMask i j = foldl setBit zeroBits [i .. j]
+
+normalize1 :: B1 -> B1
+normalize1 B1 { zero = z, length1 = ln, body = bs }
+	| 0 <= z = B1 {
+		zero = z',
+		length1 = ln, body = BS.take t $ BS.drop (z `div` 8) bs }
+	| otherwise = error "normalize: bad"
+	where z' = z `mod` 8; t = (ln + z' - 1) `div` 8 + 1
+
+pop :: B -> Maybe (Bit.B, B)
+pop (B []) = Nothing
+pop (B (b1 : b1s)) = case pop1 b1 of
+	Nothing -> error $ "never occur: " ++ show b1 ++ " " ++ show b1s
+	Just (b, b1') -> Just (b, B . normalize $ b1' : b1s )
+
+pop1 :: B1 -> Maybe (Bit.B, B1)
+pop1 B1 { zero = z, length1 = ln, body = bs } = case (z, ln) of
+	(_, 0) -> Nothing
+	(7, _) -> case BS.uncons bs of
+		Just (b, bs') -> Just (
+			bool Bit.O Bit.I (b `testBit` 7),
+			B1 { zero = 0, length1 = ln - 1, body = bs' } )
+		Nothing -> error "never occur"
+	_ -> Just (
+		bool Bit.O Bit.I $ BS.head bs `testBit` z,
+		B1 { zero = z + 1, length1 = ln - 1, body = bs } )
+
+splitAt :: Int -> B -> Maybe (B, B)
+splitAt n0 = ((B *** B) <$>) . go n0 . unB
+	where
+	go 0 b1s = Just ([], b1s)
+	go _ [] = Nothing
+	go n (b1@B1 { length1 = ln } : b1s)
+		| n < ln = case splitAt1 n b1 of
+			Nothing -> error "never occur"
+			Just (b1t, b1d) -> Just ([b1t], b1d : b1s)
+		| n == ln = Just ([b1], b1s)
+		| otherwise = ((b1 :) `first`) <$> go (n - ln) b1s
+
+splitAt1 :: Int -> B1 -> Maybe (B1, B1)
+splitAt1 n B1 { zero = z, length1 = ln, body = bs }
+	| ln < n = Nothing
+	| otherwise = Just (
+		normalize1 B1 { zero = z, length1 = n, body = bs },
+		normalize1 B1 { zero = z + n, length1 = ln - n, body = bs } )
+
+byteBoundary :: B -> Either (B, B) B
+byteBoundary (B b) = case go b of
+	([], b2) -> Right $ B b2; b12 -> Left $ (B *** B) b12
+	where
+	go [] = ([], [])
+	go (b1 : b1s) = case byteBoundary1 b1 of
+		Nothing -> (b1 :) `first` go b1s
+		Just (b1t, b1d)
+			| null1 b1t -> ([], b1d : b1s)
+			| otherwise -> ([b1t], b1d : b1s)
+
+byteBoundary1 :: B1 -> Maybe (B1, B1)
+byteBoundary1 b1@B1 { zero = z, length1 = ln, body = bs } = case z of
+	0 -> Just (empty1, b1)
+	_	| z + ln <= 8 -> Nothing
+		| otherwise -> Just (
+			B1 { zero = z, length1 = 8 - z, body = BS.take 1 bs },
+			B1 { zero = 0, length1 = ln - 8 + z, body = BS.tail bs } )
+
+popBits :: Bits n => Int -> B -> Maybe (n, B)
+popBits ln b0
+	| length b0 < ln = Nothing
+	| otherwise = Just $ go 0 ln b0
+	where
+	go i j b = case (j, pop b) of
+		(0, _) -> (zeroBits, b)
+		(_, Nothing) -> error "never occur"
+		(_, Just (bt, bts)) -> Bit.bit id (`setBit` i) bt `first` go (i + 1) (j - 1) bts
+
+toBits :: Bits n => B -> n
+toBits = go zeroBits
+	where go i b = case pop b of
+		Nothing -> zeroBits
+		Just (bt, bts) -> Bit.bit id (`setBit` i) bt $ go (i + 1) bts
+
+toBits' :: forall n . FiniteBits n => B -> Maybe n
+toBits' b0
+	| length b0 <= finiteBitSize (undefined :: n) = Just $ go 0 b0
+	| otherwise = Nothing
+	where go i b = case pop b of
+		Nothing -> zeroBits
+		Just (bt, bts) -> Bit.bit id (`setBit` i) bt $ go (i + 1) bts
diff --git a/src/Data/ByteString/Lazy/BitArray.hs b/src/Data/ByteString/Lazy/BitArray.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ByteString/Lazy/BitArray.hs
@@ -0,0 +1,189 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase, OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
+
+module Data.ByteString.Lazy.BitArray (
+
+	-- * BIT ARRAY
+
+	B, null, length, empty,
+
+	-- * FROM/TO LAZY BYTE STRING
+
+	fromByteString, toByteString,
+
+	-- * APPEND
+
+	append, appendByteString,
+
+	-- * SPLIT
+
+	pop, popBits, splitAt, byteBoundary,
+
+	-- * CONVERT
+
+	toBits, toBits'
+
+	) where
+
+import Prelude hiding (null, length, splitAt)
+import Control.Arrow
+import Data.Bits
+import Data.Bool
+import Data.Int
+import Data.ByteString.Lazy qualified as LBS
+import Data.ByteString.Bit qualified as Bit
+
+data B = B { unB :: [B1] } deriving Show
+
+empty :: B
+empty = B []
+
+null :: B -> Bool
+null = \case (B []) -> True; _ -> False
+
+length :: B -> Int64
+length = sum . (length1 <$>) . unB
+
+data B1 = B1 { zero :: Int64, length1 :: Int64, body :: LBS.ByteString }
+	deriving Show
+
+empty1 :: B1
+empty1 = B1 { zero = 0, length1 = 0, body = "" }
+
+null1 :: B1 -> Bool
+null1 = \case B1 { length1 = 0 } -> True; _ -> False
+
+fromByteString :: LBS.ByteString -> B
+fromByteString "" = B []
+fromByteString bs = B [B1 { zero = 0, length1 = 8 * LBS.length bs, body = bs }]
+
+toByteString :: B -> Either B LBS.ByteString
+toByteString b@(B b1s) = case b1s of
+	[] -> Right ""
+	[b1] -> either (Left . B . (: [])) Right $ toByteString1 b1
+	_ -> Left b
+
+toByteString1 :: B1 -> Either B1 LBS.ByteString
+toByteString1 ba@B1 { zero = z, length1 = ln, body = bs } =
+	case (z, ln `mod` 8) of (0, 0) -> Right bs; _ -> Left ba
+
+append :: B -> B -> B
+B b1 `append` B b2 = B . normalize $ b1 ++ b2
+
+appendByteString :: B -> LBS.ByteString -> B
+appendByteString b = append b . fromByteString
+
+normalize :: [B1] -> [B1]
+normalize = go empty1 . (normalize1 <$>)
+	where
+	go B1 { length1 = 0 } = \case
+		[] -> []
+		b1' : b1s -> go b1' b1s
+	go b1@B1 { zero = z1, length1 = ln1, body = bs1 } = \case
+		[]	| ln1 > 0 -> [b1]
+			| otherwise -> []
+		B1 { length1 = 0 } : b1s -> go b1 b1s
+		b1'@B1 { zero = z2, length1 = ln2, body = bs2 } : b1s
+			| (z1 + ln1) `mod` 8 == 0, z2 == 0 ->
+				go B1 {	zero = z1, length1 = ln1 + ln2,
+					body = bs1 `LBS.append` bs2 } b1s
+			| (z1 + ln1 - z2) `mod` 8 == 0 ->
+				go B1 {	zero = z1, length1 = ln1 + ln2,
+					body = LBS.init bs1 `LBS.append` (
+						(	LBS.last bs1 .&. bitMask 0 (z2 - 1) .|.
+							LBS.head bs2 .&. bitMask z2 7) `LBS.cons`
+						LBS.tail bs2 ) } b1s
+			| otherwise -> b1 : go b1' b1s
+
+bitMask :: Bits n => Int64 -> Int64 -> n
+bitMask i j = foldl setBit zeroBits $ fromIntegral <$> [i .. j]
+
+normalize1 :: B1 -> B1
+normalize1 B1 { zero = z, length1 = ln, body = bs }
+	| 0 <= z = B1 {
+		zero = z',
+		length1 = ln, body = LBS.take t $ LBS.drop (z `div` 8) bs }
+	| otherwise = error "normalize: bad"
+	where z' = z `mod` 8; t = (ln + z' - 1) `div` 8 + 1
+
+pop :: B -> Maybe (Bit.B, B)
+pop (B []) = Nothing
+pop (B (b1 : b1s)) = case pop1 b1 of
+	Nothing -> error $ "never occur: " ++ show b1 ++ " " ++ show b1s
+	Just (b, b1') -> Just (b, B . normalize $ b1' : b1s )
+
+pop1 :: B1 -> Maybe (Bit.B, B1)
+pop1 B1 { zero = z, length1 = ln, body = bs } = case (z, ln) of
+	(_, 0) -> Nothing
+	(7, _) -> case LBS.uncons bs of
+		Just (b, bs') -> Just (
+			bool Bit.O Bit.I (b `testBit` 7),
+			B1 { zero = 0, length1 = ln - 1, body = bs' } )
+		Nothing -> error "never occur"
+	_ -> Just (
+		bool Bit.O Bit.I $ LBS.head bs `testBit` fromIntegral z,
+		B1 { zero = z + 1, length1 = ln - 1, body = bs } )
+
+splitAt :: Int64 -> B -> Maybe (B, B)
+splitAt n0 = ((B *** B) <$>) . go n0 . unB
+	where
+	go 0 b1s = Just ([], b1s)
+	go _ [] = Nothing
+	go n (b1@B1 { length1 = ln } : b1s)
+		| n < ln = case splitAt1 n b1 of
+			Nothing -> error "never occur"
+			Just (b1t, b1d) -> Just ([b1t], b1d : b1s)
+		| n == ln = Just ([b1], b1s)
+		| otherwise = ((b1 :) `first`) <$> go (n - ln) b1s
+
+splitAt1 :: Int64 -> B1 -> Maybe (B1, B1)
+splitAt1 n B1 { zero = z, length1 = ln, body = bs }
+	| ln < n = Nothing
+	| otherwise = Just (
+		normalize1 B1 { zero = z, length1 = n, body = bs },
+		normalize1 B1 { zero = z + n, length1 = ln - n, body = bs } )
+
+byteBoundary :: B -> Either (B, B) B
+byteBoundary (B b) = case go b of
+	([], b2) -> Right $ B b2; b12 -> Left $ (B *** B) b12
+	where
+	go [] = ([], [])
+	go (b1 : b1s) = case byteBoundary1 b1 of
+		Nothing -> (b1 :) `first` go b1s
+		Just (b1t, b1d)
+			| null1 b1t -> ([], b1d : b1s)
+			| otherwise -> ([b1t], b1d : b1s)
+
+byteBoundary1 :: B1 -> Maybe (B1, B1)
+byteBoundary1 b1@B1 { zero = z, length1 = ln, body = bs } = case z of
+	0 -> Just (empty1, b1)
+	_	| z + ln <= 8 -> Nothing
+		| otherwise -> Just (
+			B1 { zero = z, length1 = 8 - z, body = LBS.take 1 bs },
+			B1 { zero = 0, length1 = ln - 8 + z, body = LBS.tail bs } )
+
+popBits :: Bits n => Int64 -> B -> Maybe (n, B)
+popBits ln b0
+	| length b0 < ln = Nothing
+	| otherwise = Just $ go 0 ln b0
+	where
+	go i j b = case (j, pop b) of
+		(0, _) -> (zeroBits, b)
+		(_, Nothing) -> error "never occur"
+		(_, Just (bt, bts)) -> Bit.bit id (`setBit` i) bt `first` go (i + 1) (j - 1) bts
+
+toBits :: Bits n => B -> n
+toBits = go zeroBits
+	where go i b = case pop b of
+		Nothing -> zeroBits
+		Just (bt, bts) -> Bit.bit id (`setBit` i) bt $ go (i + 1) bts
+
+toBits' :: forall n . FiniteBits n => B -> Maybe n
+toBits' b0
+	| length b0 <= fromIntegral (finiteBitSize (undefined :: n)) = Just $ go 0 b0
+	| otherwise = Nothing
+	where go i b = case pop b of
+		Nothing -> zeroBits
+		Just (bt, bts) -> Bit.bit id (`setBit` i) bt $ go (i + 1) bts
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"
