{-# language BangPatterns #-}
{-# language CPP #-}
{-# language DeriveDataTypeable #-}
{-# language DeriveGeneric #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language TypeFamilies #-}
module Text.Trifecta.Rope
( Rope(..)
, rope
, ropeBS
, Strand(..)
, strand
, strands
, grabRest
, grabLine
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.UTF8 as UTF8
import Data.Data
import Data.FingerTree as FingerTree
import Data.Foldable (toList)
import Data.Hashable
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Data.Semigroup.Reducer
import GHC.Generics
import Text.Trifecta.Delta
import Text.Trifecta.Util.Combinators as Util
data Strand
= Strand {-# UNPACK #-} !ByteString !Delta
| Skipping !Delta
deriving (Strand -> Strand -> Bool
(Strand -> Strand -> Bool)
-> (Strand -> Strand -> Bool) -> Eq Strand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Strand -> Strand -> Bool
$c/= :: Strand -> Strand -> Bool
== :: Strand -> Strand -> Bool
$c== :: Strand -> Strand -> Bool
Eq, Int -> Strand -> ShowS
[Strand] -> ShowS
Strand -> String
(Int -> Strand -> ShowS)
-> (Strand -> String) -> ([Strand] -> ShowS) -> Show Strand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strand] -> ShowS
$cshowList :: [Strand] -> ShowS
show :: Strand -> String
$cshow :: Strand -> String
showsPrec :: Int -> Strand -> ShowS
$cshowsPrec :: Int -> Strand -> ShowS
Show, Typeable Strand
DataType
Constr
Typeable Strand
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strand -> c Strand)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strand)
-> (Strand -> Constr)
-> (Strand -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strand))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strand))
-> ((forall b. Data b => b -> b) -> Strand -> Strand)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strand -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strand -> r)
-> (forall u. (forall d. Data d => d -> u) -> Strand -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Strand -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strand -> m Strand)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strand -> m Strand)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strand -> m Strand)
-> Data Strand
Strand -> DataType
Strand -> Constr
(forall b. Data b => b -> b) -> Strand -> Strand
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strand -> c Strand
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strand
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Strand -> u
forall u. (forall d. Data d => d -> u) -> Strand -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Strand -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Strand -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strand -> m Strand
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strand -> m Strand
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strand
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strand -> c Strand
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strand)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strand)
$cSkipping :: Constr
$cStrand :: Constr
$tStrand :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Strand -> m Strand
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strand -> m Strand
gmapMp :: (forall d. Data d => d -> m d) -> Strand -> m Strand
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strand -> m Strand
gmapM :: (forall d. Data d => d -> m d) -> Strand -> m Strand
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strand -> m Strand
gmapQi :: Int -> (forall d. Data d => d -> u) -> Strand -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Strand -> u
gmapQ :: (forall d. Data d => d -> u) -> Strand -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Strand -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Strand -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Strand -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Strand -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Strand -> r
gmapT :: (forall b. Data b => b -> b) -> Strand -> Strand
$cgmapT :: (forall b. Data b => b -> b) -> Strand -> Strand
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strand)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strand)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Strand)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strand)
dataTypeOf :: Strand -> DataType
$cdataTypeOf :: Strand -> DataType
toConstr :: Strand -> Constr
$ctoConstr :: Strand -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strand
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strand
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strand -> c Strand
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strand -> c Strand
$cp1Data :: Typeable Strand
Data, (forall x. Strand -> Rep Strand x)
-> (forall x. Rep Strand x -> Strand) -> Generic Strand
forall x. Rep Strand x -> Strand
forall x. Strand -> Rep Strand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Strand x -> Strand
$cfrom :: forall x. Strand -> Rep Strand x
Generic)
strand :: ByteString -> Strand
strand :: ByteString -> Strand
strand ByteString
bs = ByteString -> Delta -> Strand
Strand ByteString
bs (ByteString -> Delta
forall t. HasDelta t => t -> Delta
delta ByteString
bs)
instance Measured Delta Strand where
measure :: Strand -> Delta
measure (Strand ByteString
_ Delta
s) = Delta -> Delta
forall t. HasDelta t => t -> Delta
delta Delta
s
measure (Skipping Delta
d) = Delta
d
instance Hashable Strand
instance HasDelta Strand where
delta :: Strand -> Delta
delta = Strand -> Delta
forall v a. Measured v a => a -> v
measure
instance HasBytes Strand where
bytes :: Strand -> Int64
bytes (Strand ByteString
_ Delta
d) = Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes Delta
d
bytes Strand
_ = Int64
0
data Rope = Rope !Delta !(FingerTree Delta Strand) deriving Int -> Rope -> ShowS
[Rope] -> ShowS
Rope -> String
(Int -> Rope -> ShowS)
-> (Rope -> String) -> ([Rope] -> ShowS) -> Show Rope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rope] -> ShowS
$cshowList :: [Rope] -> ShowS
show :: Rope -> String
$cshow :: Rope -> String
showsPrec :: Int -> Rope -> ShowS
$cshowsPrec :: Int -> Rope -> ShowS
Show
rope :: FingerTree Delta Strand -> Rope
rope :: FingerTree Delta Strand -> Rope
rope FingerTree Delta Strand
r = Delta -> FingerTree Delta Strand -> Rope
Rope (FingerTree Delta Strand -> Delta
forall v a. Measured v a => a -> v
measure FingerTree Delta Strand
r) FingerTree Delta Strand
r
ropeBS :: ByteString -> Rope
ropeBS :: ByteString -> Rope
ropeBS = FingerTree Delta Strand -> Rope
rope (FingerTree Delta Strand -> Rope)
-> (ByteString -> FingerTree Delta Strand) -> ByteString -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Strand -> FingerTree Delta Strand
forall v a. Measured v a => a -> FingerTree v a
singleton (Strand -> FingerTree Delta Strand)
-> (ByteString -> Strand) -> ByteString -> FingerTree Delta Strand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand
strands :: Rope -> FingerTree Delta Strand
strands :: Rope -> FingerTree Delta Strand
strands (Rope Delta
_ FingerTree Delta Strand
r) = FingerTree Delta Strand
r
grabRest
:: Delta
-> Rope
-> r
-> (Delta -> Lazy.ByteString -> r)
-> r
grabRest :: Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
grabRest Delta
offset Rope
input r
failure Delta -> ByteString -> r
success = Delta -> Int64 -> [Strand] -> r
trim (FingerTree Delta Strand -> Delta
forall t. HasDelta t => t -> Delta
delta FingerTree Delta Strand
l) (Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes Delta
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- FingerTree Delta Strand -> Int64
forall t. HasBytes t => t -> Int64
bytes FingerTree Delta Strand
l) (FingerTree Delta Strand -> [Strand]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FingerTree Delta Strand
r) where
trim :: Delta -> Int64 -> [Strand] -> r
trim Delta
offset' Int64
0 (Strand ByteString
str Delta
_ : [Strand]
xs) = Delta -> ByteString -> [Strand] -> r
go Delta
offset' ByteString
str [Strand]
xs
trim Delta
_ Int64
k (Strand ByteString
str Delta
_ : [Strand]
xs) = Delta -> ByteString -> [Strand] -> r
go Delta
offset (Int -> ByteString -> ByteString
Strict.drop (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
k) ByteString
str) [Strand]
xs
trim Delta
offset' Int64
k (Skipping Delta
p : [Strand]
xs) = Delta -> Int64 -> [Strand] -> r
trim (Delta
offset' Delta -> Delta -> Delta
forall a. Semigroup a => a -> a -> a
<> Delta
p) Int64
k [Strand]
xs
trim Delta
_ Int64
_ [] = r
failure
go :: Delta -> ByteString -> [Strand] -> r
go Delta
offset' ByteString
str [Strand]
strands'
= Delta -> ByteString -> r
success Delta
offset' ([ByteString] -> ByteString
Lazy.fromChunks (ByteString
str ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ ByteString
a | Strand ByteString
a Delta
_ <- [Strand]
strands' ]))
(FingerTree Delta Strand
l, FingerTree Delta Strand
r) = Delta -> Rope -> (FingerTree Delta Strand, FingerTree Delta Strand)
splitRopeAt Delta
offset Rope
input
splitRopeAt :: Delta -> Rope -> (FingerTree Delta Strand, FingerTree Delta Strand)
splitRopeAt :: Delta -> Rope -> (FingerTree Delta Strand, FingerTree Delta Strand)
splitRopeAt Delta
splitPos = (Delta -> Bool)
-> FingerTree Delta Strand
-> (FingerTree Delta Strand, FingerTree Delta Strand)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FingerTree.split (\Delta
pos -> Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes Delta
pos Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes Delta
splitPos) (FingerTree Delta Strand
-> (FingerTree Delta Strand, FingerTree Delta Strand))
-> (Rope -> FingerTree Delta Strand)
-> Rope
-> (FingerTree Delta Strand, FingerTree Delta Strand)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Delta Strand
strands
grabLine
:: Delta
-> Rope
-> r
-> (Delta -> Strict.ByteString -> r)
-> r
grabLine :: Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
grabLine Delta
offset Rope
input r
failure Delta -> ByteString -> r
success
= Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
forall r. Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
grabRest Delta
offset Rope
input r
failure (\Delta
d -> Delta -> ByteString -> r
success Delta
d (ByteString -> r) -> (ByteString -> ByteString) -> ByteString -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Util.fromLazy (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Util.takeLine)
instance HasBytes Rope where
bytes :: Rope -> Int64
bytes = Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes (Delta -> Int64) -> (Rope -> Delta) -> Rope -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Delta
forall v a. Measured v a => a -> v
measure
instance HasDelta Rope where
delta :: Rope -> Delta
delta = Rope -> Delta
forall v a. Measured v a => a -> v
measure
instance Measured Delta Rope where
measure :: Rope -> Delta
measure (Rope Delta
s FingerTree Delta Strand
_) = Delta
s
instance Monoid Rope where
mempty :: Rope
mempty = Delta -> FingerTree Delta Strand -> Rope
Rope Delta
forall a. Monoid a => a
mempty FingerTree Delta Strand
forall a. Monoid a => a
mempty
mappend :: Rope -> Rope -> Rope
mappend = Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup Rope where
Rope Delta
mx FingerTree Delta Strand
x <> :: Rope -> Rope -> Rope
<> Rope Delta
my FingerTree Delta Strand
y = Delta -> FingerTree Delta Strand -> Rope
Rope (Delta
mx Delta -> Delta -> Delta
forall a. Semigroup a => a -> a -> a
<> Delta
my) (FingerTree Delta Strand
x FingerTree Delta Strand
-> FingerTree Delta Strand -> FingerTree Delta Strand
forall a. Monoid a => a -> a -> a
`mappend` FingerTree Delta Strand
y)
instance Reducer Rope Rope where
unit :: Rope -> Rope
unit = Rope -> Rope
forall a. a -> a
id
instance Reducer Strand Rope where
unit :: Strand -> Rope
unit Strand
s = FingerTree Delta Strand -> Rope
rope (Strand -> FingerTree Delta Strand
forall v a. Measured v a => a -> FingerTree v a
FingerTree.singleton Strand
s)
cons :: Strand -> Rope -> Rope
cons Strand
s (Rope Delta
mt FingerTree Delta Strand
t) = Delta -> FingerTree Delta Strand -> Rope
Rope (Strand -> Delta
forall t. HasDelta t => t -> Delta
delta Strand
s Delta -> Delta -> Delta
forall a. Monoid a => a -> a -> a
`mappend` Delta
mt) (Strand
s Strand -> FingerTree Delta Strand -> FingerTree Delta Strand
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree Delta Strand
t)
snoc :: Rope -> Strand -> Rope
snoc (Rope Delta
mt FingerTree Delta Strand
t) !Strand
s = Delta -> FingerTree Delta Strand -> Rope
Rope (Delta
mt Delta -> Delta -> Delta
forall a. Monoid a => a -> a -> a
`mappend` Strand -> Delta
forall t. HasDelta t => t -> Delta
delta Strand
s) (FingerTree Delta Strand
t FingerTree Delta Strand -> Strand -> FingerTree Delta Strand
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> Strand
s)
instance Reducer Strict.ByteString Rope where
unit :: ByteString -> Rope
unit = Strand -> Rope
forall c m. Reducer c m => c -> m
unit (Strand -> Rope) -> (ByteString -> Strand) -> ByteString -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand
cons :: ByteString -> Rope -> Rope
cons = Strand -> Rope -> Rope
forall c m. Reducer c m => c -> m -> m
cons (Strand -> Rope -> Rope)
-> (ByteString -> Strand) -> ByteString -> Rope -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand
snoc :: Rope -> ByteString -> Rope
snoc Rope
r = Rope -> Strand -> Rope
forall c m. Reducer c m => m -> c -> m
snoc Rope
r (Strand -> Rope) -> (ByteString -> Strand) -> ByteString -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand
instance Reducer [Char] Rope where
unit :: String -> Rope
unit = Strand -> Rope
forall c m. Reducer c m => c -> m
unit (Strand -> Rope) -> (String -> Strand) -> String -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand (ByteString -> Strand)
-> (String -> ByteString) -> String -> Strand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString
cons :: String -> Rope -> Rope
cons = Strand -> Rope -> Rope
forall c m. Reducer c m => c -> m -> m
cons (Strand -> Rope -> Rope)
-> (String -> Strand) -> String -> Rope -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand (ByteString -> Strand)
-> (String -> ByteString) -> String -> Strand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString
snoc :: Rope -> String -> Rope
snoc Rope
r = Rope -> Strand -> Rope
forall c m. Reducer c m => m -> c -> m
snoc Rope
r (Strand -> Rope) -> (String -> Strand) -> String -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand (ByteString -> Strand)
-> (String -> ByteString) -> String -> Strand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString