{-# LANGUAGE LambdaCase #-}

module Refact
    ( toRefactSrcSpan
    , toSS
    , checkRefactor, refactorPath, runRefactoring
    ) where

import Control.Exception.Extra
import Control.Monad
import Data.Maybe
import Data.Version.Extra
import GHC.LanguageExtensions.Type
import System.Directory.Extra
import System.Exit
import System.IO.Extra
import System.Process.Extra
import qualified Refact.Types as R

import qualified SrcLoc as GHC

toRefactSrcSpan :: GHC.SrcSpan -> R.SrcSpan
toRefactSrcSpan :: SrcSpan -> SrcSpan
toRefactSrcSpan = \case
    GHC.RealSrcSpan RealSrcSpan
span ->
        Int -> Int -> Int -> Int -> SrcSpan
R.SrcSpan (RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
span)
                  (RealSrcSpan -> Int
GHC.srcSpanStartCol RealSrcSpan
span)
                  (RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
span)
                  (RealSrcSpan -> Int
GHC.srcSpanEndCol RealSrcSpan
span)
    GHC.UnhelpfulSpan FastString
_ ->
        Int -> Int -> Int -> Int -> SrcSpan
R.SrcSpan (-Int
1) (-Int
1) (-Int
1) (-Int
1)

-- | Don't crash in case ghc gives us a \"fake\" span,
-- opting instead to show @-1 -1 -1 -1@ coordinates.
toSS :: GHC.HasSrcSpan a => a -> R.SrcSpan
toSS :: a -> SrcSpan
toSS = SrcSpan -> SrcSpan
toRefactSrcSpan (SrcSpan -> SrcSpan) -> (a -> SrcSpan) -> a -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc

checkRefactor :: Maybe FilePath -> IO FilePath
checkRefactor :: Maybe FilePath -> IO FilePath
checkRefactor = Maybe FilePath -> IO (Either FilePath FilePath)
refactorPath (Maybe FilePath -> IO (Either FilePath FilePath))
-> (Either FilePath FilePath -> IO FilePath)
-> Maybe FilePath
-> IO FilePath
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (FilePath -> IO FilePath)
-> (FilePath -> IO FilePath)
-> Either FilePath FilePath
-> IO FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO FilePath
forall a. Partial => FilePath -> IO a
errorIO FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure

refactorPath :: Maybe FilePath -> IO (Either String FilePath)
refactorPath :: Maybe FilePath -> IO (Either FilePath FilePath)
refactorPath Maybe FilePath
rpath = do
    let excPath :: FilePath
excPath = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"refactor" Maybe FilePath
rpath
    Maybe FilePath
mexc <- FilePath -> IO (Maybe FilePath)
findExecutable FilePath
excPath
    case Maybe FilePath
mexc of
        Just FilePath
exc -> do
            Version
ver <- Partial => FilePath -> Version
FilePath -> Version
readVersion (FilePath -> Version)
-> (FilePath -> FilePath) -> FilePath -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
tail (FilePath -> Version) -> IO FilePath -> IO Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
exc [FilePath
"--version"] FilePath
""
            Either FilePath FilePath -> IO (Either FilePath FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath FilePath -> IO (Either FilePath FilePath))
-> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ if Version -> [Int]
versionBranch Version
ver [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
0,Int
7,Int
0,Int
0]
                       then FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
exc
                       else FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
"Your version of refactor is too old, please upgrade to the latest version"
        Maybe FilePath
Nothing -> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath FilePath -> IO (Either FilePath FilePath))
-> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath -> Either FilePath FilePath)
-> FilePath -> Either FilePath FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
                       [ FilePath
"Could not find 'refactor' executable"
                       , FilePath
"Tried to find '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
excPath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' on the PATH"
                       , FilePath
"'refactor' is provided by the 'apply-refact' package and has to be installed"
                       , FilePath
"<https://github.com/mpickering/apply-refact>"
                       ]

runRefactoring :: FilePath -> FilePath -> FilePath -> [Extension] -> [Extension] -> String -> IO ExitCode
runRefactoring :: FilePath
-> FilePath
-> FilePath
-> [Extension]
-> [Extension]
-> FilePath
-> IO ExitCode
runRefactoring FilePath
rpath FilePath
fin FilePath
hints [Extension]
enabled [Extension]
disabled FilePath
opts =  do
    let args :: [FilePath]
args = [FilePath
fin, FilePath
"-v0"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
words FilePath
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--refact-file", FilePath
hints]
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
arg | Extension
e <- [Extension]
enabled, FilePath
arg <- [FilePath
"-X", Extension -> FilePath
forall a. Show a => a -> FilePath
show Extension
e]]
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
arg | Extension
e <- [Extension]
disabled, FilePath
arg <- [FilePath
"-X", FilePath
"No" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Extension -> FilePath
forall a. Show a => a -> FilePath
show Extension
e]]
    (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
phand) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (CreateProcess
 -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> CreateProcess
proc FilePath
rpath [FilePath]
args
    IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
LineBuffering :: IO (Either IOException ())
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
    -- Propagate the exit code from the spawn process
    ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
phand