module Data.Rope.Unpackable
( Unpackable(..)
) where
import Prelude hiding (head, last, drop)
import qualified Prelude
import Data.Word (Word8)
import Data.Monoid (Monoid, mempty, mappend)
import qualified Data.Foldable as F
import qualified Data.FingerTree as F (empty, null, split)
import Data.FingerTree (FingerTree, ViewL(..),ViewR(..),viewl,viewr,(<|),(><))
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as S (unsafeTail, unsafeHead)
import qualified Data.ByteString.UTF8 as U
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.UTF8 as LU
import Data.Rope.Body (Count(..), Chunk(..), cons', snoc', measureBody)
import Data.Rope.Internal (Annotation(..), drop, Rope(..), body, toLazyByteString, uncons8, unsnoc8)
import Codec.Binary.UTF8.Generic (UTF8Bytes)
import qualified Codec.Binary.UTF8.Generic as UTF8Bytes
class Unpackable a where
unpack :: Rope m -> [a]
head :: Rope m -> a
head = Prelude.head . unpack
last :: Rope m -> a
uncons :: Annotation m => Rope m -> Maybe (a, Rope m)
unsnoc :: Annotation m => Rope m -> Maybe (Rope m, a)
newtype F = F { runF :: FingerTree Count Chunk }
instance Monoid F where
mempty = F F.empty
F a `mappend` F b = F (a >< b)
instance UTF8Bytes F Int where
bsplit 0 (F f) = (mempty, F f)
bsplit n (F f)
| n >= measureBody f = (F f, mempty)
| otherwise = (F (x `snoc'` y'), F (y'' `cons'` z))
where
(x, yz) = F.split (> Count n) f
Chunk y :< z = viewl yz
(y', y'') = S.splitAt (n measureBody x) y
bdrop n = snd . UTF8Bytes.bsplit n
buncons f = case viewl (runF f) of
Chunk c :< cs -> Just (S.unsafeHead c, F (S.unsafeTail c `cons' ` cs))
EmptyL -> Nothing
tail (F f) = case viewl f of
Chunk c :< cs -> F (S.unsafeTail c `cons'`cs)
EmptyL -> errorEmptyList "tail"
elemIndex b = fmap fromIntegral . L.elemIndex b . L.fromChunks . map unchunk . F.toList . runF
pack = F . foldr (\l r -> Chunk l <| r) F.empty . L.toChunks . L.pack
empty = F F.empty
null = F.null . runF
instance Unpackable Word8 where
unpack = concatMap (S.unpack . unchunk) . F.toList . body
head (Rope t _) = case viewl t of
Chunk a :< _ -> S.head a
EmptyL -> errorEmptyList "head"
last (Rope t _) = case viewr t of
_ :> Chunk a -> S.last a
EmptyR -> errorEmptyList "last"
uncons = uncons8
unsnoc = unsnoc8
instance Unpackable Char where
unpack = LU.toString . toLazyByteString
head = Prelude.head . unpack
last = undefined
uncons r@(Rope t _) = case UTF8Bytes.decode (F t) of
Nothing -> Nothing
Just (a,n) -> Just (a, drop n r)
unsnoc = undefined
instance Unpackable S.ByteString where
unpack = map unchunk . F.toList . body
head r = case viewl (body r) of
Chunk a :< _ -> a
_ -> errorEmptyList "head"
last r = case viewr (body r) of
_ :> Chunk a -> a
_ -> errorEmptyList "last"
uncons r = case viewl (body r) of
Chunk a :< as -> Just (a, Rope as (drop' (S.length a) r))
EmptyL -> Nothing
unsnoc r = case viewr (body r) of
as :> Chunk a -> Just (Rope as (take' (measureBody as) r), a)
EmptyR -> Nothing
instance Unpackable Chunk where
unpack = F.toList . body
head r = case viewl (body r) of
a :< _ -> a
_ -> errorEmptyList "head"
last r = case viewr (body r) of
_ :> a -> a
_ -> errorEmptyList "last"
uncons r = case viewl (body r) of
Chunk a :< as -> Just (Chunk a, Rope as (drop' (S.length a) r))
EmptyL -> Nothing
unsnoc r = case viewr (body r) of
as :> Chunk a -> Just (Rope as (take' (measureBody as) r), Chunk a)
EmptyR -> Nothing
errorEmptyList :: String -> a
errorEmptyList t = error $ "Kata.Rope.Unpackable." ++ t ++ ": empty list"