-- | 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           Prelude     hiding (length, lines, splitAt)
import  Nix.Expr.Types.Annotated

-- | 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
(Int -> SpanUpdate -> ShowS)
-> (SpanUpdate -> String)
-> ([SpanUpdate] -> ShowS)
-> Show SpanUpdate
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
DataType
Constr
Typeable SpanUpdate =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SpanUpdate -> c SpanUpdate)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SpanUpdate)
-> (SpanUpdate -> Constr)
-> (SpanUpdate -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> SpanUpdate -> SpanUpdate)
-> (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 u. (forall d. Data d => d -> u) -> SpanUpdate -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SpanUpdate -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SpanUpdate -> m SpanUpdate)
-> Data SpanUpdate
SpanUpdate -> DataType
SpanUpdate -> Constr
(forall b. Data b => b -> b) -> SpanUpdate -> SpanUpdate
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpanUpdate -> c SpanUpdate
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSpanUpdate :: Constr
$tSpanUpdate :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> SpanUpdate -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SpanUpdate -> u
gmapQ :: (forall d. Data d => d -> u) -> SpanUpdate -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SpanUpdate -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable SpanUpdate
Data)

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

-- | Do two spans overlap
overlaps :: SrcSpan -> SrcSpan -> Bool
overlaps :: SrcSpan -> SrcSpan -> Bool
overlaps (SrcSpan b1 :: SourcePos
b1 e1 :: SourcePos
e1) (SrcSpan b2 :: SourcePos
b2 e2 :: SourcePos
e2) =
  SourcePos
b2 SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
>= SourcePos
b1 Bool -> Bool -> Bool
&& SourcePos
b2 SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
e1 Bool -> Bool -> Bool
|| SourcePos
e2 SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
>= SourcePos
b1 Bool -> Bool -> Bool
&& SourcePos
e2 SourcePos -> SourcePos -> Bool
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 _ row :: Pos
row col :: Pos
col) t :: Text
t = Int -> Text -> (Text, Text)
splitAt
  (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Text -> Int64 -> Int64 -> Int64
linearizeSourcePos Text
t (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int
unPos Pos
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int
unPos Pos
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 t :: Text
t l :: Int64
l c :: Int64
c = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineCharOffset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
c
   where lineCharOffset :: Int
lineCharOffset = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (Text -> [Int]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> [Text] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
length) ([Text] -> [Int]) -> (Text -> [Text]) -> Text -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> [Text] -> [Text]
forall i a. Integral i => i -> [a] -> [a]
genericTake Int64
l ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
lines (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text
t

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