{-# language CPP #-}
{-# language DeriveDataTypeable #-}
{-# language DeriveGeneric #-}
module Text.Trifecta.Delta
( Delta(..)
, HasDelta(..)
, HasBytes(..)
, prettyDelta
, nextTab
, rewind
, near
, column
, columnByte
) where
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Data.Hashable
import Data.Int
import Data.Data
import Data.Word
import Data.Function (on)
import Data.FingerTree hiding (empty)
import Data.ByteString as Strict hiding (empty)
import qualified Data.ByteString.UTF8 as UTF8
import GHC.Generics
import Prettyprinter hiding (column, line')
import Text.Trifecta.Util.Pretty
class HasBytes t where
bytes :: t -> Int64
instance HasBytes ByteString where
bytes :: ByteString -> Int64
bytes = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
Strict.length
instance (Measured v a, HasBytes v) => HasBytes (FingerTree v a) where
bytes :: FingerTree v a -> 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
data Delta
= Columns {-# UNPACK #-} !Int64
{-# UNPACK #-} !Int64
| Tab {-# UNPACK #-} !Int64
{-# UNPACK #-} !Int64
{-# UNPACK #-} !Int64
| Lines {-# UNPACK #-} !Int64
{-# UNPACK #-} !Int64
{-# UNPACK #-} !Int64
{-# UNPACK #-} !Int64
| Directed !ByteString
{-# UNPACK #-} !Int64
{-# UNPACK #-} !Int64
{-# UNPACK #-} !Int64
{-# UNPACK #-} !Int64
deriving (Int -> Delta -> ShowS
[Delta] -> ShowS
Delta -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delta] -> ShowS
$cshowList :: [Delta] -> ShowS
show :: Delta -> String
$cshow :: Delta -> String
showsPrec :: Int -> Delta -> ShowS
$cshowsPrec :: Int -> Delta -> ShowS
Show, Typeable Delta
Delta -> DataType
Delta -> Constr
(forall b. Data b => b -> b) -> Delta -> Delta
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) -> Delta -> u
forall u. (forall d. Data d => d -> u) -> Delta -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Delta -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Delta -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Delta
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delta -> c Delta
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Delta)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delta)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Delta -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Delta -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Delta -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Delta -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Delta -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Delta -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Delta -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Delta -> r
gmapT :: (forall b. Data b => b -> b) -> Delta -> Delta
$cgmapT :: (forall b. Data b => b -> b) -> Delta -> Delta
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delta)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delta)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Delta)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Delta)
dataTypeOf :: Delta -> DataType
$cdataTypeOf :: Delta -> DataType
toConstr :: Delta -> Constr
$ctoConstr :: Delta -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Delta
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Delta
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delta -> c Delta
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delta -> c Delta
Data, forall x. Rep Delta x -> Delta
forall x. Delta -> Rep Delta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Delta x -> Delta
$cfrom :: forall x. Delta -> Rep Delta x
Generic)
instance Eq Delta where
== :: Delta -> Delta -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall t. HasBytes t => t -> Int64
bytes
instance Ord Delta where
compare :: Delta -> Delta -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall t. HasBytes t => t -> Int64
bytes
instance (HasDelta l, HasDelta r) => HasDelta (Either l r) where
delta :: Either l r -> Delta
delta = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall t. HasDelta t => t -> Delta
delta forall t. HasDelta t => t -> Delta
delta
prettyDelta :: Delta -> Doc AnsiStyle
prettyDelta :: Delta -> Doc AnsiStyle
prettyDelta Delta
d = case Delta
d of
Columns Int64
c Int64
_ -> String -> Int64 -> Int64 -> Doc AnsiStyle
go String
interactive Int64
0 Int64
c
Tab Int64
x Int64
y Int64
_ -> String -> Int64 -> Int64 -> Doc AnsiStyle
go String
interactive Int64
0 (Int64 -> Int64
nextTab Int64
x forall a. Num a => a -> a -> a
+ Int64
y)
Lines Int64
l Int64
c Int64
_ Int64
_ -> String -> Int64 -> Int64 -> Doc AnsiStyle
go String
interactive Int64
l Int64
c
Directed ByteString
fn Int64
l Int64
c Int64
_ Int64
_ -> String -> Int64 -> Int64 -> Doc AnsiStyle
go (ByteString -> String
UTF8.toString ByteString
fn) Int64
l Int64
c
where
go
:: String
-> Int64
-> Int64
-> Doc AnsiStyle
go :: String -> Int64 -> Int64 -> Doc AnsiStyle
go String
source Int64
line' Int64
column'
= forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
bold (forall a ann. Pretty a => a -> Doc ann
pretty String
source)
forall a. Semigroup a => a -> a -> a
<> forall a. Char -> Doc a
char Char
':' forall a. Semigroup a => a -> a -> a
<> forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
bold (forall a ann. Pretty a => a -> Doc ann
pretty (Int64
line'forall a. Num a => a -> a -> a
+Int64
1))
forall a. Semigroup a => a -> a -> a
<> forall a. Char -> Doc a
char Char
':' forall a. Semigroup a => a -> a -> a
<> forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
bold (forall a ann. Pretty a => a -> Doc ann
pretty (Int64
column'forall a. Num a => a -> a -> a
+Int64
1))
interactive :: String
interactive = String
"(interactive)"
column :: HasDelta t => t -> Int64
column :: forall t. HasDelta t => t -> Int64
column t
t = case forall t. HasDelta t => t -> Delta
delta t
t of
Columns Int64
c Int64
_ -> Int64
c
Tab Int64
b Int64
a Int64
_ -> Int64 -> Int64
nextTab Int64
b forall a. Num a => a -> a -> a
+ Int64
a
Lines Int64
_ Int64
c Int64
_ Int64
_ -> Int64
c
Directed ByteString
_ Int64
_ Int64
c Int64
_ Int64
_ -> Int64
c
{-# inlinable column #-}
columnByte :: Delta -> Int64
columnByte :: Delta -> Int64
columnByte (Columns Int64
_ Int64
b) = Int64
b
columnByte (Tab Int64
_ Int64
_ Int64
b) = Int64
b
columnByte (Lines Int64
_ Int64
_ Int64
_ Int64
b) = Int64
b
columnByte (Directed ByteString
_ Int64
_ Int64
_ Int64
_ Int64
b) = Int64
b
{-# inlinable columnByte #-}
instance HasBytes Delta where
bytes :: Delta -> Int64
bytes (Columns Int64
_ Int64
b) = Int64
b
bytes (Tab Int64
_ Int64
_ Int64
b) = Int64
b
bytes (Lines Int64
_ Int64
_ Int64
b Int64
_) = Int64
b
bytes (Directed ByteString
_ Int64
_ Int64
_ Int64
b Int64
_) = Int64
b
instance Hashable Delta
instance Monoid Delta where
mempty :: Delta
mempty = Int64 -> Int64 -> Delta
Columns Int64
0 Int64
0
mappend :: Delta -> Delta -> Delta
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup Delta where
Columns Int64
c Int64
a <> :: Delta -> Delta -> Delta
<> Columns Int64
d Int64
b = Int64 -> Int64 -> Delta
Columns (Int64
c forall a. Num a => a -> a -> a
+ Int64
d) (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)
Columns Int64
c Int64
a <> Tab Int64
x Int64
y Int64
b = Int64 -> Int64 -> Int64 -> Delta
Tab (Int64
c forall a. Num a => a -> a -> a
+ Int64
x) Int64
y (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)
Columns Int64
_ Int64
a <> Lines Int64
l Int64
c Int64
t Int64
a' = Int64 -> Int64 -> Int64 -> Int64 -> Delta
Lines Int64
l Int64
c (Int64
t forall a. Num a => a -> a -> a
+ Int64
a) Int64
a'
Columns Int64
_ Int64
a <> Directed ByteString
p Int64
l Int64
c Int64
t Int64
a' = ByteString -> Int64 -> Int64 -> Int64 -> Int64 -> Delta
Directed ByteString
p Int64
l Int64
c (Int64
t forall a. Num a => a -> a -> a
+ Int64
a) Int64
a'
Lines Int64
l Int64
c Int64
t Int64
a <> Columns Int64
d Int64
b = Int64 -> Int64 -> Int64 -> Int64 -> Delta
Lines Int64
l (Int64
c forall a. Num a => a -> a -> a
+ Int64
d) (Int64
t forall a. Num a => a -> a -> a
+ Int64
b) (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)
Lines Int64
l Int64
c Int64
t Int64
a <> Tab Int64
x Int64
y Int64
b = Int64 -> Int64 -> Int64 -> Int64 -> Delta
Lines Int64
l (Int64 -> Int64
nextTab (Int64
c forall a. Num a => a -> a -> a
+ Int64
x) forall a. Num a => a -> a -> a
+ Int64
y) (Int64
t forall a. Num a => a -> a -> a
+ Int64
b) (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)
Lines Int64
l Int64
_ Int64
t Int64
_ <> Lines Int64
m Int64
d Int64
t' Int64
b = Int64 -> Int64 -> Int64 -> Int64 -> Delta
Lines (Int64
l forall a. Num a => a -> a -> a
+ Int64
m) Int64
d (Int64
t forall a. Num a => a -> a -> a
+ Int64
t') Int64
b
Lines Int64
_ Int64
_ Int64
t Int64
_ <> Directed ByteString
p Int64
l Int64
c Int64
t' Int64
a = ByteString -> Int64 -> Int64 -> Int64 -> Int64 -> Delta
Directed ByteString
p Int64
l Int64
c (Int64
t forall a. Num a => a -> a -> a
+ Int64
t') Int64
a
Tab Int64
x Int64
y Int64
a <> Columns Int64
d Int64
b = Int64 -> Int64 -> Int64 -> Delta
Tab Int64
x (Int64
y forall a. Num a => a -> a -> a
+ Int64
d) (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)
Tab Int64
x Int64
y Int64
a <> Tab Int64
x' Int64
y' Int64
b = Int64 -> Int64 -> Int64 -> Delta
Tab Int64
x (Int64 -> Int64
nextTab (Int64
y forall a. Num a => a -> a -> a
+ Int64
x') forall a. Num a => a -> a -> a
+ Int64
y') (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)
Tab Int64
_ Int64
_ Int64
a <> Lines Int64
l Int64
c Int64
t Int64
a' = Int64 -> Int64 -> Int64 -> Int64 -> Delta
Lines Int64
l Int64
c (Int64
t forall a. Num a => a -> a -> a
+ Int64
a ) Int64
a'
Tab Int64
_ Int64
_ Int64
a <> Directed ByteString
p Int64
l Int64
c Int64
t Int64
a' = ByteString -> Int64 -> Int64 -> Int64 -> Int64 -> Delta
Directed ByteString
p Int64
l Int64
c (Int64
t forall a. Num a => a -> a -> a
+ Int64
a ) Int64
a'
Directed ByteString
p Int64
l Int64
c Int64
t Int64
a <> Columns Int64
d Int64
b = ByteString -> Int64 -> Int64 -> Int64 -> Int64 -> Delta
Directed ByteString
p Int64
l (Int64
c forall a. Num a => a -> a -> a
+ Int64
d) (Int64
t forall a. Num a => a -> a -> a
+ Int64
b ) (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)
Directed ByteString
p Int64
l Int64
c Int64
t Int64
a <> Tab Int64
x Int64
y Int64
b = ByteString -> Int64 -> Int64 -> Int64 -> Int64 -> Delta
Directed ByteString
p Int64
l (Int64 -> Int64
nextTab (Int64
c forall a. Num a => a -> a -> a
+ Int64
x) forall a. Num a => a -> a -> a
+ Int64
y) (Int64
t forall a. Num a => a -> a -> a
+ Int64
b ) (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)
Directed ByteString
p Int64
l Int64
_ Int64
t Int64
_ <> Lines Int64
m Int64
d Int64
t' Int64
b = ByteString -> Int64 -> Int64 -> Int64 -> Int64 -> Delta
Directed ByteString
p (Int64
l forall a. Num a => a -> a -> a
+ Int64
m) Int64
d (Int64
t forall a. Num a => a -> a -> a
+ Int64
t') Int64
b
Directed ByteString
_ Int64
_ Int64
_ Int64
t Int64
_ <> Directed ByteString
p Int64
l Int64
c Int64
t' Int64
b = ByteString -> Int64 -> Int64 -> Int64 -> Int64 -> Delta
Directed ByteString
p Int64
l Int64
c (Int64
t forall a. Num a => a -> a -> a
+ Int64
t') Int64
b
nextTab :: Int64 -> Int64
nextTab :: Int64 -> Int64
nextTab Int64
x = Int64
x forall a. Num a => a -> a -> a
+ (Int64
8 forall a. Num a => a -> a -> a
- forall a. Integral a => a -> a -> a
mod Int64
x Int64
8)
{-# inlinable nextTab #-}
rewind :: Delta -> Delta
rewind :: Delta -> Delta
rewind (Lines Int64
n Int64
_ Int64
b Int64
d) = Int64 -> Int64 -> Int64 -> Int64 -> Delta
Lines Int64
n Int64
0 (Int64
b forall a. Num a => a -> a -> a
- Int64
d) Int64
0
rewind (Directed ByteString
p Int64
n Int64
_ Int64
b Int64
d) = ByteString -> Int64 -> Int64 -> Int64 -> Int64 -> Delta
Directed ByteString
p Int64
n Int64
0 (Int64
b forall a. Num a => a -> a -> a
- Int64
d) Int64
0
rewind Delta
_ = Int64 -> Int64 -> Delta
Columns Int64
0 Int64
0
{-# inlinable rewind #-}
near :: (HasDelta s, HasDelta t) => s -> t -> Bool
near :: forall s t. (HasDelta s, HasDelta t) => s -> t -> Bool
near s
s t
t = Delta -> Delta
rewind (forall t. HasDelta t => t -> Delta
delta s
s) forall a. Eq a => a -> a -> Bool
== Delta -> Delta
rewind (forall t. HasDelta t => t -> Delta
delta t
t)
{-# inlinable near #-}
class HasDelta t where
delta :: t -> Delta
instance HasDelta Delta where
delta :: Delta -> Delta
delta = forall a. a -> a
id
instance HasDelta Char where
delta :: Char -> Delta
delta Char
'\t' = Int64 -> Int64 -> Int64 -> Delta
Tab Int64
0 Int64
0 Int64
1
delta Char
'\n' = Int64 -> Int64 -> Int64 -> Int64 -> Delta
Lines Int64
1 Int64
0 Int64
1 Int64
0
delta Char
c
| Int
o forall a. Ord a => a -> a -> Bool
<= Int
0x7f = Int64 -> Int64 -> Delta
Columns Int64
1 Int64
1
| Int
o forall a. Ord a => a -> a -> Bool
<= Int
0x7ff = Int64 -> Int64 -> Delta
Columns Int64
1 Int64
2
| Int
o forall a. Ord a => a -> a -> Bool
<= Int
0xffff = Int64 -> Int64 -> Delta
Columns Int64
1 Int64
3
| Bool
otherwise = Int64 -> Int64 -> Delta
Columns Int64
1 Int64
4
where o :: Int
o = forall a. Enum a => a -> Int
fromEnum Char
c
instance HasDelta Word8 where
delta :: Word8 -> Delta
delta Word8
9 = Int64 -> Int64 -> Int64 -> Delta
Tab Int64
0 Int64
0 Int64
1
delta Word8
10 = Int64 -> Int64 -> Int64 -> Int64 -> Delta
Lines Int64
1 Int64
0 Int64
1 Int64
0
delta Word8
n
| Word8
n forall a. Ord a => a -> a -> Bool
<= Word8
0x7f = Int64 -> Int64 -> Delta
Columns Int64
1 Int64
1
| Word8
n forall a. Ord a => a -> a -> Bool
>= Word8
0xc0 Bool -> Bool -> Bool
&& Word8
n forall a. Ord a => a -> a -> Bool
<= Word8
0xf4 = Int64 -> Int64 -> Delta
Columns Int64
1 Int64
1
| Bool
otherwise = Int64 -> Int64 -> Delta
Columns Int64
0 Int64
1
instance HasDelta ByteString where
delta :: ByteString -> Delta
delta = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall t. HasDelta t => t -> Delta
delta forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
unpack
instance (Measured v a, HasDelta v) => HasDelta (FingerTree v a) where
delta :: FingerTree v a -> Delta
delta = forall t. HasDelta t => t -> Delta
delta forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. Measured v a => a -> v
measure