{-# LANGUAGE TemplateHaskell #-}
module ShellCheck.Fixer (applyFix, removeTabStops, mapPositions, Ranged(..), runTests) where
import ShellCheck.Interface
import ShellCheck.Prelude
import Control.Monad
import Control.Monad.State
import Data.Array
import Data.List
import Data.Semigroup
import GHC.Exts (sortWith)
import Test.QuickCheck
class Ranged a where
start :: a -> Position
end :: a -> Position
overlap :: a -> a -> Bool
overlap a
x a
y =
Position
xEnd forall a. Ord a => a -> a -> Bool
> Position
yStart Bool -> Bool -> Bool
&& Position
yEnd forall a. Ord a => a -> a -> Bool
> Position
xStart
where
yStart :: Position
yStart = forall a. Ranged a => a -> Position
start a
y
yEnd :: Position
yEnd = forall a. Ranged a => a -> Position
end a
y
xStart :: Position
xStart = forall a. Ranged a => a -> Position
start a
x
xEnd :: Position
xEnd = forall a. Ranged a => a -> Position
end a
x
setRange :: (Position, Position) -> a -> a
assertOverlap :: a -> a -> Bool
assertOverlap a
x a
y = forall a. Ranged a => a -> a -> Bool
overlap a
x a
y Bool -> Bool -> Bool
&& forall a. Ranged a => a -> a -> Bool
overlap a
y a
x
assertNoOverlap :: a -> a -> Bool
assertNoOverlap a
x a
y = Bool -> Bool
not (forall a. Ranged a => a -> a -> Bool
overlap a
x a
y) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall a. Ranged a => a -> a -> Bool
overlap a
y a
x)
prop_overlap_contiguous :: Bool
prop_overlap_contiguous = forall a. Ranged a => a -> a -> Bool
assertNoOverlap
(Int -> Int -> String -> Int -> Replacement
tFromStart Int
10 Int
12 String
"foo" Int
1)
(Int -> Int -> String -> Int -> Replacement
tFromStart Int
12 Int
14 String
"bar" Int
2)
prop_overlap_adjacent_zerowidth :: Bool
prop_overlap_adjacent_zerowidth = forall a. Ranged a => a -> a -> Bool
assertNoOverlap
(Int -> Int -> String -> Int -> Replacement
tFromStart Int
3 Int
3 String
"foo" Int
1)
(Int -> Int -> String -> Int -> Replacement
tFromStart Int
3 Int
3 String
"bar" Int
2)
prop_overlap_enclosed :: Bool
prop_overlap_enclosed = forall a. Ranged a => a -> a -> Bool
assertOverlap
(Int -> Int -> String -> Int -> Replacement
tFromStart Int
3 Int
5 String
"foo" Int
1)
(Int -> Int -> String -> Int -> Replacement
tFromStart Int
1 Int
10 String
"bar" Int
2)
prop_overlap_partial :: Bool
prop_overlap_partial = forall a. Ranged a => a -> a -> Bool
assertOverlap
(Int -> Int -> String -> Int -> Replacement
tFromStart Int
1 Int
5 String
"foo" Int
1)
(Int -> Int -> String -> Int -> Replacement
tFromStart Int
3 Int
7 String
"bar" Int
2)
instance Ranged PositionedComment where
start :: PositionedComment -> Position
start = PositionedComment -> Position
pcStartPos
end :: PositionedComment -> Position
end = PositionedComment -> Position
pcEndPos
setRange :: (Position, Position) -> PositionedComment -> PositionedComment
setRange (Position
s, Position
e) PositionedComment
pc = PositionedComment
pc {
pcStartPos :: Position
pcStartPos = Position
s,
pcEndPos :: Position
pcEndPos = Position
e
}
instance Ranged Replacement where
start :: Replacement -> Position
start = Replacement -> Position
repStartPos
end :: Replacement -> Position
end = Replacement -> Position
repEndPos
setRange :: (Position, Position) -> Replacement -> Replacement
setRange (Position
s, Position
e) Replacement
r = Replacement
r {
repStartPos :: Position
repStartPos = Position
s,
repEndPos :: Position
repEndPos = Position
e
}
instance Monoid Fix where
mempty :: Fix
mempty = Fix
newFix
mappend :: Fix -> Fix -> Fix
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [Fix] -> Fix
mconcat = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Monoid a => a -> a -> a
mappend forall a. Monoid a => a
mempty
instance Semigroup Fix where
Fix
f1 <> :: Fix -> Fix -> Fix
<> Fix
f2 =
if forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ Replacement
r2 forall a. Ranged a => a -> a -> Bool
`overlap` Replacement
r1 | Replacement
r1 <- Fix -> [Replacement]
fixReplacements Fix
f1, Replacement
r2 <- Fix -> [Replacement]
fixReplacements Fix
f2 ]
then Fix
f1
else Fix
newFix {
fixReplacements :: [Replacement]
fixReplacements = Fix -> [Replacement]
fixReplacements Fix
f1 forall a. [a] -> [a] -> [a]
++ Fix -> [Replacement]
fixReplacements Fix
f2
}
mapPositions :: (Position -> Position) -> Fix -> Fix
mapPositions :: (Position -> Position) -> Fix -> Fix
mapPositions Position -> Position
f = Fix -> Fix
adjustFix
where
adjustReplacement :: Replacement -> Replacement
adjustReplacement Replacement
rep =
Replacement
rep {
repStartPos :: Position
repStartPos = Position -> Position
f forall a b. (a -> b) -> a -> b
$ Replacement -> Position
repStartPos Replacement
rep,
repEndPos :: Position
repEndPos = Position -> Position
f forall a b. (a -> b) -> a -> b
$ Replacement -> Position
repEndPos Replacement
rep
}
adjustFix :: Fix -> Fix
adjustFix Fix
fix =
Fix
fix {
fixReplacements :: [Replacement]
fixReplacements = forall a b. (a -> b) -> [a] -> [b]
map Replacement -> Replacement
adjustReplacement forall a b. (a -> b) -> a -> b
$ Fix -> [Replacement]
fixReplacements Fix
fix
}
removeTabStops :: Ranged a => a -> Array Int String -> a
removeTabStops :: forall a. Ranged a => a -> Array Int String -> a
removeTabStops a
range Array Int String
ls =
let startColumn :: Integer
startColumn = forall {t} {a} {t}.
(Integral t, Integral a) =>
(t -> a) -> (t -> t) -> t -> t
realignColumn a -> Integer
lineNo a -> Integer
colNo a
range
endColumn :: Integer
endColumn = forall {t} {a} {t}.
(Integral t, Integral a) =>
(t -> a) -> (t -> t) -> t -> t
realignColumn a -> Integer
endLineNo a -> Integer
endColNo a
range
startPosition :: Position
startPosition = (forall a. Ranged a => a -> Position
start a
range) { posColumn :: Integer
posColumn = Integer
startColumn }
endPosition :: Position
endPosition = (forall a. Ranged a => a -> Position
end a
range) { posColumn :: Integer
posColumn = Integer
endColumn } in
forall a. Ranged a => (Position, Position) -> a -> a
setRange (Position
startPosition, Position
endPosition) a
range
where
realignColumn :: (t -> a) -> (t -> t) -> t -> t
realignColumn t -> a
lineNo t -> t
colNo t
c =
if t -> a
lineNo t
c forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
&& t -> a
lineNo t
c forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length Array Int String
ls)
then forall {t}. Integral t => String -> t -> t -> t -> t
real (Array Int String
ls forall i e. Ix i => Array i e -> i -> e
! forall a b. (Integral a, Num b) => a -> b
fromIntegral (t -> a
lineNo t
c)) t
0 t
0 (t -> t
colNo t
c)
else t -> t
colNo t
c
real :: String -> t -> t -> t -> t
real String
_ t
r t
v t
target | t
target forall a. Ord a => a -> a -> Bool
<= t
v = t
r
real [] t
r t
v t
target = t
r forall a. Num a => a -> a -> a
+ (t
target forall a. Num a => a -> a -> a
- t
v)
real (Char
'\t':String
rest) t
r t
v t
target = String -> t -> t -> t -> t
real String
rest (t
rforall a. Num a => a -> a -> a
+t
1) (t
v forall a. Num a => a -> a -> a
+ t
8 forall a. Num a => a -> a -> a
- (t
v forall a. Integral a => a -> a -> a
`mod` t
8)) t
target
real (Char
_:String
rest) t
r t
v t
target = String -> t -> t -> t -> t
real String
rest (t
rforall a. Num a => a -> a -> a
+t
1) (t
vforall a. Num a => a -> a -> a
+t
1) t
target
lineNo :: a -> Integer
lineNo = Position -> Integer
posLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ranged a => a -> Position
start
endLineNo :: a -> Integer
endLineNo = Position -> Integer
posLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ranged a => a -> Position
end
colNo :: a -> Integer
colNo = Position -> Integer
posColumn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ranged a => a -> Position
start
endColNo :: a -> Integer
endColNo = Position -> Integer
posColumn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ranged a => a -> Position
end
multiToSingleLine :: [Fix] -> Array Int String -> ([Fix], String)
multiToSingleLine :: [Fix] -> Array Int String -> ([Fix], String)
multiToSingleLine [Fix]
fixes Array Int String
lines =
(forall a b. (a -> b) -> [a] -> [b]
map ((Position -> Position) -> Fix -> Fix
mapPositions Position -> Position
adjust) [Fix]
fixes, [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall i e. Array i e -> [e]
elems Array Int String
lines)
where
shiftTree :: PSTree Int
shiftTree :: PSTree Int
shiftTree =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\PSTree Int
t (Int
n,String
s) -> forall n. (Ord n, Num n) => n -> n -> PSTree n -> PSTree n
addPSValue (Int
nforall a. Num a => a -> a -> a
+Int
1) (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Num a => a -> a -> a
+ Int
1) PSTree Int
t) forall n. Num n => PSTree n
newPSTree forall a b. (a -> b) -> a -> b
$
forall i e. Ix i => Array i e -> [(i, e)]
assocs Array Int String
lines
singleString :: String
singleString = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall i e. Array i e -> [e]
elems Array Int String
lines
adjust :: Position -> Position
adjust Position
pos =
Position
pos {
posLine :: Integer
posLine = Integer
1,
posColumn :: Integer
posColumn = (Position -> Integer
posColumn Position
pos) forall a. Num a => a -> a -> a
+
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall n. (Ord n, Num n) => n -> PSTree n -> n
getPrefixSum (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Position -> Integer
posLine Position
pos) PSTree Int
shiftTree)
}
applyFix :: Fix -> Array Int String -> [String]
applyFix :: Fix -> Array Int String -> [String]
applyFix Fix
fix Array Int String
fileLines =
let
untabbed :: Fix
untabbed = Fix
fix {
fixReplacements :: [Replacement]
fixReplacements =
forall a b. (a -> b) -> [a] -> [b]
map (\Replacement
c -> forall a. Ranged a => a -> Array Int String -> a
removeTabStops Replacement
c Array Int String
fileLines) forall a b. (a -> b) -> a -> b
$
Fix -> [Replacement]
fixReplacements Fix
fix
}
([Fix]
adjustedFixes, String
singleLine) = [Fix] -> Array Int String -> ([Fix], String)
multiToSingleLine [Fix
untabbed] Array Int String
fileLines
in
String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fixer a -> a
runFixer forall a b. (a -> b) -> a -> b
$ [Fix] -> String -> Fixer String
applyFixes2 [Fix]
adjustedFixes String
singleLine
prop_doReplace1 :: Bool
prop_doReplace1 = forall {p} {p} {a}.
(Integral p, Integral p) =>
p -> p -> [a] -> [a] -> [a]
doReplace Integer
0 Integer
0 String
"1234" String
"A" forall a. Eq a => a -> a -> Bool
== String
"A1234"
prop_doReplace2 :: Bool
prop_doReplace2 = forall {p} {p} {a}.
(Integral p, Integral p) =>
p -> p -> [a] -> [a] -> [a]
doReplace Integer
1 Integer
1 String
"1234" String
"A" forall a. Eq a => a -> a -> Bool
== String
"A1234"
prop_doReplace3 :: Bool
prop_doReplace3 = forall {p} {p} {a}.
(Integral p, Integral p) =>
p -> p -> [a] -> [a] -> [a]
doReplace Integer
1 Integer
2 String
"1234" String
"A" forall a. Eq a => a -> a -> Bool
== String
"A234"
prop_doReplace4 :: Bool
prop_doReplace4 = forall {p} {p} {a}.
(Integral p, Integral p) =>
p -> p -> [a] -> [a] -> [a]
doReplace Integer
3 Integer
3 String
"1234" String
"A" forall a. Eq a => a -> a -> Bool
== String
"12A34"
prop_doReplace5 :: Bool
prop_doReplace5 = forall {p} {p} {a}.
(Integral p, Integral p) =>
p -> p -> [a] -> [a] -> [a]
doReplace Integer
4 Integer
4 String
"1234" String
"A" forall a. Eq a => a -> a -> Bool
== String
"123A4"
prop_doReplace6 :: Bool
prop_doReplace6 = forall {p} {p} {a}.
(Integral p, Integral p) =>
p -> p -> [a] -> [a] -> [a]
doReplace Integer
5 Integer
5 String
"1234" String
"A" forall a. Eq a => a -> a -> Bool
== String
"1234A"
doReplace :: p -> p -> [a] -> [a] -> [a]
doReplace p
start p
end [a]
o [a]
r =
let si :: Int
si = forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
startforall a. Num a => a -> a -> a
-p
1)
ei :: Int
ei = forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
endforall a. Num a => a -> a -> a
-p
1)
([a]
x, [a]
xs) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
si [a]
o
z :: [a]
z = forall a. Int -> [a] -> [a]
drop (Int
ei forall a. Num a => a -> a -> a
- Int
si) [a]
xs
in
[a]
x forall a. [a] -> [a] -> [a]
++ [a]
r forall a. [a] -> [a] -> [a]
++ [a]
z
testFixes :: String -> String -> [Fix] -> Bool
testFixes :: String -> String -> [Fix] -> Bool
testFixes String
expected String
original [Fix]
fixes =
String
actual forall a. Eq a => a -> a -> Bool
== String
expected
where
actual :: String
actual = forall a. Fixer a -> a
runFixer ([Fix] -> String -> Fixer String
applyFixes2 [Fix]
fixes String
original)
type Fixer a = State (PSTree Int) a
applyReplacement2 :: Replacement -> String -> Fixer String
applyReplacement2 :: Replacement -> String -> Fixer String
applyReplacement2 Replacement
rep String
string = do
PSTree Int
tree <- forall s (m :: * -> *). MonadState s m => m s
get
let transform :: Int -> Int
transform Int
pos = Int
pos forall a. Num a => a -> a -> a
+ forall n. (Ord n, Num n) => n -> PSTree n -> n
getPrefixSum Int
pos PSTree Int
tree
let originalPos :: (Position, Position)
originalPos = (Replacement -> Position
repStartPos Replacement
rep, Replacement -> Position
repEndPos Replacement
rep)
(Int
oldStart, Int
oldEnd) = forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
tmap (forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Integer
posColumn) (Position, Position)
originalPos
(Int
newStart, Int
newEnd) = forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
tmap Int -> Int
transform (Int
oldStart, Int
oldEnd)
let (Integer
l1, Integer
l2) = forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
tmap Position -> Integer
posLine (Position, Position)
originalPos in
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
l1 forall a. Eq a => a -> a -> Bool
/= Integer
1 Bool -> Bool -> Bool
|| Integer
l2 forall a. Eq a => a -> a -> Bool
/= Integer
1) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String -> String
pleaseReport String
"bad cross-line fix"
let replacer :: String
replacer = Replacement -> String
repString Replacement
rep
let shift :: Int
shift = (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
replacer) forall a. Num a => a -> a -> a
- (Int
oldEnd forall a. Num a => a -> a -> a
- Int
oldStart)
let insertionPoint :: Int
insertionPoint =
case Replacement -> InsertionPoint
repInsertionPoint Replacement
rep of
InsertionPoint
InsertBefore -> Int
oldStart
InsertionPoint
InsertAfter -> Int
oldEndforall a. Num a => a -> a -> a
+Int
1
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall n. (Ord n, Num n) => n -> n -> PSTree n -> PSTree n
addPSValue Int
insertionPoint Int
shift PSTree Int
tree
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {p} {p} {a}.
(Integral p, Integral p) =>
p -> p -> [a] -> [a] -> [a]
doReplace Int
newStart Int
newEnd String
string String
replacer
where
tmap :: (t -> b) -> (t, t) -> (b, b)
tmap t -> b
f (t
a,t
b) = (t -> b
f t
a, t -> b
f t
b)
applyReplacements2 :: [Replacement] -> String -> Fixer String
applyReplacements2 :: [Replacement] -> String -> Fixer String
applyReplacements2 [Replacement]
reps String
str =
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> b -> a -> c
flip Replacement -> String -> Fixer String
applyReplacement2) String
str forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith Replacement -> Int
repPrecedence [Replacement]
reps
applyFixes2 :: [Fix] -> String -> Fixer String
applyFixes2 :: [Fix] -> String -> Fixer String
applyFixes2 [Fix]
fixes = [Replacement] -> String -> Fixer String
applyReplacements2 (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Fix -> [Replacement]
fixReplacements [Fix]
fixes)
runFixer :: Fixer a -> a
runFixer :: forall a. Fixer a -> a
runFixer Fixer a
f = forall s a. State s a -> s -> a
evalState Fixer a
f forall n. Num n => PSTree n
newPSTree
data PSTree n = PSBranch n (PSTree n) (PSTree n) n | PSLeaf
deriving (Int -> PSTree n -> String -> String
forall n. Show n => Int -> PSTree n -> String -> String
forall n. Show n => [PSTree n] -> String -> String
forall n. Show n => PSTree n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PSTree n] -> String -> String
$cshowList :: forall n. Show n => [PSTree n] -> String -> String
show :: PSTree n -> String
$cshow :: forall n. Show n => PSTree n -> String
showsPrec :: Int -> PSTree n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> PSTree n -> String -> String
Show)
newPSTree :: Num n => PSTree n
newPSTree :: forall n. Num n => PSTree n
newPSTree = forall n. PSTree n
PSLeaf
getPrefixSum :: (Ord n, Num n) => n -> PSTree n -> n
getPrefixSum :: forall n. (Ord n, Num n) => n -> PSTree n -> n
getPrefixSum = forall {t}. (Ord t, Num t) => t -> t -> PSTree t -> t
f n
0
where
f :: t -> t -> PSTree t -> t
f t
sum t
_ PSTree t
PSLeaf = t
sum
f t
sum t
target (PSBranch t
pivot PSTree t
left PSTree t
right t
cumulative) =
case t
target forall a. Ord a => a -> a -> Ordering
`compare` t
pivot of
Ordering
LT -> t -> t -> PSTree t -> t
f t
sum t
target PSTree t
left
Ordering
GT -> t -> t -> PSTree t -> t
f (t
sumforall a. Num a => a -> a -> a
+t
cumulative) t
target PSTree t
right
Ordering
EQ -> t
sumforall a. Num a => a -> a -> a
+t
cumulative
addPSValue :: (Ord n, Num n) => n -> n -> PSTree n -> PSTree n
addPSValue :: forall n. (Ord n, Num n) => n -> n -> PSTree n -> PSTree n
addPSValue n
key n
value PSTree n
tree = if n
value forall a. Eq a => a -> a -> Bool
== n
0 then PSTree n
tree else PSTree n -> PSTree n
f PSTree n
tree
where
f :: PSTree n -> PSTree n
f PSTree n
PSLeaf = forall n. n -> PSTree n -> PSTree n -> n -> PSTree n
PSBranch n
key forall n. PSTree n
PSLeaf forall n. PSTree n
PSLeaf n
value
f (PSBranch n
pivot PSTree n
left PSTree n
right n
sum) =
case n
key forall a. Ord a => a -> a -> Ordering
`compare` n
pivot of
Ordering
LT -> forall n. n -> PSTree n -> PSTree n -> n -> PSTree n
PSBranch n
pivot (PSTree n -> PSTree n
f PSTree n
left) PSTree n
right (n
sum forall a. Num a => a -> a -> a
+ n
value)
Ordering
GT -> forall n. n -> PSTree n -> PSTree n -> n -> PSTree n
PSBranch n
pivot PSTree n
left (PSTree n -> PSTree n
f PSTree n
right) n
sum
Ordering
EQ -> forall n. n -> PSTree n -> PSTree n -> n -> PSTree n
PSBranch n
pivot PSTree n
left PSTree n
right (n
sum forall a. Num a => a -> a -> a
+ n
value)
prop_pstreeSumsCorrectly :: [(Int, Int)] -> [Int] -> Bool
prop_pstreeSumsCorrectly [(Int, Int)]
kvs [Int]
targets =
let
dumbPrefixSums :: [(Int, Int)] -> [Int] -> [Int]
dumbPrefixSums :: [(Int, Int)] -> [Int] -> [Int]
dumbPrefixSums [(Int, Int)]
kvs [Int]
targets =
let prefixSum :: Int -> Int
prefixSum Int
target = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int
v | (Int
k,Int
v) <- [(Int, Int)]
kvs, Int
k forall a. Ord a => a -> a -> Bool
<= Int
target]
in forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
prefixSum [Int]
targets
smartPrefixSums :: [(Int, Int)] -> [Int] -> [Int]
smartPrefixSums :: [(Int, Int)] -> [Int] -> [Int]
smartPrefixSums [(Int, Int)]
kvs [Int]
targets =
let tree :: PSTree Int
tree = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\PSTree Int
tree (Int
pos, Int
shift) -> forall n. (Ord n, Num n) => n -> n -> PSTree n -> PSTree n
addPSValue Int
pos Int
shift PSTree Int
tree) forall n. PSTree n
PSLeaf [(Int, Int)]
kvs
in forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> forall n. (Ord n, Num n) => n -> PSTree n -> n
getPrefixSum Int
x PSTree Int
tree) [Int]
targets
in [(Int, Int)] -> [Int] -> [Int]
smartPrefixSums [(Int, Int)]
kvs [Int]
targets forall a. Eq a => a -> a -> Bool
== [(Int, Int)] -> [Int] -> [Int]
dumbPrefixSums [(Int, Int)]
kvs [Int]
targets
testFix :: [Replacement] -> Fix
testFix :: [Replacement] -> Fix
testFix [Replacement]
list = Fix
newFix {
fixReplacements :: [Replacement]
fixReplacements = [Replacement]
list
}
tFromStart :: Int -> Int -> String -> Int -> Replacement
tFromStart :: Int -> Int -> String -> Int -> Replacement
tFromStart Int
start Int
end String
repl Int
order =
Replacement
newReplacement {
repStartPos :: Position
repStartPos = Position
newPosition {
posLine :: Integer
posLine = Integer
1,
posColumn :: Integer
posColumn = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
start
},
repEndPos :: Position
repEndPos = Position
newPosition {
posLine :: Integer
posLine = Integer
1,
posColumn :: Integer
posColumn = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
end
},
repString :: String
repString = String
repl,
repPrecedence :: Int
repPrecedence = Int
order,
repInsertionPoint :: InsertionPoint
repInsertionPoint = InsertionPoint
InsertAfter
}
tFromEnd :: Int -> Int -> String -> Int -> Replacement
tFromEnd Int
start Int
end String
repl Int
order =
(Int -> Int -> String -> Int -> Replacement
tFromStart Int
start Int
end String
repl Int
order) {
repInsertionPoint :: InsertionPoint
repInsertionPoint = InsertionPoint
InsertBefore
}
prop_simpleFix1 :: Bool
prop_simpleFix1 = String -> String -> [Fix] -> Bool
testFixes String
"hello world" String
"hell world" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
5 Int
5 String
"o" Int
1
]]
prop_anchorsLeft :: Bool
prop_anchorsLeft = String -> String -> [Fix] -> Bool
testFixes String
"-->foobar<--" String
"--><--" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromStart Int
4 Int
4 String
"foo" Int
1,
Int -> Int -> String -> Int -> Replacement
tFromStart Int
4 Int
4 String
"bar" Int
2
]]
prop_anchorsRight :: Bool
prop_anchorsRight = String -> String -> [Fix] -> Bool
testFixes String
"-->foobar<--" String
"--><--" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
4 Int
4 String
"bar" Int
1,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
4 Int
4 String
"foo" Int
2
]]
prop_anchorsBoth1 :: Bool
prop_anchorsBoth1 = String -> String -> [Fix] -> Bool
testFixes String
"-->foobar<--" String
"--><--" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromStart Int
4 Int
4 String
"bar" Int
2,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
4 Int
4 String
"foo" Int
1
]]
prop_anchorsBoth2 :: Bool
prop_anchorsBoth2 = String -> String -> [Fix] -> Bool
testFixes String
"-->foobar<--" String
"--><--" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
4 Int
4 String
"foo" Int
2,
Int -> Int -> String -> Int -> Replacement
tFromStart Int
4 Int
4 String
"bar" Int
1
]]
prop_composeFixes1 :: Bool
prop_composeFixes1 = String -> String -> [Fix] -> Bool
testFixes String
"cd \"$1\" || exit" String
"cd $1" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromStart Int
4 Int
4 String
"\"" Int
10,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
6 Int
6 String
"\"" Int
10
],
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
6 Int
6 String
" || exit" Int
5
]]
prop_composeFixes2 :: Bool
prop_composeFixes2 = String -> String -> [Fix] -> Bool
testFixes String
"$(\"$1\")" String
"`$1`" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromStart Int
1 Int
2 String
"$(" Int
5,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
4 Int
5 String
")" Int
5
],
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromStart Int
2 Int
2 String
"\"" Int
10,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
4 Int
4 String
"\"" Int
10
]]
prop_composeFixes3 :: Bool
prop_composeFixes3 = String -> String -> [Fix] -> Bool
testFixes String
"(x)[x]" String
"xx" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromStart Int
1 Int
1 String
"(" Int
4,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
2 Int
2 String
")" Int
3,
Int -> Int -> String -> Int -> Replacement
tFromStart Int
2 Int
2 String
"[" Int
2,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
3 Int
3 String
"]" Int
1
]]
prop_composeFixes4 :: Bool
prop_composeFixes4 = String -> String -> [Fix] -> Bool
testFixes String
"(x)[x]" String
"xx" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromStart Int
1 Int
1 String
"(" Int
4,
Int -> Int -> String -> Int -> Replacement
tFromStart Int
2 Int
2 String
"[" Int
3,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
2 Int
2 String
")" Int
2,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
3 Int
3 String
"]" Int
1
]]
prop_composeFixes5 :: Bool
prop_composeFixes5 = String -> String -> [Fix] -> Bool
testFixes String
"\"$(x)\"" String
"`x`" [
[Replacement] -> Fix
testFix [
Int -> Int -> String -> Int -> Replacement
tFromStart Int
1 Int
2 String
"$(" Int
2,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
3 Int
4 String
")" Int
2,
Int -> Int -> String -> Int -> Replacement
tFromStart Int
1 Int
1 String
"\"" Int
1,
Int -> Int -> String -> Int -> Replacement
tFromEnd Int
4 Int
4 String
"\"" Int
1
]]
return []
runTests :: IO Bool
runTests = $Bool
String
[(String, Property)]
[(Int, Int)] -> [Int] -> Bool
[(String, Property)] -> (Property -> IO Result) -> IO Bool
forall prop. Testable prop => prop -> IO Result
forall prop. Testable prop => prop -> Property
runQuickCheckAll :: [(String, Property)] -> (Property -> IO Result) -> IO Bool
property :: forall prop. Testable prop => prop -> Property
quickCheckResult :: forall prop. Testable prop => prop -> IO Result
prop_composeFixes5 :: Bool
prop_composeFixes4 :: Bool
prop_composeFixes3 :: Bool
prop_composeFixes2 :: Bool
prop_composeFixes1 :: Bool
prop_anchorsBoth2 :: Bool
prop_anchorsBoth1 :: Bool
prop_anchorsRight :: Bool
prop_anchorsLeft :: Bool
prop_simpleFix1 :: Bool
prop_pstreeSumsCorrectly :: [(Int, Int)] -> [Int] -> Bool
prop_doReplace6 :: Bool
prop_doReplace5 :: Bool
prop_doReplace4 :: Bool
prop_doReplace3 :: Bool
prop_doReplace2 :: Bool
prop_doReplace1 :: Bool
prop_overlap_partial :: Bool
prop_overlap_enclosed :: Bool
prop_overlap_adjacent_zerowidth :: Bool
prop_overlap_contiguous :: Bool
quickCheckAll