bytestring-ft (empty) → 0.1.0.0

raw patch · 11 files changed

+1100/−0 lines, 11 filesdep +basedep +bytestringdep +bytestring-ftsetup-changed

Dependencies added: base, bytestring, bytestring-ft, mono-traversable

Files

• CHANGELOG.md +11/−0
• LICENSE +26/−0
• README.md +3/−0
• Setup.hs +2/−0
• bytestring-ft.cabal +64/−0
• src/Data/ByteString/FingerTree.hs +51/−0
• src/Data/ByteString/FingerTree/Bits.hs +64/−0
• src/Data/ByteString/FingerTree/CString.hs +40/−0
• src/Data/ByteString/FingerTree/Char8.hs +10/−0
• src/Data/ByteString/FingerTree/Internal.hs +827/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,11 @@+# Changelog for `bytestring-ft`++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

@@ -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.

@@ -0,0 +1,3 @@+# bytestring-ft++Byte String implemented on Finger Tree.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,64 @@+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:           bytestring-ft+version:        0.1.0.0+synopsis:       Byte String implemented on Finger Tree+description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/bytestring-ft#readme>+category:       Data+homepage:       https://github.com/YoshikuniJujo/bytestring-ft#readme+bug-reports:    https://github.com/YoshikuniJujo/bytestring-ft/issues+author:         Yoshikuni Jujo+maintainer:     yoshikuni.jujo@gmail.com+copyright:      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/bytestring-ft++library+  exposed-modules:+      Data.ByteString.FingerTree+      Data.ByteString.FingerTree.Bits+      Data.ByteString.FingerTree.Char8+      Data.ByteString.FingerTree.CString+      Data.ByteString.FingerTree.Internal+  other-modules:+      Paths_bytestring_ft+  autogen-modules:+      Paths_bytestring_ft+  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.*+    , mono-traversable ==1.*+  default-language: Haskell2010++test-suite bytestring-ft-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_bytestring_ft+  autogen-modules:+      Paths_bytestring_ft+  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+    , bytestring ==0.12.*+    , bytestring-ft+    , mono-traversable ==1.*+  default-language: Haskell2010

@@ -0,0 +1,51 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ViewPatterns, BangPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.ByteString.FingerTree (++	-- * BYTE STRING++	ByteString,+	pattern Empty, pattern (:<), pattern (:>), pattern (:<|), pattern (:|>),++	-- * INTRODUCING AND ELIMINATING++	empty, singleton, pack, unpack, fromStrict, toStrict,++	-- * BASIC INTERFACE++	cons, snoc, append, uncons, unsnoc, null, length,++	-- * REDUCING BYTESTRINGS (FOLDS)++	foldl',++	-- * GENERATING++	replicate,++	-- * BREAKING++	splitAt', span++) where++import Prelude hiding (concat, null, length, replicate, span, foldl')+import Control.Arrow+import Data.Word+import Data.ByteString qualified as BS+import Data.ByteString.FingerTree.Internal++span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)+span _ Empty = (Empty, Empty)+span p ba@(b :< bs)+	| p b = (b :<) `first` span p bs+	| otherwise = (Empty, ba)++foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a+foldl' f !v = \case Empty -> v; bs :<| bss -> foldl' f (BS.foldl' f v bs) bss

