PageRenderTime 17ms CodeModel.GetById 4ms app.highlight 10ms RepoModel.GetById 1ms app.codeStats 0ms

/src/Editing/Execute.hs

http://github.com/Eelis/geordi
Haskell | 79 lines | 63 code | 13 blank | 3 comment | 1 complexity | 1f8474c1330a1b7d955c2f71d5680787 MD5 | raw file
 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)