/src/Editing/EditsPreparation.hs

  1{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances, FlexibleContexts, UndecidableInstances, OverlappingInstances, PatternGuards, ViewPatterns #-}
  2
  3module Editing.EditsPreparation (use_tests, findInStr, FindResult(..), FoundIn(..)) where
  4
  5import qualified Cxx.Basics
  6import qualified Cxx.Show
  7import qualified Cxx.Operations
  8import qualified Editing.Diff
  9import qualified Editing.Show
 10import qualified Data.List as List
 11import qualified Data.Char as Char
 12import qualified Data.List.NonEmpty as NeList
 13import Data.Foldable (toList)
 14import Data.Traversable (forM, mapM, sequence)
 15import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty)
 16import Control.Monad (liftM2, join)
 17import Control.Monad.Except (throwError)
 18import Data.SetOps
 19import Util ((.), (‥), Convert(..), Op(..), ops_cost, erase_indexed, levenshtein, replaceAllInfix, approx_match, Cost, Invertible(..), Ordinal(..), test_cmp, multiplicative_numeral, E, or_fail, pairs, NeList, neElim, neHomogenize, safeNth)
 20
 21-- One property that might be suitable for formal verification is that finders only return anchor/ranges/edits contained in the range they received, and that no anchor/range/edit ever goes out of bounds.
 22
 23import Prelude hiding (last, (.), all, sequence, mapM)
 24import Prelude.Unicode hiding ((∈))
 25import Editing.Basics (TextEdit(..), Range(..), Pos(..), Anchor(..), frontAnchor, selectRange, fullRange, replaceRange, Side(..), end, rangeFromTo, unanchor_range, wideRange, StickyRange, find_occs, offset, contained_in, makeMoveEdit, tightRange, stickyRange, merge_contiguous)
 26import Editing.Commands
 27import Request (RequestEdit(..))
 28
 29import Control.Monad.Reader (ReaderT(..), local, ask)
 30
 31{- The present module concerns the translation of commands into Edits. The translation mostly follows the grammatical structure of commands, and so we get translators for various kinds of clauses, most of which will actually yield (lists of) positions and/or ranges rather than Edits, with only the topmost translators yielding actual Edits.
 32
 33Since most edit clauses refer to parts of a subject snippet, the translation from commands to edits is always performed in the context of such a subject. In addition, a context consists of several more things: -}
 34
 35data ResolutionContext = ResolutionContext
 36  { context_suffix :: String
 37  , _given :: String
 38  , fixIt :: Maybe (TextEdit Char)
 39  , search_range :: Range Char -- Todo: Should this not be an StickyRange?
 40  , well_formed :: E (Cxx.Basics.GeordiRequest, Anchor Char → E (Anchor Char))
 41  }
 42
 43-- We will explain each of these fields in more detail, but first introduce a type class for translators, which are just functions run in a reader monad providing the above context, returning types in a certain class.
 44
 45type Resolver = ReaderT ResolutionContext E
 46
 47class InGiven_to_InWf b ⇒ Find a b | a → b where find :: a → Resolver b
 48
 49-- We will describe the InGiven_to_InWf class in a moment. Some fairly obvious Find instances are:
 50
 51instance (Find x a, Find y a) ⇒ Find (Either x y) a where find = either find find
 52instance Find a b ⇒ Find (AndList a) (NeList b) where find = sequence . (find .) . andList
 53
 54-- The _given and search_range fields in ResolutionContext simply specify a string and subrange of that string for the finder to search in. The context_suffix field describes the context (e.g. "after third statement in body of f"). Its only purpose is to make for nicer error messages: when Find instances fail, context_suffix lets us produce error messages like "Could not find `beh` after third statement in body of f."
 55
 56fail_with_context :: String → Resolver a
 57fail_with_context s = (s ++) . context_suffix . ask >>= throwError
 58
 59-- Find instances for things like Relative typically invoke Find instances for constituent clauses on subranges of the range they received themselves. For this we define |narrow|, which simultaneously modifies the search_range and extends the context_suffix:
 60
 61narrow :: String → Range Char → Resolver a → Resolver a
 62narrow x y = local $ \(ResolutionContext z v f _ w) → ResolutionContext (" " ++ x ++ z) v f y w
 63
 64{- To motivate the well_formed field in ResolutionContext and the InGiven_to_InWf class, we must first describe some general edit command properties we desire.
 65
 66Consider the perfectly reasonable composite command "erase first x and move second x to end" executed on the snippet "xyxy". Clearly, we want the result to be "yyx". This means we cannot just execute the two commands in sequence in isolation, because once the first 'x' has been erased, there no longer /is/ a second 'x' to move. We conclude that whenever possible, all commands in a composite command should be translated to edits in the context of the same original snippet. The edits from the different commands should then be merged intelligently (this is done by the Execute module).
 67
 68Now consider the composite command "add ) after ( and erase declaration of i" executed on the snippet "void f(; int i;". Following the principle above to the letter, we should look for a declaration of i in the original snippet. However, since the original snippet does not parse, this would result in an error. This is really unfortunate, because the whole point of the "add ) after (" edit was to make the snippet well-formed. Hence, what we really want is for non-semantic things to be resolved in the original snippet as usual, but for semantic things to be looked up in the original snippet with the fewest number of preceding edits needed to make it well formed applied to it, so that in the above example, the declaration of i is looked for in the snippet as it appears after the "add ) after (" command has been applied to it.
 69
 70Following this idea, a Find instance that needs to do a semantic look-up should not just try to parse _given, but should have access to this notion of "the original snippet with the fewest number of preceding edits needed to make it well formed applied to it" (let us call this "the well-formed snippet"), and that is exactly what the well_formed field is. The 'E' monad is there because there simply may not be a sequence of preceding edits that make the snippet well-formed. The Anchor transformer translates an Anchor in _given to an Anchor in well-formed snippet, encapsulating the actual edits that turn the former into the latter. In particular, the Anchor transformer may be applied to search_range to give the range to search in the well-formed snippet.
 71
 72The anchor/ranges/edits a Find instance might find in well_formed are obviously relative to the well-formed snippet, not to _given (unless they are the same--more about that later). To inform the caller of what a returned anchor/range/edit is relative to, these are wrapped in FindResults: -}
 73
 74data FoundIn = InGiven | InWf deriving Eq
 75data FindResult a = Found FoundIn a
 76
 77instance Functor FindResult where fmap f (Found x y) = Found x (f y)
 78
 79-- Before we explain the InGiven_to_InWf constraint and some of the finer _given vs well_formed points, let us look at some actual Find instances, starting with the one for verbatim strings.
 80
 81instance Find String (NeList (FindResult DualStickyRange)) where
 82  find x = do
 83    ResolutionContext _ s _ r _ ← ask
 84    case nonEmpty $ find_occs x $ selectRange r s of
 85      Nothing → fail_with_context $ "String `" ++ x ++ "` does not occur"
 86      Just l → return $ (Found InGiven . convert . (\o → tightRange $ rangeFromTo (offset (pos (start r)) o :: Pos Char) (offset (pos (start r) + length x) o))) . l
 87
 88{- Since no semantic lookup is needed, Find String only looks in _given, of which it informs its caller by returning values marked Found InGiven. DualStickyRange and Anchor sidedness is described in Editing.Basics.
 89
 90For our next example, we consider the Find instance for "in"-clauses: -}
 91
 92instance (Find a (NeList b)) ⇒ Find (In a) (NeList b) where
 93  find (In o Nothing) = find o
 94  find (In o (Just incl)) = ((full_range .) .) . find incl >>= (join .) . mapM (\(Found a x) →
 95    (case a of InGiven → id; InWf → inwf) $ narrow (Editing.Show.show incl) (convert x) $ find o)
 96
 97-- For the nontrivial case, we first simply search for incl, which yields a number of DualStickyRanges, which we map to their full_range components. Then, for each StickyRange x that was found, we distinguish between two cases. If x is relative to the current _given, we just use |narrow| to focus our attention on x, and try to find |o| there. If x is relative to the well-formed snippet, then we should find |o| in there, too. So in this case, we want to force the Find instance for |o| to search in the well-formed snippet. We do this by first changing _given to the well-formed snippet and setting the Anchor transformer in well_formed to |return|, and then proceeding with |narrow| as before. We realize this with the following utility function:
 98
 99inwf :: InGiven_to_InWf a ⇒ Resolver a → Resolver a
