trifecta-2.1.2: src/Text/Trifecta/Delta.hs
{-# 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 = fromIntegral . Strict.length
instance (Measured v a, HasBytes v) => HasBytes (FingerTree v a) where
bytes = bytes . 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 (Show, Data, Generic)
instance Eq Delta where
(==) = (==) `on` bytes
instance Ord Delta where
compare = compare `on` bytes
instance (HasDelta l, HasDelta r) => HasDelta (Either l r) where
delta = either delta delta
-- | Example: @file.txt:12:34@
prettyDelta :: Delta -> Doc AnsiStyle
prettyDelta d = case d of
Columns c _ -> go interactive 0 c
Tab x y _ -> go interactive 0 (nextTab x + y)
Lines l c _ _ -> go interactive l c
Directed fn l c _ _ -> go (UTF8.toString fn) l c
where
go
:: String -- Source description
-> Int64 -- Line
-> Int64 -- Column
-> Doc AnsiStyle
go source line' column'
= annotate bold (pretty source)
<> char ':' <> annotate bold (pretty (line'+1))
<> char ':' <> annotate bold (pretty (column'+1))
interactive = "(interactive)"
-- | Retrieve the character offset within the current line from this 'Delta'.
column :: HasDelta t => t -> Int64
column t = case delta t of
Columns c _ -> c
Tab b a _ -> nextTab b + a
Lines _ c _ _ -> c
Directed _ _ c _ _ -> c
{-# inlinable column #-}
-- | Retrieve the byte offset within the current line from this 'Delta'.
columnByte :: Delta -> Int64
columnByte (Columns _ b) = b
columnByte (Tab _ _ b) = b
columnByte (Lines _ _ _ b) = b
columnByte (Directed _ _ _ _ b) = b
{-# inlinable columnByte #-}
instance HasBytes Delta where
bytes (Columns _ b) = b
bytes (Tab _ _ b) = b
bytes (Lines _ _ b _) = b
bytes (Directed _ _ _ b _) = b
instance Hashable Delta
instance Monoid Delta where
mempty = Columns 0 0
mappend = (<>)
instance Semigroup Delta where
Columns c a <> Columns d b = Columns (c + d) (a + b)
Columns c a <> Tab x y b = Tab (c + x) y (a + b)
Columns _ a <> Lines l c t a' = Lines l c (t + a) a'
Columns _ a <> Directed p l c t a' = Directed p l c (t + a) a'
Lines l c t a <> Columns d b = Lines l (c + d) (t + b) (a + b)
Lines l c t a <> Tab x y b = Lines l (nextTab (c + x) + y) (t + b) (a + b)
Lines l _ t _ <> Lines m d t' b = Lines (l + m) d (t + t') b
Lines _ _ t _ <> Directed p l c t' a = Directed p l c (t + t') a
Tab x y a <> Columns d b = Tab x (y + d) (a + b)
Tab x y a <> Tab x' y' b = Tab x (nextTab (y + x') + y') (a + b)
Tab _ _ a <> Lines l c t a' = Lines l c (t + a ) a'
Tab _ _ a <> Directed p l c t a' = Directed p l c (t + a ) a'
Directed p l c t a <> Columns d b = Directed p l (c + d) (t + b ) (a + b)
Directed p l c t a <> Tab x y b = Directed p l (nextTab (c + x) + y) (t + b ) (a + b)
Directed p l _ t _ <> Lines m d t' b = Directed p (l + m) d (t + t') b
Directed _ _ _ t _ <> Directed p l c t' b = Directed p l c (t + t') b
-- | Increment a column number to the next tabstop.
nextTab :: Int64 -> Int64
nextTab x = x + (8 - mod x 8)
{-# inlinable nextTab #-}
-- | Rewind a 'Delta' to the beginning of the line.
rewind :: Delta -> Delta
rewind (Lines n _ b d) = Lines n 0 (b - d) 0
rewind (Directed p n _ b d) = Directed p n 0 (b - d) 0
rewind _ = Columns 0 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 = rewind (delta s) == rewind (delta t)
{-# inlinable near #-}
class HasDelta t where
delta :: t -> Delta
instance HasDelta Delta where
delta = id
instance HasDelta Char where
delta '\t' = Tab 0 0 1
delta '\n' = Lines 1 0 1 0
delta c
| o <= 0x7f = Columns 1 1
| o <= 0x7ff = Columns 1 2
| o <= 0xffff = Columns 1 3
| otherwise = Columns 1 4
where o = fromEnum c
instance HasDelta Word8 where
delta 9 = Tab 0 0 1
delta 10 = Lines 1 0 1 0
delta n
| n <= 0x7f = Columns 1 1
| n >= 0xc0 && n <= 0xf4 = Columns 1 1
| otherwise = Columns 0 1
instance HasDelta ByteString where
delta = foldMap delta . unpack
instance (Measured v a, HasDelta v) => HasDelta (FingerTree v a) where
delta = delta . measure