RenameProp.hs

{-# LANGUAGE TypeFamilies #-}

module Descript.BasicInj.Process.Refactor.RenameProp
  ( renameProp
  , renameProp'
  ) where

import Descript.BasicInj.Process.Refactor.GenRenameSymbol
import qualified Descript.BasicInj.Traverse.Term as T
import Descript.BasicInj.Traverse
import Descript.BasicInj.Data
import Descript.Misc
import Data.Functor.Identity
import Control.Monad.Trans.Writer.Strict

data RenameProp = RenameProp (FSymbol ()) (GenRenameSymbol Symbol)

instance Traversal RenameProp where
  type Eff RenameProp = ResultT RefactorError (WriterT [RefactorWarning] Identity)
  type TAnn RenameProp = SrcAnn

  tonTerm T.RecordType (RenameProp target rsym) x@(RecordType ann head' props)
      | head' /@= target = pure x
      | otherwise
      = RecordType ann head'
    <$> traverse (renameSymbol rsym) props
  tonTerm T.GenRecord (RenameProp target rsym) x@(Record ann head' props)
      | head' /@= target = pure x
      | otherwise
      = Record ann head'
    <$> traverse (renameLocalProp rsym) props
  tonTerm T.PathElem (RenameProp target rsym) x@(PathElem ann propKey' headKey')
      | headKey' /@= target = pure x
      | otherwise
      = PathElem ann
    <$> renameSymbol rsym propKey'
    <*> pure headKey'
  tonTerm _ _ x = pure x

-- | Replaces every occurrence of the first property with the second,
-- in the record with the given head.
renameProp :: String -> String -> String -> RefactorFunc Source
renameProp head' old new src
  = renameProp' T.Source (mkFSymbol head') (Symbol () old) (Symbol () new) src
  where mkFSymbol = FSymbol (sourceScope src) . Symbol ()

-- | Replaces every occurrence of the first property with the second,
-- in the record with the given head.
renameProp' :: TTerm t -> FSymbol () -> Symbol () -> Symbol () -> RefactorFunc t
renameProp' term head' old new = travTerm term $ RenameProp head' $ GenRenameSymbol old new

renameLocalProp :: GenRenameSymbol Symbol -> RefactorFunc (GenProperty v)
renameLocalProp rsym (Property ann key val)
  = Property ann <$> renameSymbol rsym key <*> pure val