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