RefactorReduce.hs

{-# LANGUAGE TypeFamilies #-}

module Descript.BasicInj.Process.Refactor.RefactorReduce
  ( refactorReduce
  ) where

import Descript.BasicInj.Process.Reduce.SrcAnn
import qualified Descript.BasicInj.Traverse.Term as T
import Descript.BasicInj.Process.Validate
import Descript.BasicInj.Traverse
import qualified Descript.BasicInj.Data.Value.In as In
import qualified Descript.BasicInj.Data.Value.Out as Out
import Descript.BasicInj.Data
import Descript.Misc
import Data.Semigroup as S
import Data.Monoid as M
import Data.Functor.Identity
import Core.Control.Monad.Trans
import Control.Monad.Trans.Writer.Strict

data RefactorReduce = RefactorReduce (PhaseCtx ())

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

  tonTerm T.PhaseCtx (RefactorReduce phase) = pure . reducePhase phase
  tonTerm T.RegValue (RefactorReduce phase) = pure . reduceReg phase
  tonTerm _ _ = pure

-- | Replaces the left (input) value with the right (output) within
-- every value in the source, including reducers.
refactorReduce :: DirtyDep SrcAnn
               -> In.Value SrcAnn
               -> Out.Value SrcAnn
               -> RefactorFunc Source
refactorReduce dextra old new x = do
  validateForRefactor $ Depd dextra x -- Handles dependency errors
  -- Ignores dependency errors, already handled
  validateForRefactorIn T.Reducer fullMod reducer
  rehoist $ refactorReduce' T.Source (PhaseCtx () [reducer_]) x
  where reducer = Reducer (getAnn old S.<> getAnn new) old new
        reducer_ = remAnns reducer
        fullMod = sourceAModule_ x M.<> dirtyVal dextra

-- | Applies the reducer to every value in the node, including other
-- reducers (it's a macro reducer).
refactorReduce' :: TTerm t -> PhaseCtx () -> RefactorFunc t
refactorReduce' term phase = travTerm term $ RefactorReduce phase