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
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)
updateSpans :: [SpanUpdate] -> Text -> Text
updateSpans :: [SpanUpdate] -> Text -> Text
updateSpans [SpanUpdate]
us 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)
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end
overlaps :: SrcSpan -> SrcSpan -> Bool
overlaps :: SrcSpan -> SrcSpan -> Bool
overlaps (SrcSpan SourcePos
b1 SourcePos
e1) (SrcSpan SourcePos
b2 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 :: SourcePos -> Text -> (Text, Text)
split :: SourcePos -> Text -> (Text, Text)
split (SourcePos String
_ Pos
row Pos
col) 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
- Int
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
- Int
1)))
)
Text
t
linearizeSourcePos :: Text
-> Int64
-> Int64
-> Int64
linearizeSourcePos :: Text -> Int64 -> Int64 -> Int64
linearizeSourcePos Text
t Int64
l 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
+Int
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 String
_ Pos
row Pos
column) =
String
"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
<> String
" column " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pos -> String
forall a. Show a => a -> String
show Pos
column