{-# LANGUAGE ScopedTypeVariables
           , LambdaCase
           , MultiWayIf
           #-}
module Language.Haskell.Tools.Refactor.RenameDefinition (renameDefinition, renameDefinition') where

import Name hiding (Name)
import GHC (Ghc, TyThing(..), lookupName)
import qualified GHC
import OccName
import SrcLoc

import Control.Reference hiding (element)
import Control.Monad.State
import Control.Monad.Trans.Except
import Data.Data
import Data.Maybe
import Data.Generics.Uniplate.Data
import Language.Haskell.Tools.AST
import Language.Haskell.Tools.AnnTrf.SourceTemplate
import Language.Haskell.Tools.AST.Gen
import Language.Haskell.Tools.Refactor.RefactorBase

import Debug.Trace

renameDefinition' :: forall n . (NamedThing n, Data n) => RealSrcSpan -> String -> Ann Module (STWithNames n) -> RefactoredModule n
renameDefinition' sp str mod
  = case (getNodeContaining sp mod :: Maybe (Ann SimpleName (STWithNames n))) >>= (fmap getName . (^? semantics&nameInfo)) of 
      Just n -> renameDefinition n str mod
      Nothing -> refactError "No name is selected"

renameDefinition :: forall n . (NamedThing n, Data n) => GHC.Name -> String -> Ann Module (STWithNames n) -> RefactoredModule n
renameDefinition toChange newName mod 
    = do nameCls <- classifyName toChange
         (res,defFound) <- runStateT (biplateRef !~ changeName toChange newName $ mod) False
         if | not (nameValid nameCls newName) -> refactError "The new name is not valid"
            | not defFound -> refactError "The definition to rename was not found"
            | otherwise -> return res
  where     
    changeName :: GHC.Name -> String -> Ann SimpleName (STWithNames n) -> StateT Bool (Refactor n) (Ann SimpleName (STWithNames n))
    changeName toChange str elem 
      = if | fmap getName (elem ^? semantics&nameInfo) == Just toChange
               && (elem ^? semantics&isDefined) == Just False
               && any ((str ==) . occNameString . getOccName) (maybe [] head (elem ^? semantics & scopedLocals))
             -> lift $ refactError "The definition clashes with an existing one" -- name clash with an external definition
           | fmap getName (elem ^? semantics&nameInfo) == Just toChange
             -> do modify (|| fromMaybe False (elem ^? semantics&isDefined)) 
                   return $ element & unqualifiedName .= mkNamePart str $ elem
           | let namesInScope = fromMaybe [] (elem ^? semantics & scopedLocals)
                 actualName = maybe toChange getName (elem ^? semantics & nameInfo)
              in str == occNameString (getOccName actualName) && sameNamespace toChange actualName 
                   && conflicts toChange actualName namesInScope
             -> lift $ refactError "The definition clashes with an existing one" -- local name clash
           | otherwise -> return elem

conflicts :: GHC.Name -> GHC.Name -> [[GHC.Name]] -> Bool
conflicts overwrites overwritten (scopeBlock : scope) 
  | overwritten `elem` scopeBlock && overwrites `notElem` scopeBlock = False
  | overwrites `elem` scopeBlock = True
  | otherwise = conflicts overwrites overwritten scope
conflicts _ _ [] = False

sameNamespace :: GHC.Name -> GHC.Name -> Bool
sameNamespace n1 n2 = occNameSpace (getOccName n1) == occNameSpace (getOccName n2)