100inwf re = ReaderT $ \(ResolutionContext w _ f r wf) → do
101  (tree, anchor_trans) ← or_fail wf
102  Anchor _ a ← anchor_trans $ Anchor Before $ start r
103  Anchor _ b ← anchor_trans $ Anchor Before $ end r
104  (inGiven_to_inWf .) $ runReaderT re $ ResolutionContext w
105    (Cxx.Show.show_simple tree) f (rangeFromTo a b) (Right (tree, return))
106
107-- Results returned by the re-contexted resolver may be marked as Found InGiven, but since we changed _given to the well-formed snippet, these are really Found InWf, so inwf should adjust them, and that's where the InGiven_to_InWf class comes in.
108
109class InGiven_to_InWf a where inGiven_to_inWf :: a → a
110
111instance InGiven_to_InWf (FindResult a) where inGiven_to_inWf (Found _ x) = Found InWf x
112instance InGiven_to_InWf (Range Char) where inGiven_to_inWf = id
113instance InGiven_to_InWf a ⇒ InGiven_to_InWf (NeList a) where inGiven_to_inWf = fmap inGiven_to_inWf
114instance InGiven_to_InWf a ⇒ InGiven_to_InWf [a] where inGiven_to_inWf = fmap inGiven_to_inWf
115
116-- Next, we look at a Find instance for a typically semantic thing:
117
118instance Find Cxx.Basics.Findable (NeList (FindResult DualStickyRange)) where
119  find d = inwf $ do
120    (tree, _) ← well_formed . ask >>= or_fail
121    r ← search_range . ask
122    case nonEmpty $ filter ((`contained_in` r) . fst) $ Cxx.Operations.find d tree of
123      Nothing → fail_with_context $ "Could not find " ++ show d
124      Just l → return $ fmap (\(q, r'@(Range u h)) →
125        let m = length $ takeWhile (==' ') $ reverse $ selectRange r' (Cxx.Show.show_simple tree) in
126          Found InWf $ DualStickyRange (tightRange q) (tightRange $ (Range u (h-m) :: Range Char))) l
127
128{- Here, we immediately go into wf and do all the work there.
129
130In several other places we can see given-vs.-wf considerations: -}
131
132instance (Invertible a, Find a b, Convert (FindResult (StickyRange Char)) b) ⇒ Find (Relative a) (NeList b) where
133  find (Absolute x) = return . find x
134  find (Relative o (AndList bas) w) = do
135   Found c r ← (unanchor_range . full_range) ‥ find w
136   (case c of InGiven → id; InWf → inwf) $ do
137    u ← search_range . ask
138    forM bas $ \ba → do
139      let h = Editing.Show.show ba ++ " " ++ Editing.Show.show w
140      case ba of
141        Before → narrow h (rangeFromTo (start u) (start r)) $ find (invert o)
142        After → narrow h (rangeFromTo (end r) (end u)) $ find o
143  find (FromTill b e) = do
144   Found c p'@(Anchor _ p) ← (either ($ Before) id .) . find b
145   (case c of InGiven → id; InWf → inwf) $ do
146    sr ← search_range . ask
147    narrow ("after " ++ Editing.Show.show b) (rangeFromTo p (end sr)) $ do
148     Found d y ← either ($ After) id ‥ find e
149     return . convert . Found d . flip stickyRange y . (case d of InGiven → return; InWf → toWf) p'
150  find (Between o be@(Betw b e)) = do
151    Found c x ← find b
152    Found d y ← find e
153    x' ← (if (c, d) == (InGiven, InGiven) ∨ c == InWf then return else toWf) x
154    y' ← (if (c, d) == (InGiven, InGiven) ∨ d == InWf then return else toWf) y
155    (if (c, d) == (InGiven, InGiven) then id else inwf) $ do
156     let (p, q) = if either ($ Before) id x' ≤ either ($ Before) id y' then (x', y') else (y', x')
157     narrow (Editing.Show.show be) (convert $ stickyRange (either ($ After) id p) (either ($ Before) id q)) $ return . find o
158
159-- More documentation some other time!
160
161findInStr :: Find a b ⇒ String → Maybe (TextEdit Char) -> (E (Cxx.Basics.GeordiRequest, Anchor Char → E (Anchor Char))) → a → E b
162findInStr s f e x = runReaderT (find x) $ ResolutionContext "." s f (fullRange s) e
163
164instance Find (Around Substrs) (NeList (FindResult DualStickyRange)) where find (Around x) = find x
165
166instance Convert (FindResult (StickyRange Char)) (NeList (FindResult DualStickyRange)) where
167  convert (Found c x) = return $ Found c $ convert x
168
169instance Find Substrs (NeList (FindResult DualStickyRange)) where
170  find (Substrs l) = join . join . find l
171
172instance Find MakeSubject (NeList (FindResult DualStickyRange)) where
173  find (MakeSubject l) = join . join . find l
174
175class OccurrenceError a where
176  doesNotOccur_n_times :: a → Int → String
177  multipleOccur :: a → String
178
179instance OccurrenceError String where
180  doesNotOccur_n_times s n = "String `" ++ s ++ "` does not occur " ++ multiplicative_numeral (if n < 0 then -n else n+1)
181  multipleOccur s = "String `" ++ s ++ "` occurs multiple times"
182
183instance OccurrenceError Cxx.Basics.Findable where
184  doesNotOccur_n_times s n = "Could not find a " ++ show (Ordinal n) ++ " " ++ Editing.Show.show s
185  multipleOccur s = "Multiple " ++ Cxx.Show.show_plural s ++ " occur"
186
187instance (OccurrenceError a, OccurrenceError b) ⇒ OccurrenceError (Either a b) where
188  doesNotOccur_n_times = either doesNotOccur_n_times doesNotOccur_n_times
189  multipleOccur = either multipleOccur multipleOccur
190
191instance Editing.Show.Show a ⇒ OccurrenceError a where
192  doesNotOccur_n_times s n = Editing.Show.show s ++ " does not occur " ++ multiplicative_numeral (if n < 0 then -n else n+1)
193  multipleOccur s = Editing.Show.show s ++ " occurs multiple times"
194
195instance (OccurrenceError a, Find a (NeList (FindResult DualStickyRange))) ⇒ Find (Ranked a) (FindResult DualStickyRange) where
196  find (Sole x) = find x >>= \l → if null (NeList.tail l) then return $ NeList.head l else fail_with_context $ multipleOccur x
197  find (Ranked (Ordinal n) s) = safeNth n . toList . find s >>= maybe (fail_with_context $ doesNotOccur_n_times s n) return
198
199instance (OccurrenceError a, Find a (NeList (FindResult DualStickyRange))) ⇒ Find (Rankeds a) (NeList (FindResult DualStickyRange)) where
200  find (All x) = find x
201  find (Sole' x) =
202    find x >>= \l → if null (NeList.tail l) then return l else fail_with_context $ multipleOccur x
203  find (Rankeds rs s) = sequence ((\r → find (Ranked r s)) . flatten_occ_clauses rs)
204  find (AllBut rs s) =
205    erase_indexed (ordinal_carrier . toList (flatten_occ_clauses rs)) . toList . find s >>= \z → case z of
206      [] → throwError "All occurrences excluded." -- Todo: Better error.
207      x:y → return $ x :| y
208
209flatten_occ_clauses :: AndList OccurrencesClause → NeList Ordinal
210flatten_occ_clauses (AndList rs) = join $ (\(OccurrencesClause l) → l) . rs
211
212findResult_as_either :: FindResult a → Either a a
213findResult_as_either (Found c a) = (case c of InGiven → Left; InWf → Right) a
214
215merge_contiguous_FindResult_StickyRanges :: NeList (FindResult (StickyRange Char)) → Resolver (FindResult (NeList (StickyRange Char)))
216merge_contiguous_FindResult_StickyRanges l =
217  neHomogenize toWf (findResult_as_either . l) >>= \a → case a of
218    Left xs → return $ Found InGiven $ merge_contiguous xs
219    Right xs → return $ Found InWf $ merge_contiguous xs
220  -- This is not optimal, because wf-ness of one contiguous range should not imply wf-ness of all ranges.
221
222instance Find Substr (FindResult DualStickyRange) where
223  find Everything = Found InGiven . convert . wideRange . search_range . ask
224  find (NotEverything x) = find x
225
226instance Find (EverythingOr (Rankeds (Either Cxx.Basics.Findable String))) (NeList (FindResult DualStickyRange)) where
227  find Everything = return . Found InGiven . convert . wideRange . search_range . ask
228  find (NotEverything x) = find x
229
230instance Find (EverythingOr (Rankeds (Either Cxx.Basics.Findable ImplicitDeclarationOf))) (NeList (FindResult DualStickyRange)) where
231  find Everything = return . Found InGiven . convert . wideRange . search_range . ask
232  find (NotEverything x) = find x
233
234instance Find ImplicitBodyOf (NeList (FindResult DualStickyRange)) where
235  find (ImplicitBodyOf x) = find $ Cxx.Basics.BodyOf x
236
237instance Find ImplicitDeclarationOf (NeList (FindResult DualStickyRange)) where
238  find (ImplicitDeclarationOf x) = find $ Cxx.Basics.DeclarationOf x
239
240instance Find InClause (NeList (FindResult DualStickyRange)) where find (InClause x) = join . join . find x
241
242instance Find AppendPositionsClause (NeList (FindResult (Anchor Char))) where
243  find (NonAppendPositionsClause pc) = find pc
244  find (AppendIn incl) = (((($ After) . full_range) .) .) . find incl
245
246instance Find PrependPositionsClause (NeList (FindResult (Anchor Char))) where
247  find (NonPrependPositionsClause pc) = find pc
248  find (PrependIn incl) = (((($ Before) . full_range) .) .) . find incl
249
250instance Find PositionsClause (NeList (FindResult (Anchor Char))) where
251  find (PositionsClause (AndList bas) x) = do
252    Found w l ← ((replace_range .) .) . find x >>= merge_contiguous_FindResult_StickyRanges
253    return $ l >>= (\e → (\ba → Found w $ e ba) . bas)
254
255instance Find Replacer (NeList (FindResult RequestEdit)) where
256  find (Replacer p r) = do
257    Found c v ← ((replace_range .) .) . find p >>= merge_contiguous_FindResult_StickyRanges
258    return $ (TextEdit . flip RangeReplaceEdit r . convert) ‥ Found c . v
259  find (ReplaceOptions o o') = return $ fmap (Found InGiven) $ RemoveOptions o :| [AddOptions o']
260
261instance Find Changer (NeList (FindResult RequestEdit)) where
262  find (Changer p r) = find (Replacer p r)
263  find (ChangeOptions o o') = find (ReplaceOptions o o')
264
265instance Find Eraser [FindResult RequestEdit] where
266  find (EraseText x) = ((TextEdit . flip RangeReplaceEdit "" . convert . full_range) .) ‥ toList . find x
267  find (EraseOptions o) = return [Found InGiven $ RemoveOptions o]
268  find (EraseAround (Wrapping x y) (Around z)) = do
269    l ← (((unanchor_range . full_range) .) .) . toList . find z
270    (concat .) $ forM l $ \(Found v u) →
271      (case v of InGiven → id; InWf → inwf) $ do
272      sr ← search_range . ask
273      (concat .) $ forM [(Before, x, -1, rangeFromTo (start sr) (start u)), (After, y, 0, rangeFromTo (end u) (end sr))] $ \(ba, xy, i, r) →
274        narrow (Editing.Show.show ba ++ " " ++ Editing.Show.show z) r $
275          find $ EraseText $ Substrs $ and_one $ flip In Nothing $ Absolute $ NotEverything $ Rankeds (and_one $ OccurrencesClause $ return $ Ordinal i) (Right xy)
276
277instance Find Bound (FindResult (Either (StickyRange Char) (Anchor Char))) where
278  find (Bound Nothing Everything) = Found InGiven . Left . stickyRange frontAnchor . Anchor After . Pos . size . search_range . ask
279  find (Bound (Just Before) Everything) = return $ Found InGiven $ Right $ frontAnchor
280  find (Bound (Just After) Everything) = Found InGiven . Right . Anchor After . Pos . size . search_range . ask
281  find (Bound mba p) = ((maybe Left (\ba → Right . ($ ba)) mba . full_range) .) . find p
282
283instance Find RelativeBound (FindResult (Either (StickyRange Char) (Anchor Char))) where
284  find Front = Found InGiven . Right . Anchor Before . start . search_range . ask
285  find Back = Found InGiven . Right . Anchor After . end . search_range . ask
286  find (RelativeBound mba p) = find p >>= \l → if null (NeList.tail l)
287    then return $ maybe Left (\ba → Right . ($ ba)) mba . full_range . NeList.head l
288    else throwError "Relative bound must be singular."
289
290class ToWf a where toWf :: a → Resolver a
291
292instance ToWf (Anchor Char) where toWf a = (((($ a) . snd) .) . well_formed . ask >>= or_fail) >>= or_fail
293instance ToWf (StickyRange Char) where
294  toWf a = do
295    f ← (snd .) . well_formed . ask >>= or_fail
296    liftM2 stickyRange (or_fail (f $ a Before)) (or_fail (f $ a After))
297
298instance (ToWf a, ToWf b) ⇒ ToWf (Either a b) where
299  toWf (Left x) = Left . toWf x
300  toWf (Right x) = Right . toWf x
301
302makeMoveEdit' :: FindResult (Anchor Char) → FindResult (StickyRange Char) → Resolver (FindResult (TextEdit Char))
303makeMoveEdit' (Found InGiven a) (Found InGiven r) = Found InGiven . makeMoveEdit a (convert r)
304makeMoveEdit' (Found InWf a) (Found c x) = do
305  r ← (case c of InGiven → toWf; InWf → return) x
306  Found InWf . makeMoveEdit a (convert r)
307makeMoveEdit' (Found c x) (Found InWf r) = do
308  a' ← (case c of InGiven → toWf; InWf → return)  x
309  Found InWf . makeMoveEdit a' (convert r)
310
311makeSwapEdit :: FindResult (StickyRange Char) → FindResult (StickyRange Char) → Resolver [FindResult (TextEdit Char)]
312makeSwapEdit a b = do
313  some ← makeMoveEdit' (($ Before) . b) a
314  more ← makeMoveEdit' (($ Before) . a) b
315  return [some, more]
316
317instance Find Mover [FindResult (TextEdit Char)] where
318  find (Mover o p) = do
319    a ← find p
320    toList . find o >>= mapM (makeMoveEdit' a . (full_range .)) . reverse
321
322instance Find Position (FindResult (Anchor Char)) where
323  find (Position ba x) = find x >>= \l → if null (NeList.tail l)
324    then return $ flip full_range ba . (NeList.head l)
325    else throwError "Anchor position must be singular."
326
327instance Find UsePattern (FindResult (Range Char)) where
328  find (UsePattern z) = do
329    ResolutionContext _ s _ r _ ← ask
330    let
331      text_tokens = edit_tokens Char.isAlphaNum $ selectRange r s
332      pattern_tokens = edit_tokens Char.isAlphaNum z
333      (x, y) = (sum $ length . take stt text_tokens, sum $ length . take siz (drop stt text_tokens))
334      (owc, stt, siz) = head $ approx_match token_edit_cost pattern_tokens (replaceAllInfix pattern_tokens (replicate (length pattern_tokens) (replicate 100 'X')) text_tokens)
335    if y == 0 ∨ ops_cost owc > fromIntegral (length z) / 1.5 then fail_with_context $ "No non-exact match for " ++ z else return $ Found InGiven $ offset (pos (start r)) $ Range (Pos x) y
336
337instance Invertible UsePattern where invert = id
338
339instance Convert (FindResult (Range a)) (FindResult (Range a)) where convert = id
340
341instance Find UseClause (NeList (FindResult RequestEdit)) where
342  find (UseOptions o) = return $ return $ Found InGiven $ AddOptions o
343  find (UseString ru@(In b _)) = case unrelative b of
344    Nothing → throwError "Nonsensical use-command."
345    Just (UsePattern v) → (((TextEdit . flip RangeReplaceEdit v) .) .) . find ru
346
347token_edit_cost :: Op String → Cost
348token_edit_cost (SkipOp (' ':_)) = 0
349token_edit_cost (SkipOp x) | x ∈ Cxx.Basics.keywords = -2.4
350token_edit_cost (SkipOp (h:t)) | Char.isAlphaNum h = -2.2 - fromIntegral (length t) * 0.2
351token_edit_cost (SkipOp _) = -2
352token_edit_cost (EraseOp (' ':_)) = 0.02
353token_edit_cost (EraseOp x) = token_edit_cost (InsertOp x)
354token_edit_cost (InsertOp t) | t ∈ Cxx.Basics.keywords = 2
355token_edit_cost (InsertOp (' ':_)) = -0.02
356token_edit_cost (InsertOp x@(y:_)) | Char.isAlpha y = fromIntegral (length x) * 0.7
357token_edit_cost (InsertOp (x:y)) | Char.isDigit x = 1 + fromIntegral (length y) * 0.3
358token_edit_cost (InsertOp _) = 1
359token_edit_cost (ReplaceOp x y)
360  | or $ (\c → List.all (∈ c) [x, y]) . [Cxx.Basics.classKeys, Cxx.Basics.accessSpecifiers, Cxx.Basics.relational_ops] = 0.4
361token_edit_cost (ReplaceOp (c:_) (d:_)) | not $ Char.isAlphaNum c ∨ Char.isAlphaNum d = 1.1
362token_edit_cost (ReplaceOp x@(c:_) y@(d:_)) | Char.isAlpha c, Char.isAlpha d =
363  if null (x ∩ y) then 10 else levenshtein x y * 0.4
364token_edit_cost (ReplaceOp x@(c:_) y@(d:_)) | Char.isAlphaNum c, Char.isAlphaNum d = levenshtein x y * 0.8
365token_edit_cost (ReplaceOp _ _) = 10
366  -- The precise values of these costs are fine-tuned to make the tests pass, and that is their only justification. We're trying to approximate the human intuition for what substring should be replaced, as codified in the tests.
367
368instance Find Command [FindResult RequestEdit] where
369  find (Use l) = toList . join . find l
370  find (Append x Nothing) = do
371    r ← search_range . ask
372    return [Found InGiven $ TextEdit $ InsertEdit (Anchor After (Pos (size r))) x]
373  find (Prepend x Nothing) = return [Found InGiven $ TextEdit $ InsertEdit frontAnchor x]
374  find (Append r (Just p)) = toList . (((TextEdit . flip InsertEdit r) .) .) . join . find p
375  find (Prepend r (Just p)) = toList . (((TextEdit . flip InsertEdit r) .) .) . join . find p
376  find (Erase (AndList l)) = concat . sequence (find . toList l)
377  find (Replace (AndList l)) = concat . sequence ((toList .) . find . toList l)
378  find (Change (AndList l)) = concat . sequence ((toList .) . find . toList l)
379  find (Insert (SimpleInsert r) p) = toList . (((TextEdit . flip InsertEdit r) .) .) . join . find p
380  find (Insert (WrapInsert (Wrapping x y)) (AndList z)) =
381    concatMap (\(Found v a, Found w b) → [Found v $ TextEdit $ InsertEdit a x, Found w $ TextEdit $ InsertEdit b y]) . pairs . concat . map toList . sequence (map find $ toList z)
382  find (Move (AndList movers)) = ((TextEdit .) .) . concat . sequence (find . toList movers)
383  find (Swap substrs Nothing) = toList . ((replace_range .) .) . find substrs >>= f
384    where
385      f [] = return []
386      f (a:b:c) = liftM2 (++) (((TextEdit .) .) . makeSwapEdit a b) (f c)
387      f _ = throwError "Cannot swap uneven number of operands."
388  find (Swap substrs (Just substrs')) = do
389    Found v x ← ((full_range .) .) . find substrs >>= merge_contiguous_FindResult_StickyRanges
390    Found w y ← ((full_range .) .) . find substrs' >>= merge_contiguous_FindResult_StickyRanges
391    let a = Found v . x; b = Found w . y
392    if null (NeList.tail a) && null (NeList.tail b) then ((TextEdit .) .) . makeSwapEdit (NeList.head a) (NeList.head b)
393     else throwError "Swap operands must be contiguous ranges."
394  find (Make s b) = inwf $ do
395    (tree, _) ← well_formed . ask >>= or_fail
396    l ← (fmap (\(Found _ x) → replace_range x)) . find s
397    (Found InGiven .) . concat . toList . forM l (\x →
398      (TextEdit .) . Cxx.Operations.make_edits (convert x) b 0 tree)
399  find Fix = do
400    mf ← fixIt . ask
401    case mf of
402      Nothing → throwError "No fix available."
403      Just f → return [Found InGiven $ TextEdit f]
404
405use_tests :: IO ()
406use_tests = do
407  t "ETYPE_DESC" "ETPYE" "Replaced `<< ETPYE` with `<< ETYPE_DESC`." "Replaced `<< ETYPE_DESC` with `<< ETPYE`."
408  t "kip(a.~T)" "a.~T" "Replaced a.~T with kip(a.~T)." "Replaced kip(a.~T) with a.~T."
409  -- t "cos(a.~T)" "a.~T" -- Fails, but can probably be made to work by rewarding successive skips.
410  t "size_type" "size_t" "Replaced `string::size_t- siz` with `string::size_type- siz`." "Replaced `string::size_type- siz` with `string::size_t- siz`."
411  t "size = 9" "siz = 2" "Replaced `string::size_t- siz = 2` with `string::size_t- size = 9`." "Replaced `string::size_t- size = 9` with `string::size_t- siz = 2`."
412  t "ETYPE" "ETPYE" "Replaced `<< ETPYE` with `<< ETYPE`." "Replaced `<< ETYPE` with `<< ETPYE`."
413  t "std::string" "string" "Replaced `string::size_t- siz` with `std::string::size_t- siz`." "Replaced `std::string::size_t- siz` with `string::size_t- siz`."
414  t "; float x" "; int x" "Replaced `int x` with `float x`." "Replaced `float x` with `int x`."
415  t "x-" "x -" "Replaced `x - size` with `x- size`." "Replaced `x- size` with `x - size`."
416  t ") cin <<" ") cout <<" "Replaced cout with cin." "Replaced cin with cout."
417  t "x = 4" "x = 3" "Replaced 3 with 4." "Replaced 4 with 3."
418  t "x - 8);" "x - size);" "Replaced `x - size` with `x - 8`." "Replaced `x - 8` with `x - size`."
419  t "(!i)" "(i == 0)" "Replaced `i == 0` with !i."  "Replaced !i with `i == 0`."
420  t "seekp" "seek" "Replaced a.seek with a.seekp." "Replaced a.seekp with a.seek."
421  t "<char>" "<unsigned char>" "Replaced `vector<unsigned char> & r` with `vector<char> & r`." "Replaced `vector<char> & r` with `vector<unsigned char> & r`."
422  t "<const fish>" "<fish>" "Replaced `reinterpret_cat<fish>` with `reinterpret_cat<const fish>`." "Replaced `reinterpret_cat<const fish>` with `reinterpret_cat<fish>`."
423  t "&); };" "&) };" "Inserted semicolon after `C const &)`." "Erased semicolon after `C const &)`."
424  t "> * r = v" "> & r = v" "Replaced `& r` with `* r`." "Replaced `* r` with `& r`."
425  t "v.cbegin()" "v.begin()" "Replaced v.begin with v.cbegin." "Replaced v.cbegin with v.begin."
426  -- Todo: "void foo" should match "voidfoo".
427--  t "x - sizeof(y))" "x - size)" "Replaced `x - size` with `x - sizeof(y)`." "Replaced `x - sizeof(y))` with `x - size)`."
428  t "int a(2);" "int a;" "Inserted (2) after `{ int a`." "Erased (2) after `{ int a`."
429  t "int const * w" "int * w" "Replaced `int * w` with `int const * w`." "Replaced `int const * w` with `int * w`."
430  t "main(int argc) {" "main() {" "Inserted `int argc` after `void main(`." "Erased `int argc`."
431  t "_cast" "_cat" "Replaced `reinterpret_cat<fish>` with `reinterpret_cast<fish>`." "Replaced `reinterpret_cast<fish>` with `reinterpret_cat<fish>`."
432  t "(++a)" "(a++)" "Replaced a++ with ++a." "Replaced ++a with a++."
433  t "list<int>" "vector<int>" "Replaced `vector<int> v` with `list<int> v`." "Replaced `list<int> v` with `vector<int> v`."
434  t "a->seekp" "a.seek" "Replaced a.seek with a->seekp." "Replaced a->seekp with a.seek."
435  t "vector<int>::iterator i" "vector<int> i" "Replaced `vector<int> i` with `vector<int>::iterator i`." "Replaced `vector<int>::iterator i` with `vector<int> i`."
436  t "runtime_error(" "runtime_exception(" "Replaced `throw runtime_exception` with `throw runtime_error`." "Replaced `throw runtime_error` with `throw runtime_exception`."
437  t "~T();" "~T;" "Inserted () after `) { a.~T`." "Erased () after `) { a.~T`." -- Todo: ugly.
438  t "int const * w" "int * w" "Replaced `int * w` with `int const * w`." "Replaced `int const * w` with `int * w`."
439  t "(T & a)" "(T a)" "Replaced `T a` with `T & a`." "Replaced `T & a` with `T a`."
440  t "& r(v);" "& r = v;" "Replaced `= v` after `vector<unsigned char> & r` with (v)." "Replaced (v) after `vector<unsigned char> & r` with `= v`."
441  t "ios_base::end_t" "ios::end" "Replaced ios::end with `ios_base::end_t`.""Replaced `ios_base::end_t` with ios::end."
442  t "95" "94" "Replaced 94 with 95." "Replaced 95 with 94."
443  t "vector<int> const v { 3, 2 };" "vector<int> v; v = { 3, 2 };" "Replaced `vector<int> v; v =` with `vector<int> const v`." "Replaced `vector<int> const v` with `vector<int> v; v =`."
444  t "class C" "struct C" "Replaced `struct C` with `class C`." "Replaced `class C` with `struct C`."
445  t "B z{p};" "B z = B{p};" "Erased `= B` after `B z`." "Inserted `= B` after `B z`."
446  t "friend C & operator+" "C & operator+" "Inserted friend before `C & operator+`." "Erased friend before `C & operator+`."
447  t "char const(&here)[N]" "char(const&here)[N]" "Replaced `char(const&here` with `char const(&here`." "Replaced `char const(&here` with `char(const&here`."
448  t "z = shared_ptr<B>{new p}" "z = B{p}" "Replaced B{p with `shared_ptr<B>{new p`." "Replaced `shared_ptr<B>{new p` with B{p." -- Todo: ugly.
449  t "(X(y));" "X(y);" "Inserted ( before X(y) and inserted ) after `} X(y)`." "Erased ( before X(y)) and ) after `} (X(y)`." -- Todo: ugly.
450  t "2000" "1800" "Replaced 1800 with 2000." "Replaced 2000 with 1800."
451  t "8000100808" "10000000000" "Replaced 10000000000 with 8000100808." "Replaced 8000100808 with 10000000000."
452  t "> 7" ">= 7" "Replaced `x >= 7` with `x > 7`." "Replaced `x > 7` with `x >= 7`."
453  t "private: fstream" "public: fstream" "Replaced `public: fstream p` with `private: fstream p`." "Replaced `private: fstream p` with `public: fstream p`." -- Todo: "replaced public: with private: before fstream p".
454  t "int main" "void main" "Replaced `void main` with `int main`." "Replaced `int main` with `void main`." -- Todo: One day this should say: "Made main return int."
455  t "<char>" "<unsigned char>" "Replaced `vector<unsigned char> & r` with `vector<char> & r`." "Replaced `vector<char> & r` with `vector<unsigned char> & r`."
456  t "int const u =" "int x =" "Replaced `int x` with `int const u`." "Replaced `int const u` with `int x`."
457  t "u - -j" "u--j" "Replaced &u--j with `&u - -j`." "Replaced `&u - -j` with &u--j."
458  t "struct C{" "struct C(){" "Erased () after `struct C`." "Inserted () after `struct C`."
459  --t "&ETPYE" "ETPYE" "Replaced ETPYE with &ETPYE." "Replaced &ETPYE with ETPYE."
460  putStrLn "All use tests passed."
461 where
462  u :: String → String → String → String → String → IO ()
463  u txt pattern match d rd =
464    case runReaderT (find (UseString $ flip In Nothing $ Absolute $ UsePattern pattern)) (ResolutionContext "." txt Nothing (fullRange txt) (Left "-")) of
465      Left e → fail e
466      Right (neElim → (Found _ (TextEdit (RangeReplaceEdit rng _)), [])) → do
467        test_cmp pattern match (selectRange rng txt)
468        let r = replaceRange rng pattern txt
469        test_cmp pattern d $ show $ Editing.Diff.diff txt r
470        test_cmp (pattern ++ " (reverse)") rd $ show $ Editing.Diff.diff r txt
471      _ → error "should not happen"
472  t :: String → String → String → String → IO ()
473  t = u "{ string::size_t- siz = 2; int x = 3; if(i == 0) cout << ETPYE(x - size); vector<int> v; v = { 3, 2 }; vector<int> i = reinterpret_cat<fish>(10000000000, v.begin()); } X(y); using tracked::B; B z = B{p}; int const u = 94; int * w = &u--j; !B && !D; vector<unsigned char> & r = v; struct C(){ C & operator+(ostream &, char(const&here)[N], C const &) }; template<typename T> voidfoo(T a) { a.~T; } void main() { int a; a.seek(1800, ios::end); foo(a++); if(x >= 7) throw runtime_exception(y); } class Qbla { public: fstream p; };"