@@ -0,0 +1,64 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.ByteString.FingerTree.Bits where++import Control.Arrow+import Data.Bits+import Data.Bool+import Data.ByteString.FingerTree qualified as BSF+import Data.ByteString.FingerTree.Internal+import Data.MonoTraversable++-- see ~/projects/tools-yj/src/Data/ByteString/ToolsYj.hs++-- * FROM/TO BITS++fromBits :: Bits b => b -> ByteString+fromBits = unfoldr \b ->+	bool Nothing (Just (bitsToBits 8 b, b `shiftR` 8)) (b /= zeroBits)++fromBits' :: FiniteBits b => b -> ByteString+fromBits' b0 = go (finiteBitSize b0 `div` 8) b0+	where+	go 0 _ = ""+	go n b = bitsToBits 8 b `cons` go (n - 1) (b `shiftR` 8)++toBits :: Bits b => ByteString -> b+toBits = ofoldr (\b s -> bitsToBits 8 b .|. s `shiftL` 8) zeroBits++toBits' :: forall b . FiniteBits b => ByteString -> Maybe b+toBits' bs = bool+	Nothing+	(Just $ ofoldr (\b s -> bitsToBits 8 b .|. s `shiftL` 8) zeroBits bs)+	(8 * olength bs <= finiteBitSize @b undefined)++-- * FROM/TO BITS -- BIG ENDIEN++fromBitsBE :: Bits b => b -> ByteString+fromBitsBE b+	| b == zeroBits = ""+	| otherwise = fromBitsBE (b `shiftR` 8) `snoc` bitsToBits 8 b++fromBitsBE' :: FiniteBits b => b -> ByteString+fromBitsBE' b0 = go (finiteBitSize b0 `div` 8) b0+	where+	go 0 _ = ""+	go n b = go (n - 1) (b `shiftR` 8) `snoc` bitsToBits 8 b++toBitsBE :: Bits b => ByteString -> b+toBitsBE = BSF.foldl' (\s b -> bitsToBits 8 b .|. s `shiftL` 8) zeroBits++toBitsBE' :: FiniteBits b => b -> ByteString+toBitsBE' b0 = go (finiteBitSize b0 `div` 8) b0+	where+	go 0 _ = ""+	go n b = go (n - 1) (b `shiftR` 8) `snoc` bitsToBits 8 b++-- * BITS TO BITS++bitsToBits :: (Bits a, Bits b) => Int -> a -> b+bitsToBits n b = foldl setBit zeroBits+	. map fst . filter snd $ map (id &&& testBit b) [0 .. n - 1]

