{-# LANGUAGE LambdaCase #-}

module Refact
    ( substVars
    , toRefactSrcSpan
    , toSS, toSSA, toSSAnc
    , checkRefactor, refactorPath, runRefactoring
    ) where

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

import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Parser.Annotation as GHC

import GHC.Util.SrcLoc (getAncLoc)

substVars :: [String]
substVars :: [String]
substVars = [Char
letter forall a. a -> [a] -> [a]
: String
number | String
number <- String
"" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Integer
0..], Char
letter <- [Char
'a'..Char
'z']]

toRefactSrcSpan :: GHC.SrcSpan -> R.SrcSpan
toRefactSrcSpan :: SrcSpan -> SrcSpan
toRefactSrcSpan = \case
    GHC.RealSrcSpan RealSrcSpan
span Maybe BufSpan
_ ->
        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 UnhelpfulSpanReason
_ ->
        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.Located a -> R.SrcSpan
toSS :: forall a. Located a -> SrcSpan
toSS = SrcSpan -> SrcSpan
toRefactSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> l
GHC.getLoc

toSSA :: GHC.GenLocated (GHC.SrcSpanAnn' a) e -> R.SrcSpan
toSSA :: forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA = SrcSpan -> SrcSpan
toRefactSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA

toSSAnc :: GHC.GenLocated GHC.Anchor e -> R.SrcSpan
toSSAnc :: forall e. GenLocated Anchor e -> SrcSpan
toSSAnc = SrcSpan -> SrcSpan
toRefactSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GenLocated Anchor a -> SrcSpan
getAncLoc

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

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

runRefactoring :: FilePath -> FilePath -> FilePath -> [Extension] -> [Extension] -> String -> IO ExitCode
runRefactoring :: String
-> String
-> String
-> [Extension]
-> [Extension]
-> String
-> IO ExitCode
runRefactoring String
rpath String
fin String
hints [Extension]
enabled [Extension]
disabled String
opts =  do
    let args :: [String]
args = [String
fin, String
"-v0"] forall a. [a] -> [a] -> [a]
++ String -> [String]
words String
opts forall a. [a] -> [a] -> [a]
++ [String
"--refact-file", String
hints]
          forall a. [a] -> [a] -> [a]
++ [String
arg | Extension
e <- [Extension]
enabled, String
arg <- [String
"-X", forall a. Show a => a -> String
show Extension
e]]
          forall a. [a] -> [a] -> [a]
++ [String
arg | Extension
e <- [Extension]
disabled, String
arg <- [String
"-X", String
"No" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Extension
e]]
    IO () -> IO ()
whenLoud forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Running refactor: " forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
showCommandForUser String
rpath [String]
args
    (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
phand) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess forall a b. (a -> b) -> a -> b
$ String -> [String] -> CreateProcess
proc String
rpath [String]
args
    forall e a. Exception e => IO a -> IO (Either e a)
try 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

minRefactorVersion :: Version
minRefactorVersion :: Version
minRefactorVersion = [Int] -> Version
makeVersion [Int
0,Int
9,Int
1,Int
0]