{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}

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

import Control.Exception.Extra
import Control.Monad
import Data.List.NonEmpty qualified as NE
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 Refact.Types qualified as R

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

import GHC.Util.SrcLoc (getAncLoc)

substVars :: [String]
substVars :: [String]
substVars = [Char
letter Char -> String -> String
forall a. a -> [a] -> [a]
: String
number | String
number <- String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
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 (SrcSpan -> SrcSpan)
-> (Located a -> SrcSpan) -> Located a -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> SrcSpan
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 (SrcSpan -> SrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' a) e -> SrcSpan
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 (SrcSpan -> SrcSpan)
-> (GenLocated Anchor e -> SrcSpan)
-> GenLocated Anchor e
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated Anchor e -> SrcSpan
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 (Maybe String -> IO (Either String String))
-> (Either String String -> IO String) -> Maybe String -> IO String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> IO String)
-> (String -> IO String) -> Either String String -> IO String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO String
forall a. Partial => String -> IO a
errorIO String -> IO String
forall a. a -> IO a
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 = String -> Maybe String -> String
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
String -> Version
readVersion (String -> Version) -> (String -> String) -> String -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.tail (NonEmpty Char -> String)
-> (String -> NonEmpty Char) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. Partial => [a] -> NonEmpty a
NE.fromList (String -> Version) -> IO String -> IO Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
exc [String
"--version"] String
""
            Either String String -> IO (Either String String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ if Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
minRefactorVersion
                       then String -> Either String String
forall a b. b -> Either a b
Right String
exc
                       else String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"Your version of refactor is too old, please install apply-refact "
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
minRefactorVersion
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" or later. Apply-refact can be installed from Cabal or Stack."
        Maybe String
Nothing -> Either String String -> IO (Either String String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                       [ String
"Could not find 'refactor' executable"
                       , String
"Tried to find '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
excPath String -> String -> String
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"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
words String
opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--refact-file", String
hints]
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
arg | Extension
e <- [Extension]
enabled, String
arg <- [String
"-X", Extension -> String
forall a. Show a => a -> String
show Extension
e]]
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
arg | Extension
e <- [Extension]
disabled, String
arg <- [String
"-X", String
"No" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Show a => a -> String
show Extension
e]]
    IO () -> IO ()
whenLoud (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Running refactor: " String -> String -> String
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 (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
$ String -> [String] -> CreateProcess
proc String
rpath [String]
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

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