/src/Editing/Execute.hs

 1{-# LANGUAGE UnicodeSyntax, PatternGuards, ScopedTypeVariables, TypeSynonymInstances, ViewPatterns, FlexibleContexts, RecordWildCards, MultiParamTypeClasses #-}
 2
 3module Editing.Execute (execute) where
 4
 5import qualified Data.Set as Set
 6import qualified Cxx.Parse
 7
 8import Editing.EditsPreparation (FindResult(..), FoundIn(..), findInStr)
 9
10import Control.Monad (foldM)
11import Data.Monoid (Monoid(..))
12import Control.Applicative ((<|>))
13import Control.Arrow ((&&&))
14import Request (EditableRequest(..), EditableRequestKind(..), RequestEdit(..), addEvalOpt)
15import Cxx.Basics (GeordiRequest)
16import Util ((.), E, MaybeApply(..), Apply(..), MyMonadError(..))
17
18import Prelude hiding ((.))
19import Editing.Basics
20import Editing.Commands
21
22editRequestBody :: (String → String) → (EditableRequest → EditableRequest)
23editRequestBody f (EditableRequest k s) = EditableRequest k (f s)
24
25instance MaybeApply RequestEdit EditableRequest where
26  mapply e er@EditableRequest{..} = case e of
27    TextEdit te → return $ editRequestBody (apply te) er
28    RemoveOptions opts
29      | Evaluate f ← kind → return er{ kind = Evaluate $ (Set.\\) f $ Set.fromList opts }
30      | otherwise → throwError $ "Cannot remove evaluation options from \"" ++ show kind ++ "\" request."
31    AddOptions opts
32      | Evaluate f ← kind → return er{ kind = Evaluate $ foldr addEvalOpt f opts }
33      | otherwise → throwError $ "Cannot use evaluation options for \"" ++ show kind ++ "\" request."
34
35data FoldState = FoldState
36  { adjust_since_start :: Adjuster Char
37  , current_request :: EditableRequest
38  , milepost :: E WellFormedMilepost }
39
40data WellFormedMilepost = WellFormedMilepost
41  { tree :: GeordiRequest
42  , adjust_to_wf :: Adjuster Char
43  , adjust_since_wf :: Adjuster Char }
44      -- The earliest well-formed AST of the request body, its String version, an adjuster adjusting anchors in the original request to anchors in the well-formed request, and an adjuster adjusting edits in the well-formed request to edits in the current request.
45
46fold_edit :: RequestEdit → FoldState → E FoldState
47  -- The edit must be relative to the current request in the fold state (sequence_edit's job).
48fold_edit e fs = do
49  r ← mapply e $ current_request fs
50  let
51    f req = WellFormedMilepost req (adjust_since_start new) mempty
52    a = case e of TextEdit te → adjuster (editable_body $ current_request fs) te; _ → mempty
53    new = FoldState
54      (adjust_since_start fs `mappend` a)
55      r
56      (((\mp → mp { adjust_since_wf = adjust_since_wf mp `mappend` a }) . milepost fs) <|>
57        f . Cxx.Parse.parseRequest (editable_body r))
58  return new
59
60sequence_edit :: FoldState → FindResult RequestEdit → E FoldState
61sequence_edit fs (Found f e) = do
62  a :: Adjuster Char ← case f of
63    InGiven → return $ adjust_since_start fs
64    InWf → adjust_since_wf . milepost fs
65  case e of
66    TextEdit e' → do
67      t ← (TextEdit .) . editAdjuster a e'
68      maybe return fold_edit t fs
69    _ → fold_edit e fs
70
71exec_cmd :: Maybe (TextEdit Char) -> String → FoldState → Command → E FoldState
72exec_cmd fixit s fs = (>>= foldM sequence_edit fs) .
73  findInStr s fixit ((tree &&& anchorAdjuster . adjust_to_wf) . milepost fs)
74
75execute :: Maybe (TextEdit Char) -> [Command] → EditableRequest → E EditableRequest
76execute fixit l r@(EditableRequest _ s) = current_request . foldM (exec_cmd fixit s) fs l
77  where
78    f t = WellFormedMilepost t mempty mempty
79    fs = (FoldState mempty r $ f . Cxx.Parse.parseRequest s)