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
)
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)
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)
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
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 :: 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
linearizeSourcePos
:: Text
-> Int64
-> Int64
-> Int64
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)