{-# language BangPatterns          #-}
{-# language CPP                   #-}
{-# language DeriveDataTypeable    #-}
{-# language DeriveGeneric         #-}
{-# language FlexibleInstances     #-}
{-# language MultiParamTypeClasses #-}
{-# language TypeFamilies          #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2011-2019 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- A rope is a data strucure to efficiently store and manipulate long strings.
-- Wikipedia provides a nice overview:
-- <https://en.wikipedia.org/wiki/Rope_(data_structure)>
----------------------------------------------------------------------------
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

-- $setup
--
-- >>> :set -XOverloadedStrings
-- >>> import Data.Monoid ((<>))
-- >>> import Data.ByteString (ByteString)
-- >>> import qualified Data.ByteString.UTF8 as Strict
-- >>> import qualified Data.ByteString.Lazy.UTF8 as Lazy
-- >>> import Text.Trifecta.Delta

-- A 'Strand' is a chunk of data; many 'Strand's together make a 'Rope'.
data Strand
  = Strand {-# UNPACK #-} !ByteString !Delta -- ^ Data of a certain length
  | Skipping !Delta                          -- ^ Absence of data of a certain length
  deriving (Strand -> Strand -> Bool
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
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
Strand -> DataType
Strand -> Constr
(forall b. Data b => b -> b) -> Strand -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Strand -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Strand -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Strand -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Strand -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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)

-- | Construct a single 'Strand' out of a 'ByteString'.
strand :: ByteString -> Strand
strand :: ByteString -> Strand
strand ByteString
bs = ByteString -> Delta -> Strand
Strand ByteString
bs (forall t. HasDelta t => t -> Delta
delta ByteString
bs)

instance Measured Delta Strand where
  measure :: Strand -> Delta
measure (Strand ByteString
_ Delta
s) = 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 = forall v a. Measured v a => a -> v
measure

instance HasBytes Strand where
  bytes :: Strand -> Int64
bytes (Strand ByteString
_ Delta
d) = 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
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 (forall v a. Measured v a => a -> v
measure FingerTree Delta Strand
r) FingerTree Delta Strand
r

-- | Construct a 'Rope' out of a single 'ByteString' strand.
ropeBS :: ByteString -> Rope
ropeBS :: ByteString -> Rope
ropeBS = FingerTree Delta Strand -> Rope
rope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. Measured v a => a -> FingerTree v a
singleton 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

-- | Grab the entire rest of the input 'Rope', starting at an initial offset, or
-- return a default if we’re already at or beyond the end. Also see 'grabLine'.
--
-- Extract a suffix of a certain length from the input:
--
-- >>> grabRest (delta ("Hello " :: ByteString)) (ropeBS "Hello World\nLorem") Nothing (\x y -> Just (x, Lazy.toString y))
-- Just (Columns 6 6,"World\nLorem")
--
-- Same deal, but over multiple strands:
--
-- >>> grabRest (delta ("Hel" :: ByteString)) (ropeBS "Hello" <> ropeBS "World") Nothing (\x y -> Just (x, Lazy.toString y))
-- Just (Columns 3 3,"loWorld")
--
-- When the offset is too long, fall back to a default:
--
-- >>> grabRest (delta ("OffetTooLong" :: ByteString)) (ropeBS "Hello") Nothing (\x y -> Just (x, Lazy.toString y))
-- Nothing
grabRest
    :: Delta -- ^ Initial offset
    -> Rope  -- ^ Input
    -> r     -- ^ Default value if there is no input left
    -> (Delta -> Lazy.ByteString -> r)
        -- ^ If there is some input left, create an @r@ out of the data from the
        -- initial offset until the end
    -> r
grabRest :: forall r. Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
grabRest Delta
offset Rope
input r
failure Delta -> ByteString -> r
success = Delta -> Int64 -> [Strand] -> r
trim (forall t. HasDelta t => t -> Delta
delta FingerTree Delta Strand
l) (forall t. HasBytes t => t -> Int64
bytes Delta
offset forall a. Num a => a -> a -> a
- forall t. HasBytes t => t -> Int64
bytes FingerTree Delta Strand
l) (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 (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' 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 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

-- | Split the rope in two halves, given a 'Delta' offset from the beginning.
splitRopeAt :: Delta -> Rope -> (FingerTree Delta Strand, FingerTree Delta Strand)
splitRopeAt :: Delta -> Rope -> (FingerTree Delta Strand, FingerTree Delta Strand)
splitRopeAt Delta
splitPos = forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FingerTree.split (\Delta
pos -> forall t. HasBytes t => t -> Int64
bytes Delta
pos forall a. Ord a => a -> a -> Bool
> forall t. HasBytes t => t -> Int64
bytes Delta
splitPos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Delta Strand
strands

-- | Grab the rest of the line at a certain offset in the input 'Rope', or
-- return a default if there is no newline left in the input. Also see
-- 'grabRest'.
--
-- >>> grabLine (delta ("Hello " :: ByteString)) (ropeBS "Hello" <> ropeBS " World\nLorem") Nothing (\x y -> Just (x, Strict.toString y))
-- Just (Columns 6 6,"World\n")
grabLine
    :: Delta -- ^ Initial offset
    -> Rope  -- ^ Input
    -> r     -- ^ Default value if there is no input left
    -> (Delta -> Strict.ByteString -> r)
        -- ^ If there is some input left, create an @r@ out of the data from the
        -- initial offset until the end of the line
    -> r
grabLine :: forall r. Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
grabLine Delta
offset Rope
input r
failure Delta -> ByteString -> r
success
  = forall r. Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
grabRest Delta
offset Rope
input r
failure (\Delta
d -> Delta -> ByteString -> r
success Delta
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Util.fromLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Util.takeLine)

instance HasBytes Rope where
  bytes :: Rope -> Int64
bytes = forall t. HasBytes t => t -> Int64
bytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. Measured v a => a -> v
measure

instance HasDelta Rope where
  delta :: Rope -> Delta
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 forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
  mappend :: Rope -> Rope -> Rope
mappend = 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 forall a. Semigroup a => a -> a -> a
<> Delta
my) (FingerTree Delta Strand
x forall a. Monoid a => a -> a -> a
`mappend` FingerTree Delta Strand
y)

instance Reducer Rope Rope where
  unit :: Rope -> Rope
unit = forall a. a -> a
id

instance Reducer Strand Rope where
  unit :: Strand -> Rope
unit Strand
s = FingerTree Delta Strand -> Rope
rope (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 (forall t. HasDelta t => t -> Delta
delta Strand
s forall a. Monoid a => a -> a -> a
`mappend` Delta
mt) (Strand
s 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 forall a. Monoid a => a -> a -> a
`mappend` forall t. HasDelta t => t -> Delta
delta Strand
s) (FingerTree Delta Strand
t 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 = forall c m. Reducer c m => c -> m
unit forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand
  cons :: ByteString -> Rope -> Rope
cons = forall c m. Reducer c m => c -> m -> m
cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand
  snoc :: Rope -> ByteString -> Rope
snoc Rope
r = forall c m. Reducer c m => m -> c -> m
snoc Rope
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand

instance Reducer [Char] Rope where
  unit :: String -> Rope
unit = forall c m. Reducer c m => c -> m
unit forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString
  cons :: String -> Rope -> Rope
cons = forall c m. Reducer c m => c -> m -> m
cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString
  snoc :: Rope -> String -> Rope
snoc Rope
r = forall c m. Reducer c m => m -> c -> m
snoc Rope
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Strand
strand forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString