Refactor.hs

module Descript.Build.Refactor
  ( RefactorAction (..)
  , parseRefactor
  , parseRefactorAction
  , refactor
  ) where

import Descript.Build.Read
import qualified Descript.BasicInj as BasicInj
import Descript.Misc
import qualified Data.Text as Text
import Control.Monad
import Core.Control.Monad.Trans
import Control.Monad.Trans.Class

data RefactorAction
  = RenameRecord String String
  | RenameProp String String String
  | RefactorReduce String String
  deriving (Eq, Ord, Read, Show)

-- | Parses a refactor action from command-line arguments,
-- then runs the action.
parseRefactor :: (Monad u)
              => String
              -> [String]
              -> DFile u
              -> RefactorResultT u Patch
parseRefactor label args file
    = (`refactor` file)
  =<< hoist (parseRefactorAction label args)

-- | Parses a refactor action from command-line arguments.
-- The string is the action label, the list contains the args.
parseRefactorAction :: String -> [String] -> Result RefactorError RefactorAction
parseRefactorAction "rename-record" [old, new]
  = Success $ RenameRecord old new
parseRefactorAction "rename-record" args
  = Failure $ BadRefactorArgs "rename-record" 2 args
parseRefactorAction "rename-property" [head', old, new]
  = Success $ RenameProp head' old new
parseRefactorAction "rename-property" args
  = Failure $ BadRefactorArgs "rename-property" 3 args
parseRefactorAction "reduce" [old, new]
  = Success $ RefactorReduce old new
parseRefactorAction "reduce" args
  = Failure $ BadRefactorArgs "reduce" 2 args
parseRefactorAction label args
  = Failure $ UnsupportedRefactorAction label args

-- | Parses a source file, refactors it, and returns a patch to update
-- the original file.
refactor :: (Monad u) => RefactorAction -> DFile u -> RefactorResultT u Patch
refactor (RenameRecord old new) file
  = refactorViaBasic (BasicInj.renameRecord old new) file
refactor (RenameProp head' old new) file
  = refactorViaBasic (BasicInj.renameProp head' old new) file
refactor (RefactorReduce old new) file = do
  Depd ddep src <- presToRRes Nothing $ readSrc file
  let dep = dirtyVal ddep
      dsrc = Depd dep src
      scope = BasicInj.sourceScope src
      ctx = BasicInj.recordCtx $ BasicInj.dsourceAModule dsrc
  old' <- refIRead (readInputValIn scope ctx) $ ifile $ Text.pack old
  let old_ = remAnns old'
  new' <- refIRead (readOutputValIn scope ctx old_) $ ifile $ Text.pack new
  refactorViaBasic (BasicInj.refactorReduce ddep old' new') file

refactorViaBasic :: (Monad u)
                 => RefactorFunc BasicInj.Source
                 -> DFile u
                 -> RefactorResultT u Patch
refactorViaBasic f = refactorViaBasicT $ rehoist . f

refactorViaBasicT :: (Monad u)
                  => RefactorFuncT u BasicInj.Source
                  -> DFile u
                  -> RefactorResultT u Patch
refactorViaBasicT f = fmap ppatch . f . depdVal <=< refRead

refRead :: (Monad u) => DFile u -> RefactorResultT u (DirtyDepd BasicInj.Source SrcAnn)
refRead = presToRRes Nothing . readSrc

refIRead :: (Monad u)
         => (SFile -> ParseResult a)
         -> SFile
         -> RefactorResultT u a
refIRead readSrc' isrc = presToRRes (Just isrc) $ hoist $ readSrc' isrc

presToRRes :: (Monad u) => Maybe SFile -> ParseResultT u a -> RefactorResultT u a
presToRRes isrc = mapInner lift . mapErrorT (RefactorParseError isrc)