{-# language CPP #-}
{-# language DeriveDataTypeable #-}
{-# language DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
-- 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 'Delta' keeps track of the cursor position of the parser, so it can be
-- referred to later, for example in error messages.
----------------------------------------------------------------------------
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 = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> (ByteString -> Int) -> ByteString -> Int64
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 = v -> Int64
forall t. HasBytes t => t -> Int64
bytes (v -> Int64) -> (FingerTree v a -> v) -> FingerTree v a -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree v a -> v
forall v a. Measured v a => a -> v
measure

-- | Since there are multiple ways to be at a certain location, 'Delta' captures
-- all these alternatives as a single type.
data Delta
  = Columns {-# UNPACK #-} !Int64
            {-# UNPACK #-} !Int64
    -- ^ @
    -- ( number of characters
    -- , number of bytes )
    -- @

  | Tab {-# UNPACK #-} !Int64
        {-# UNPACK #-} !Int64
        {-# UNPACK #-} !Int64
    -- ^ @
    -- ( number of characters before the tab
    -- , number of characters after the tab
    -- , number of bytes )
    -- @

  | Lines {-# UNPACK #-} !Int64
          {-# UNPACK #-} !Int64
          {-# UNPACK #-} !Int64
          {-# UNPACK #-} !Int64
    -- ^ @
    -- ( number of newlines contained
    -- , number of characters since the last newline
    -- , number of bytes
    -- , number of bytes since the last newline )
    -- @

  | Directed !ByteString
             {-# UNPACK #-} !Int64
             {-# UNPACK #-} !Int64
             {-# UNPACK #-} !Int64
             {-# UNPACK #-} !Int64
    -- ^ @
    -- ( current file name
    -- , number of lines since the last line directive
    -- , number of characters since the last newline
    -- , number of bytes
    -- , number of bytes since the last newline )
    -- @
  deriving (Int -> Delta -> ShowS
[Delta] -> ShowS
Delta -> String
(Int -> Delta -> ShowS)
-> (Delta -> String) -> ([Delta] -> ShowS) -> Show Delta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Delta -> ShowS
showsPrec :: Int -> Delta -> ShowS
$cshow :: Delta -> String
show :: Delta -> String
$cshowList :: [Delta] -> ShowS
showList :: [Delta] -> ShowS
Show, Typeable Delta
Typeable Delta =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Delta -> c Delta)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Delta)
-> (Delta -> Constr)
-> (Delta -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Delta -> Delta)
-> (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 u. (forall d. Data d => d -> u) -> Delta -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Delta -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Delta -> m Delta)
-> Data Delta
Delta -> Constr
Delta -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delta -> c Delta
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delta -> c Delta
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Delta
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Delta
$ctoConstr :: Delta -> Constr
toConstr :: Delta -> Constr
$cdataTypeOf :: Delta -> DataType
dataTypeOf :: Delta -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Delta)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Delta)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delta)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delta)
$cgmapT :: (forall b. Data b => b -> b) -> Delta -> Delta
gmapT :: (forall b. Data b => b -> b) -> Delta -> Delta
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Delta -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Delta -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Delta -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Delta -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Delta -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Delta -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delta -> m Delta
Data, (forall x. Delta -> Rep Delta x)
-> (forall x. Rep Delta x -> Delta) -> Generic Delta
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
$cfrom :: forall x. Delta -> Rep Delta x
from :: forall x. Delta -> Rep Delta x
$cto :: forall x. Rep Delta x -> Delta
to :: forall x. Rep Delta x -> Delta
Generic)

instance Eq Delta where
  == :: Delta -> Delta -> Bool
(==) = Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int64 -> Int64 -> Bool)
-> (Delta -> Int64) -> Delta -> Delta -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes

instance Ord Delta where
  compare :: Delta -> Delta -> Ordering
compare = Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int64 -> Int64 -> Ordering)
-> (Delta -> Int64) -> Delta -> Delta -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes

instance (HasDelta l, HasDelta r) => HasDelta (Either l r) where
  delta :: Either l r -> Delta
delta = (l -> Delta) -> (r -> Delta) -> Either l r -> Delta
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either l -> Delta
forall t. HasDelta t => t -> Delta
delta r -> Delta
forall t. HasDelta t => t -> Delta
delta

-- | Example: @file.txt:12:34@
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 Int64 -> Int64 -> Int64
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 -- Source description
        -> Int64  -- Line
        -> Int64  -- Column
        -> Doc AnsiStyle
    go :: String -> Int64 -> Int64 -> Doc AnsiStyle
go String
source Int64
line' Int64
column'
      = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
bold (String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
source)
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Char -> Doc AnsiStyle
forall a. Char -> Doc a
char Char
':' Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
bold (Int64 -> Doc AnsiStyle
forall ann. Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int64
line'Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1))
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Char -> Doc AnsiStyle
forall a. Char -> Doc a
char Char
':' Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
bold (Int64 -> Doc AnsiStyle
forall ann. Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int64
column'Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1))
    interactive :: String
interactive = String
"(interactive)"

-- | Retrieve the character offset within the current line from this 'Delta'.
column :: HasDelta t => t -> Int64
column :: forall t. HasDelta t => t -> Int64
column t
t = case t -> Delta
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 Int64 -> Int64 -> Int64
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 #-}

-- | Retrieve the byte offset within the current line from this 'Delta'.
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 = Delta -> Delta -> Delta
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
d)                            (Int64
a Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
x) Int64
y                          (Int64
a Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
d)                   (Int64
t Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
b)  (Int64
a Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
x) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
y)     (Int64
t Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
b)  (Int64
a Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
m) Int64
d                         (Int64
t Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
d)                          (Int64
a Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
x') Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
y')          (Int64
a Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
d)                   (Int64
t Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
b ) (Int64
a Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
x) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
y)     (Int64
t Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
b ) (Int64
a Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
m) Int64
d                         (Int64
t Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
t') Int64
b

-- | Increment a column number to the next tabstop.
nextTab :: Int64 -> Int64
nextTab :: Int64 -> Int64
nextTab Int64
x = Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Int64
8 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
mod Int64
x Int64
8)
{-# inlinable nextTab #-}

-- | Rewind a 'Delta' to the beginning of the line.
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 Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
d) Int64
0
rewind Delta
_                    = Int64 -> Int64 -> Delta
Columns Int64
0 Int64
0
{-# inlinable rewind #-}

-- | Should we show two things with a 'Delta' on the same line?
--
-- >>> near (Columns 0 0) (Columns 5 5)
-- True
--
-- >>> near (Lines 1 0 1 0) (Lines 2 4 4 2)
-- False
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 (s -> Delta
forall t. HasDelta t => t -> Delta
delta s
s) Delta -> Delta -> Bool
forall a. Eq a => a -> a -> Bool
== Delta -> Delta
rewind (t -> Delta
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 = 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7f   = Int64 -> Int64 -> Delta
Columns Int64
1 Int64
1
    | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7ff  = Int64 -> Int64 -> Delta
Columns Int64
1 Int64
2
    | Int
o Int -> Int -> Bool
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 = Char -> Int
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7f              = Int64 -> Int64 -> Delta
Columns Int64
1 Int64
1
    | Word8
n Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xc0 Bool -> Bool -> Bool
&& Word8
n Word8 -> Word8 -> Bool
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 = (Word8 -> Delta) -> [Word8] -> Delta
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Delta
forall t. HasDelta t => t -> Delta
delta ([Word8] -> Delta)
-> (ByteString -> [Word8]) -> ByteString -> 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 = v -> Delta
forall t. HasDelta t => t -> Delta
delta (v -> Delta) -> (FingerTree v a -> v) -> FingerTree v a -> Delta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree v a -> v
forall v a. Measured v a => a -> v
measure