-- | This module deals with updating spans of characters in values of type Text.
--
-- It defines some helper types and functions to apply these "updates".

module Update.Span
  ( SpanUpdate(..)
  , SrcSpan(..)
  , SourcePos(..)
  , updateSpan
  , updateSpans
  , linearizeSourcePos
  , prettyPrintSourcePos
  , split
  ) where

import           Control.Exception              ( assert )
import           Data.Data                      ( Data )
import           Data.Int                       ( Int64 )
import           Data.List                      ( genericTake
                                                , sortOn
                                                )
import           Data.Text                      ( Text
                                                , length
                                                , lines
                                                , splitAt
                                                )
import           Nix.Expr.Types.Annotated
import           Prelude                 hiding ( length
                                                , lines
                                                , splitAt
                                                )

-- | A span and some text to replace it with.
-- They don't have to be the same length.
data SpanUpdate = SpanUpdate
  { SpanUpdate -> SrcSpan
spanUpdateSpan     :: SrcSpan
  , SpanUpdate -> Text
spanUpdateContents :: Text
  }
  deriving (Int -> SpanUpdate -> ShowS
[SpanUpdate] -> ShowS
SpanUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanUpdate] -> ShowS
$cshowList :: [SpanUpdate] -> ShowS
show :: SpanUpdate -> String
$cshow :: SpanUpdate -> String
showsPrec :: Int -> SpanUpdate -> ShowS
$cshowsPrec :: Int -> SpanUpdate -> ShowS
Show, Typeable SpanUpdate
SpanUpdate -> DataType
SpanUpdate -> Constr
(forall b. Data b => b -> b) -> SpanUpdate -> SpanUpdate
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) -> SpanUpdate -> u
forall u. (forall d. Data d => d -> u) -> SpanUpdate -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpanUpdate -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpanUpdate -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SpanUpdate -> m SpanUpdate
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpanUpdate -> m SpanUpdate
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpanUpdate
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpanUpdate -> c SpanUpdate
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpanUpdate)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SpanUpdate)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpanUpdate -> m SpanUpdate
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpanUpdate -> m SpanUpdate
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpanUpdate -> m SpanUpdate
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpanUpdate -> m SpanUpdate
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SpanUpdate -> m SpanUpdate
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SpanUpdate -> m SpanUpdate
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SpanUpdate -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SpanUpdate -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SpanUpdate -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SpanUpdate -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpanUpdate -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpanUpdate -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpanUpdate -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpanUpdate -> r
gmapT :: (forall b. Data b => b -> b) -> SpanUpdate -> SpanUpdate
$cgmapT :: (forall b. Data b => b -> b) -> SpanUpdate -> SpanUpdate
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SpanUpdate)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SpanUpdate)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpanUpdate)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpanUpdate)
dataTypeOf :: SpanUpdate -> DataType
$cdataTypeOf :: SpanUpdate -> DataType
toConstr :: SpanUpdate -> Constr
$ctoConstr :: SpanUpdate -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpanUpdate
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpanUpdate
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpanUpdate -> c SpanUpdate
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpanUpdate -> c SpanUpdate
Data)

-- | Update many spans in a file. They must be non-overlapping.
updateSpans :: [SpanUpdate] -> Text -> Text
updateSpans :: [SpanUpdate] -> Text -> Text
updateSpans [SpanUpdate]
us Text
t =
  let sortedSpans :: [SpanUpdate]
sortedSpans = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (SrcSpan -> SourcePos
spanBegin forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanUpdate -> SrcSpan
spanUpdateSpan) [SpanUpdate]
us
      anyOverlap :: Bool
anyOverlap =
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SrcSpan -> SrcSpan -> Bool
overlaps) (forall a b. [a] -> [b] -> [(a, b)]
zip forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ SpanUpdate -> SrcSpan
spanUpdateSpan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SpanUpdate]
sortedSpans)
  in  forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not Bool
anyOverlap) (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SpanUpdate -> Text -> Text
updateSpan Text
t [SpanUpdate]
sortedSpans)

-- | Update a single span of characters inside a text value. If you're updating
-- multiples spans it's best to use 'updateSpans'.
updateSpan :: SpanUpdate -> Text -> Text
updateSpan :: SpanUpdate -> Text -> Text
updateSpan (SpanUpdate (SrcSpan SourcePos
b SourcePos
e) Text
r) Text
t =
  let (Text
before, Text
_  ) = SourcePos -> Text -> (Text, Text)
split SourcePos
b Text
t
      (Text
_     , Text
end) = SourcePos -> Text -> (Text, Text)
split SourcePos
e Text
t
  in  Text
before forall a. Semigroup a => a -> a -> a
<> Text
r forall a. Semigroup a => a -> a -> a
<> Text
end

-- | Do two spans overlap
overlaps :: SrcSpan -> SrcSpan -> Bool
overlaps :: SrcSpan -> SrcSpan -> Bool
overlaps (SrcSpan SourcePos
b1 SourcePos
e1) (SrcSpan SourcePos
b2 SourcePos
e2) =
  SourcePos
b2 forall a. Ord a => a -> a -> Bool
>= SourcePos
b1 Bool -> Bool -> Bool
&& SourcePos
b2 forall a. Ord a => a -> a -> Bool
< SourcePos
e1 Bool -> Bool -> Bool
|| SourcePos
e2 forall a. Ord a => a -> a -> Bool
>= SourcePos
b1 Bool -> Bool -> Bool
&& SourcePos
e2 forall a. Ord a => a -> a -> Bool
< SourcePos
e1

-- | Split some text at a particular 'SourcePos'
split :: SourcePos -> Text -> (Text, Text)
split :: SourcePos -> Text -> (Text, Text)
split (SourcePos String
_ Pos
row Pos
col) Text
t = Int -> Text -> (Text, Text)
splitAt
  (forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Text -> Int64 -> Int64 -> Int64
linearizeSourcePos Text
t
                        (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int
unPos Pos
row forall a. Num a => a -> a -> a
- Int
1))
                        (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int
unPos Pos
col forall a. Num a => a -> a -> a
- Int
1))
    )
  )
  Text
t

-- | Go from a line and column representation to a single character offset from
-- the beginning of the text.
--
-- This probably fails on crazy texts with multi character line breaks.
linearizeSourcePos
  :: Text -- ^ The string to linearize in
  -> Int64 -- ^ The line offset
  -> Int64 -- ^ The column offset
  -> Int64 -- ^ The character offset
linearizeSourcePos :: Text -> Int64 -> Int64 -> Int64
linearizeSourcePos Text
t Int64
l Int64
c = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineCharOffset forall a. Num a => a -> a -> a
+ Int64
c
 where
  lineCharOffset :: Int
lineCharOffset = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Integral i => i -> [a] -> [a]
genericTake Int64
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
lines forall a b. (a -> b) -> a -> b
$ Text
t

prettyPrintSourcePos :: SourcePos -> String
prettyPrintSourcePos :: SourcePos -> String
prettyPrintSourcePos (SourcePos String
_ Pos
row Pos
column) =
  forall a. Show a => a -> String
show (Pos -> Int
unPos Pos
row) forall a. Semigroup a => a -> a -> a
<> String
":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Pos -> Int
unPos Pos
column)