@@ -0,0 +1,40 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.ByteString.FingerTree.CString (peek, poke) where++import Foreign.Ptr+import Foreign.Marshal.Utils+import Foreign.C.String+import Data.ByteString qualified as BS+import Data.ByteString.FingerTree as BSF++pokeByteString :: CStringLen -> BS.ByteString -> IO (CStringLen, BS.ByteString)+pokeByteString (p, n) bs+	| n >= n' = do+		BS.useAsCStringLen bs \(p', _) -> copyBytes p p' n'+		pure ((plusPtr p n', n - n'), "")+	| otherwise = let (t, d) = BS.splitAt n bs in do+		BS.useAsCStringLen t \(p', _) -> copyBytes p p' n+		pure ((plusPtr p n, 0), d)+	where+	n' = BS.length bs++poke :: CStringLen -> BSF.ByteString ->+	IO (CStringLen, Either CStringLen BSF.ByteString)+poke c@(p, n) bsf+	| n >= n' = ((p, n'), Left (plusPtr p n', n - n')) <$ go c bsf+	| otherwise = case BSF.splitAt' n bsf of+		Nothing -> error "never occur"+		Just (t, d) -> (c, Right d) <$ go c t+	where+	go csl = \case+		Empty -> pure ()+		bs BSF.:<| bss -> do+			(csl', "") <- pokeByteString csl bs+			go csl' bss+	n' = BSF.length bsf++peek :: CStringLen -> IO BSF.ByteString+peek csl = (BSF.:<| BSF.Empty) <$> BS.packCStringLen csl

@@ -0,0 +1,10 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.ByteString.FingerTree.Char8 where++import Data.ByteString.Char8 qualified as BSC+import Data.ByteString.FingerTree.Internal++singleton :: Char -> ByteString+singleton = ByteString . Single . BSC.singleton

@@ -0,0 +1,827 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ViewPatterns, BangPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.ByteString.FingerTree.Internal (++	-- * BYTE STRING++	ByteString(..), pattern Empty,+	pattern (:<), pattern (:>),+	pattern (:<|), pattern (:|>),++	-- * INTRODUCING AND ELIMINATING++	empty, singleton, pack, unpack, fromStrict, toStrict,++	-- * BASIC INTERFACE++	cons, snoc, append, uncons, unsnoc, null, length,++	-- * GENERATING++	replicate, unfoldr,++	-- * BREAKING++	splitAt',++	-- * FingerTree++	FingerTree(..)++) where++import Prelude hiding (concat, null, length, replicate)+import Prelude qualified as P+import Data.Foldable (foldr')+import Data.String+import Data.Bool+import Data.Word+import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as BSC++import GHC.Generics++import Data.MonoTraversable++infixr 5 `consTree`+infixl 5 `snocTree`+infixr 5 `appendTree0`++newtype ByteString = ByteString { unByteString :: FingerTree BS.ByteString }++instance IsString ByteString where+	{-# INLINE fromString #-}+	fromString = packChars++instance Semigroup ByteString where+	(<>) = append++instance Monoid ByteString where+	mempty = Empty+	mappend = (<>)+	mconcat = concat++instance Read ByteString where+	readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]++instance Show ByteString where+	showsPrec p ps r = showsPrec p (unpackChars ps) r++instance Eq ByteString where (==) = eq+instance Ord ByteString where compare = compareBytes++empty :: ByteString+empty = Empty++singleton :: Word8 -> ByteString+singleton = ByteString . Single . BS.singleton++pack :: [Word8] -> ByteString+pack = \case+	[] -> ByteString EmptyT+	bs -> ByteString . Single $ BS.pack bs++unpack :: ByteString -> [Word8]+unpack (ByteString t) = unpackTree t++unpackTree :: FingerTree BS.ByteString -> [Word8]+unpackTree EmptyT = []+unpackTree (bs :<|| t) = BS.unpack bs ++ unpackTree t++fromStrict :: BS.ByteString -> ByteString+fromStrict bs = bool (ByteString $ Single bs) Empty (BS.null bs)++toStrict :: ByteString -> BS.ByteString+toStrict (ByteString t) = toStrictTree t++toStrictTree :: FingerTree BS.ByteString -> BS.ByteString+toStrictTree = BS.concat . toList++cons :: Word8 -> ByteString -> ByteString+b `cons` ByteString bs = ByteString $ BS.singleton b `consTree` bs++snoc :: ByteString -> Word8 -> ByteString+ByteString bs `snoc` b = ByteString $ bs `snocTree` BS.singleton b++append :: ByteString -> ByteString -> ByteString+append = (><)++uncons :: ByteString -> Maybe (Word8, ByteString)+uncons (ByteString t) = case t of+	EmptyT -> Nothing+	bs :<|| t' -> case BS.uncons bs of+		Nothing -> error "unnormalized ByteString"+		Just (b, bs') -> Just (+			b,+			bool	(ByteString $ bs' :<|| t')+				(ByteString t')+				(BS.null bs') )++unsnoc :: ByteString -> Maybe (ByteString, Word8)+unsnoc (ByteString t) = case t of+	EmptyT -> Nothing+	t' :||> bs -> case BS.unsnoc bs of+		Nothing -> error "unnormalized ByteString"+		Just (bs', b) -> Just (+			bool	(ByteString $ t' :||> bs')+				(ByteString t')+				(BS.null bs'),+			b )++null :: ByteString -> Bool+null = (<= 0) . size . unByteString++length :: ByteString -> Int+length = size . unByteString++concat :: [ByteString] -> ByteString+concat = foldr append Empty++replicate :: Int -> Word8 -> ByteString+replicate 0 = const $ Empty+replicate n = ByteString . Single . BS.replicate n++unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString+unfoldr f = concat . (fromStrict <$>) . unfoldChunk 32 64+	where unfoldChunk n  n' x =+		case BS.unfoldrN n f x of+			(s, Nothing) -> [s]+			(s, Just x') -> s : unfoldChunk n' (n + n') x'++splitAt' :: Int -> ByteString -> Maybe (ByteString, ByteString)+splitAt' n (ByteString t) = case search (\l _ -> l >= n) t of+	Position l x r -> let (xl, xr) = BS.splitAt (n - size l) x in+		Just (	ByteString $ bool (`snocTree` xl) id (BS.null xl) l,+			ByteString $ bool (xr `consTree`) id (BS.null xr) r )+	_ -> Nothing++eq :: ByteString -> ByteString -> Bool+eq Empty Empty = True+eq Empty _ = False+eq _ Empty = False+eq aa@(a :< as) ba@(b :< bs)+	| length aa /= length ba = False+	| otherwise = a == b && as `eq` bs++compareBytes :: ByteString -> ByteString -> Ordering+compareBytes Empty Empty = EQ+compareBytes Empty _ = LT+compareBytes _ Empty = GT+compareBytes (a :< as) (b :< bs)+	| a < b = LT+	| a > b = GT+	| otherwise = compareBytes as bs++packChars :: [Char] -> ByteString+packChars cs+	| P.null cs = ByteString EmptyT+	| otherwise = ByteString . Single $ BSC.pack cs++unpackChars :: ByteString -> [Char]+unpackChars (ByteString t) = unpackCharsTree t++unpackCharsTree :: FingerTree BS.ByteString -> [Char]+unpackCharsTree EmptyT = []+unpackCharsTree (bs :<|| t) = BSC.unpack bs ++ unpackCharsTree t++pattern Empty :: ByteString+pattern Empty = ByteString EmptyT++{-# COMPLETE (:<|), Empty #-}++pattern (:<|) :: BS.ByteString -> ByteString -> ByteString+pattern b :<| bs <- (unByteString -> b :<|| (ByteString -> bs)) where+	b :<| bs = ByteString $ bool (b :<|| unByteString bs) EmptyT (BS.null b)++{-# COMPLETE (:|>), Empty #-}++pattern (:|>) :: ByteString -> BS.ByteString -> ByteString+pattern bs :|> b <- (unByteString -> (ByteString -> bs) :||> b) where+	bs :|> b = ByteString $ bool (unByteString bs :||> b) EmptyT (BS.null b)++{-# COMPLETE (:<), Empty #-}++pattern (:<) :: Word8 -> ByteString -> ByteString+pattern b :< bs <- (uncons -> Just (b, bs)) where+	b :< bs = cons b bs++{-# COMPLETE (:>), Empty #-}++pattern (:>) :: ByteString -> Word8 -> ByteString+pattern bs :> b <- (unsnoc -> Just (bs, b)) where+	bs :> b = snoc bs b++{-# COMPLETE (:<||), EmptyT #-}++pattern (:<||) :: Sized a => a -> FingerTree a -> FingerTree a+pattern x :<|| xs <- (viewl -> x :<. xs) where +	x :<|| xs = x `consTree` xs++{-# COMPLETE (:||>), EmptyT #-}++pattern (:||>) :: Sized a => FingerTree a -> a -> FingerTree a+pattern xs :||> x <- (viewr -> xs :>. x) where+	xs :||> x = xs `snocTree` x++(><) :: ByteString -> ByteString -> ByteString+ByteString xs >< ByteString ys = ByteString $ xs `appendTree0` ys++data SearchResult a+	= Position !(FingerTree a) a !(FingerTree a)+	| OnLeft+	| OnRight+	| Nowhere+	deriving (Eq, Ord, Show, Generic)++search :: Sized a =>+	(Int -> Int -> Bool) -> FingerTree a -> SearchResult a+search p t+	| p_left && p_right = OnLeft+	| not p_left && p_right = case searchTree p 0 t 0 of+		Split l x r -> Position l x r+	| not p_left && not p_right = OnRight+	| otherwise = Nowhere+	where+	p_left = p 0 vt+	p_right = p vt 0+	vt = size t++data Split t a = Split !t a !t++searchTree :: Sized a =>+	(Int -> Int -> Bool) -> Int -> FingerTree a -> Int -> Split (FingerTree a) a+searchTree _ _ EmptyT _ = error "EmptyT"+searchTree _ _ (Single x) _ = Split EmptyT x EmptyT+searchTree p vl (Deep _ pr m sf) vr+	| p vlp vmsr = case searchDigit p vl pr vmsr of+		Split l x r -> Split (maybe EmptyT digitToTree l) x (deepL r m sf)+	| p vlpm vsr = case searchTree p vlp m vsr of+		Split ml xs mr -> case searchNode p (vlp + size ml) xs (size mr + vsr) of+			Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)+	| otherwise = case searchDigit p vlpm sf vr of+		Split l x r -> Split (deepR pr m l) x (maybe EmptyT digitToTree r)+	where+	vlp = vl + size pr+	vlpm = vlp + vm+	vmsr = vm + vsr+	vsr = size sf + vr+	vm = size m++searchNode :: Sized a =>+	(Int -> Int -> Bool) -> Int -> Node a -> Int -> Split (Maybe (Digit a)) a+searchNode p vl (Node2 _ a b) vr+	| p va vb = Split Nothing a (Just (One b))+	| otherwise = Split (Just (One a)) b Nothing+	where+	va = vl + size a+	vb = size b + vr+searchNode p vl (Node3 _ a b c) vr+	| p va vbc = Split Nothing a (Just (Two b c))+	| p vab vc = Split (Just (One a)) b (Just (One c))+	| otherwise = Split (Just (Two a b)) c Nothing+	where+	va = vl + size a+	vab = va + size b+	vc = size c + vr+	vbc = size b + vc++searchDigit :: Sized a =>+	(Int -> Int -> Bool) -> Int -> Digit a -> Int -> Split (Maybe (Digit a)) a+searchDigit _ vl (One a) vr = vl `seq` vr `seq` Split Nothing a Nothing+searchDigit p vl (Two a b) vr+	| p va vb = Split Nothing a (Just (One b))+	| otherwise = Split (Just (One a)) b Nothing+	where+	va = vl + size a+	vb = size b + vr+searchDigit p vl (Three a b c) vr+	| p va vbc = Split Nothing a (Just (Two b c))+	| p vab vc = Split (Just (One a)) b (Just (One c))+	| otherwise = Split (Just (Two a b)) c Nothing+	where+	va = vl + size a+	vab = va + size b+	vbc = size b + vc+	vc = size c + vr++searchDigit p vl (Four a b c d) vr+	| p va vbcd = Split Nothing a (Just (Three b c d))+	| p vab vcd = Split (Just (One a)) b (Just (Two c d))+	| p vabc vd = Split (Just (Two a b)) c (Just (One d))+	| otherwise = Split (Just (Three a b c)) d Nothing+	where+	va = vl + size a+	vab = va + size b+	vabc = vab + size c+	vbcd = size b + vcd+	vcd = size c + vd+	vd = size d + vr++data FingerTree a+	= EmptyT+	| Single a+	| Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)+	deriving (Show, Eq, Ord)++toList :: Sized a => FingerTree a -> [a]+toList EmptyT = []+toList (x :<|| xs) = x : toList xs++instance Sized a => Sized (FingerTree a) where+	{-# SPECIALIZE instance Sized (FingerTree BS.ByteString) #-}+	{-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}+	size EmptyT = 0+	size (Single x) = size x+	size (Deep v _ _ _) = v++{-# SPECIALIZE consTree :: BS.ByteString -> FingerTree BS.ByteString -> FingerTree BS.ByteString #-}+{-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}+consTree :: Sized a => a -> FingerTree a -> FingerTree a+consTree a EmptyT = Single a+consTree a (Single b) = deep (One a) EmptyT (One b)+consTree a (Deep s (Four b c d e) m sf) = m `seq`+	Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf+consTree a (Deep s (Three b c d) m sf) = Deep (size a + s) (Four a b c d) m sf+consTree a (Deep s (Two b c) m sf) = Deep (size a + s) (Three a b c) m sf+consTree a (Deep s (One b) m sf) = Deep (size a + s) (Two a b) m sf++{-# SPECIALIZE snocTree :: FingerTree BS.ByteString -> BS.ByteString -> FingerTree BS.ByteString #-}+{-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}+snocTree :: Sized a => FingerTree a -> a -> FingerTree a+snocTree EmptyT a = Single a+snocTree (Single a) b = deep (One a) EmptyT (One b)+snocTree (Deep s pr m (Four a b c d)) e = m `seq`+	Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)+snocTree (Deep s pr m (Three a b c)) d = Deep (s + size d) pr m (Four a b c d)+snocTree (Deep s pr m (Two a b)) c = Deep (s + size c) pr m (Three a b c)+snocTree (Deep s pr m (One a)) b = Deep (s + size b) pr m (Two a b)++data Digit a+	= One a+	| Two a a+	| Three a a a+	| Four a a a a+	deriving (Show, Eq, Ord)++foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b+foldDigit (<+>) f = \case+	One a -> f a+	Two a b -> f a <+> f b+	Three a b c -> f a <+> f b <+> f c+	Four a b c d -> f a <+> f b <+> f c <+> f d++instance Foldable Digit where+	foldMap = foldDigit mappend++	foldr f z = \case+		One a -> a `f` z+		Two a b -> a `f` (b `f` z)+		Three a b c -> a `f` (b `f` (c `f` z))+		Four a b c d -> a `f` (b `f` (c `f` (d `f` z)))+	{-# INLINE foldr #-}++	foldl f z = \case+		One a -> z `f` a+		Two a b -> (z `f` a) `f` b+		Three a b c -> ((z `f` a) `f` b) `f` c+		Four a b c d -> (((z `f` a) `f` b) `f` c) `f` d+	{-# INLINE foldl #-}++	foldr' f !z = \case+		One a -> f a z+		Two a b -> f a $! f b z+		Three a b c -> f a $! f b $! f c z+		Four a b c d -> f a $! f b $! f c $! f d z+	{-# INLINE foldr' #-}++	foldl' f !z = \case+		One a -> f z a+		Two a b -> (f $! f z a) b+		Three a b c -> (f $! (f $! f z a) b) c+		Four a b c d -> (f $! (f $! (f $! f z a) b) c) d+	{-# INLINE foldl' #-}++	foldr1 f = \case+		One a -> a+		Two a b -> a `f` b+		Three a b c -> a `f` (b `f` c)+		Four a b c d -> a `f` (b `f` (c `f` d))++	foldl1 f = \case+		One a -> a+		Two a b -> a `f` b+		Three a b c -> (a `f` b) `f` c+		Four a b c d -> ((a `f` b) `f` c) `f` d++instance Functor Digit where+	{-# INLINE fmap #-}+	fmap f = \case +		One a -> One $ f a+		Two a b -> Two (f a) (f b)+		Three a b c -> Three (f a) (f b) (f c)+		Four a b c d -> Four (f a) (f b) (f c) (f d)++instance Sized a => Sized (Digit a) where+	{-# INLINE size #-}+	size = foldl1 (+) . fmap size++data Node a+	= Node2 {-# UNPACK #-} !Int a a+	| Node3 {-# UNPACK #-} !Int a a a+	deriving (Show, Eq, Ord)++foldNode :: (b -> b -> b) -> (a -> b) -> Node a -> b+foldNode (<+>) f (Node2 _ a b) = f a <+> f b+foldNode (<+>) f (Node3 _ a b c) = f a <+> f b <+> f c++instance Foldable Node where+	foldMap = foldNode mappend++	foldr f z = \case+		Node2 _ a b -> a `f` (b `f` z)+		Node3 _ a b c -> a `f` (b `f` (c `f` z))+	{-# INLINE foldr #-}++	foldl f z = \case+		Node2 _ a b -> (z `f` a) `f` b+		Node3 _ a b c -> ((z `f` a) `f` b) `f` c+	{-# INLINE foldl #-}++	foldr' f !z = \case+		Node2 _ a b -> f a $! f b z+		Node3 _ a b c -> f a $! f b $! f c z+	{-# INLINE foldr' #-}++	foldl' f !z = \case+		Node2 _ a b -> (f $! f z a) b+		Node3 _ a b c -> (f $! (f $! f z a) b) c++instance Functor Node where+	{-# INLINE fmap #-}+	fmap f = \case+		Node2 v a b -> Node2 v (f a) (f b)+		Node3 v a b c -> Node3 v (f a) (f b) (f c)++instance Sized (Node a) where+	size = \case Node2 v _ _ -> v; Node3 v _ _ _ -> v++{-# INLINE node2 #-}+node2 :: Sized a => a -> a -> Node a+node2 a b = Node2 (size a + size b) a b++{-# INLINE node3 #-}+node3 :: Sized a => a -> a -> a -> Node a+node3 a b c = Node3 (size a + size b + size c) a b c++{-# INLINE deep #-}++deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a+deep pr m sf = Deep (size pr + size m + size sf) pr m sf++deepL :: Sized a =>+	Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a+deepL Nothing m sf = rotL m sf+deepL (Just pr) m sf = deep pr m sf++rotL :: Sized a => FingerTree (Node a) -> Digit a -> FingerTree a+rotL m sf = case viewl m of+	EmptyL -> digitToTree sf+	a :<. m' -> Deep (size m + size sf) (nodeToDigit a) m' sf++data ViewL s a = EmptyL | a :<. s a deriving (Eq, Ord, Show, Read, Generic)++viewl :: Sized a => FingerTree a -> ViewL FingerTree a+viewl EmptyT = EmptyL+viewl (Single x) = x :<. EmptyT+viewl (Deep _ (One x) m sf) = x :<. rotL m sf+viewl (Deep _ pr m sf) = lheadDigit pr :<. deep (ltailDigit pr) m sf++lheadDigit :: Digit a -> a+lheadDigit (One a) = a+lheadDigit (Two a _) = a+lheadDigit (Three a _ _) = a+lheadDigit (Four a _ _ _) = a++ltailDigit :: Digit a -> Digit a+ltailDigit (One _) = error "bad"+ltailDigit (Two _ b) = One b+ltailDigit (Three _ b c) = Two b c+ltailDigit (Four _ b c d) = Three b c d++deepR :: Sized a =>+	Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a+deepR pr m Nothing = rotR pr m+deepR pr m (Just sf) = deep pr m sf++rotR :: Sized a => Digit a -> FingerTree (Node a) -> FingerTree a+rotR pr m = case viewr m of+	EmptyR -> digitToTree pr+	m' :>. a -> Deep (size pr + size m) pr m' (nodeToDigit a)++data ViewR s a = EmptyR | s a :>. a deriving (Eq, Ord, Show, Read, Generic)++viewr :: Sized a => FingerTree a -> ViewR FingerTree a+viewr EmptyT = EmptyR+viewr (Single x) = EmptyT :>. x+viewr (Deep _ pr m (One x)) = rotR pr m :>. x+viewr (Deep _ pr m sf) = deep pr m (rtailDigit sf) :>. rheadDigit sf++rheadDigit :: Digit a -> a+rheadDigit (One a) = a+rheadDigit (Two _ b) = b+rheadDigit (Three _ _ c) = c+rheadDigit (Four _ _ _ d) = d++rtailDigit :: Digit a -> Digit a+rtailDigit (One _) = error "bad"+rtailDigit (Two a _) = One a+rtailDigit (Three a b _) = Two a b+rtailDigit (Four a b c _) = Three a b c++nodeToDigit :: Node a -> Digit a+nodeToDigit (Node2 _ a b) = Two a b+nodeToDigit (Node3 _ a b c) = Three a b c++digitToTree :: Sized a => Digit a -> FingerTree a+digitToTree (One a) = Single a+digitToTree (Two a b) = deep (One a) EmptyT (One b)+digitToTree (Three a b c) = deep (Two a b) EmptyT (One c)+digitToTree (Four a b c d) = deep (Two a b) EmptyT (Two c d)++class Sized a where size :: a -> Int++instance Sized BS.ByteString where size = BS.length++-- The appendTree/addDigits gunk below was originally machine generated via mkappend.hs+-- but has since been manually edited to include strictness annotations.++appendTree0 :: FingerTree (BS.ByteString) -> FingerTree (BS.ByteString) -> FingerTree (BS.ByteString)+appendTree0 EmptyT xs =+     xs+appendTree0 xs EmptyT =+     xs+appendTree0 (Single x) xs =+     x `consTree` xs+appendTree0 xs (Single x) =+     xs `snocTree` x+appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =+     Deep (s1 + s2) pr1 m sf2+     where !m = addDigits0 m1 sf1 pr2 m2++addDigits0 :: FingerTree (Node (BS.ByteString)) -> Digit (BS.ByteString) -> Digit (BS.ByteString) -> FingerTree (Node (BS.ByteString)) -> FingerTree (Node (BS.ByteString))+addDigits0 m1 (One a) (One b) m2 =+    appendTree1 m1 (node2 a b) m2+addDigits0 m1 (One a) (Two b c) m2 =+    appendTree1 m1 (node3 a b c) m2+addDigits0 m1 (One a) (Three b c d) m2 =+    appendTree2 m1 (node2 a b) (node2 c d) m2+addDigits0 m1 (One a) (Four b c d e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits0 m1 (Two a b) (One c) m2 =+    appendTree1 m1 (node3 a b c) m2+addDigits0 m1 (Two a b) (Two c d) m2 =+    appendTree2 m1 (node2 a b) (node2 c d) m2+addDigits0 m1 (Two a b) (Three c d e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits0 m1 (Two a b) (Four c d e f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits0 m1 (Three a b c) (One d) m2 =+    appendTree2 m1 (node2 a b) (node2 c d) m2+addDigits0 m1 (Three a b c) (Two d e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits0 m1 (Three a b c) (Three d e f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits0 m1 (Three a b c) (Four d e f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits0 m1 (Four a b c d) (One e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits0 m1 (Four a b c d) (Two e f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits0 m1 (Four a b c d) (Three e f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits0 m1 (Four a b c d) (Four e f g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2++appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)+appendTree1 EmptyT !a xs =+     a `consTree` xs+appendTree1 xs !a EmptyT =+     xs `snocTree` a+appendTree1 (Single x) !a xs =+     x `consTree` a `consTree` xs+appendTree1 xs !a (Single x) =+     xs `snocTree` a `snocTree` x+appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =+     Deep (s1 + size a + s2) pr1 m sf2+     where !m = addDigits1 m1 sf1 a pr2 m2++addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))+addDigits1 m1 (One a) b (One c) m2 =+    appendTree1 m1 (node3 a b c) m2+addDigits1 m1 (One a) b (Two c d) m2 =+    appendTree2 m1 (node2 a b) (node2 c d) m2+addDigits1 m1 (One a) b (Three c d e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits1 m1 (One a) b (Four c d e f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits1 m1 (Two a b) c (One d) m2 =+    appendTree2 m1 (node2 a b) (node2 c d) m2+addDigits1 m1 (Two a b) c (Two d e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits1 m1 (Two a b) c (Three d e f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits1 m1 (Two a b) c (Four d e f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits1 m1 (Three a b c) d (One e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits1 m1 (Three a b c) d (Two e f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits1 m1 (Three a b c) d (Three e f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits1 m1 (Three a b c) d (Four e f g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits1 m1 (Four a b c d) e (One f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits1 m1 (Four a b c d) e (Two f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits1 m1 (Four a b c d) e (Three f g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2++appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)+appendTree2 EmptyT !a !b xs =+     a `consTree` b `consTree` xs+appendTree2 xs !a !b EmptyT =+     xs `snocTree` a `snocTree` b+appendTree2 (Single x) a b xs =+     x `consTree` a `consTree` b `consTree` xs+appendTree2 xs a b (Single x) =+     xs `snocTree` a `snocTree` b `snocTree` x+appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =+     Deep (s1 + size a + size b + s2) pr1 m sf2+     where !m = addDigits2 m1 sf1 a b pr2 m2++addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))+addDigits2 m1 (One a) b c (One d) m2 =+    appendTree2 m1 (node2 a b) (node2 c d) m2+addDigits2 m1 (One a) b c (Two d e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits2 m1 (One a) b c (Three d e f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits2 m1 (One a) b c (Four d e f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits2 m1 (Two a b) c d (One e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits2 m1 (Two a b) c d (Two e f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits2 m1 (Two a b) c d (Three e f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits2 m1 (Two a b) c d (Four e f g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits2 m1 (Three a b c) d e (One f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits2 m1 (Three a b c) d e (Two f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits2 m1 (Three a b c) d e (Three f g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+addDigits2 m1 (Four a b c d) e f (One g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits2 m1 (Four a b c d) e f (Two g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2++appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)+appendTree3 EmptyT !a !b !c xs =+     a `consTree` b `consTree` c `consTree` xs+appendTree3 xs !a !b !c EmptyT =+     xs `snocTree` a `snocTree` b `snocTree` c+appendTree3 (Single x) a b c xs =+     x `consTree` a `consTree` b `consTree` c `consTree` xs+appendTree3 xs a b c (Single x) =+     xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x+appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =+     Deep (s1 + size a + size b + size c + s2) pr1 m sf2+     where !m = addDigits3 m1 sf1 a b c pr2 m2++addDigits3 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))+addDigits3 m1 (One a) b c d (One e) m2 =+    appendTree2 m1 (node3 a b c) (node2 d e) m2+addDigits3 m1 (One a) b c d (Two e f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits3 m1 (One a) b c d (Three e f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits3 m1 (One a) b c d (Four e f g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits3 m1 (Two a b) c d e (One f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits3 m1 (Two a b) c d e (Two f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits3 m1 (Two a b) c d e (Three f g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+addDigits3 m1 (Three a b c) d e f (One g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits3 m1 (Three a b c) d e f (Two g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+addDigits3 m1 (Four a b c d) e f g (One h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2++appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)+appendTree4 EmptyT !a !b !c !d xs =+     a `consTree` b `consTree` c `consTree` d `consTree` xs+appendTree4 xs !a !b !c !d EmptyT =+     xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d+appendTree4 (Single x) a b c d xs =+     x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs+appendTree4 xs a b c d (Single x) =+     xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x+appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =+     Deep (s1 + size a + size b + size c + size d + s2) pr1 m sf2+     where !m = addDigits4 m1 sf1 a b c d pr2 m2++addDigits4 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))+addDigits4 m1 (One a) b c d e (One f) m2 =+    appendTree2 m1 (node3 a b c) (node3 d e f) m2+addDigits4 m1 (One a) b c d e (Two f g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits4 m1 (One a) b c d e (Three f g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits4 m1 (One a) b c d e (Four f g h i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+addDigits4 m1 (Two a b) c d e f (One g) m2 =+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+addDigits4 m1 (Two a b) c d e f (Two g h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+addDigits4 m1 (Three a b c) d e f g (One h) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2+addDigits4 m1 (Four a b c d) e f g h (One i) m2 =+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2+addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =+    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2++type instance Element ByteString = Word8++instance MonoFunctor ByteString where+	omap f = \case+		Empty -> Empty+		bs :<| bss -> (f `BS.map` bs) :<| (f `omap` bss)++instance MonoFoldable ByteString where+	ofoldMap c = \case+		Empty -> mempty+		b :< bs -> c b `mappend` (c `ofoldMap` bs)+	ofoldr op v = \case+		Empty -> v+		b :< bs -> b `op` ofoldr op v bs+	ofoldl' op !v = \case+		Empty -> v+		b :< bs -> ofoldl' op (v `op` b) bs+	ofoldr1Ex op = \case+		Empty -> error "bad"+		b :< Empty -> b+		b :< bs -> b `op` ofoldr1Ex op bs+	ofoldl1Ex' op = \case+		Empty -> error "bad"+		b :< bs -> ofoldl' op b bs++instance MonoTraversable ByteString where+	otraverse f = \case+		Empty -> pure Empty+		b :< bs -> (:<) <$> f b <*> f `otraverse` bs

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"