{-# 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
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
#endif
import Data.Function (on)
import Data.FingerTree hiding (empty)
import Data.ByteString as Strict hiding (empty)
import qualified Data.ByteString.UTF8 as UTF8
import Data.Text.Prettyprint.Doc hiding (column, line')
import GHC.Generics

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
showList :: [Delta] -> ShowS
$cshowList :: [Delta] -> ShowS
show :: Delta -> String
$cshow :: Delta -> String
showsPrec :: Int -> Delta -> ShowS
$cshowsPrec :: Int -> Delta -> ShowS
Show, Typeable Delta
DataType
Constr
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 -> DataType
Delta -> Constr
(forall b. Data b => b -> b) -> Delta -> Delta
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delta -> c Delta
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cDirected :: Constr
$cLines :: Constr
$cTab :: Constr
$cColumns :: Constr
$tDelta :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Delta -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Delta -> u
gmapQ :: (forall d. Data d => d -> u) -> Delta -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Delta -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Delta
Data, Typeable, (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
$cto :: forall x. Rep Delta x -> Delta
$cfrom :: forall x. Delta -> Rep Delta x
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 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 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 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 :: 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 :: 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 (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