{- | Discover the GHC version by querying the GHC executable

 -}
module GHC.Check.Executable where

import Data.Version
import System.FilePath
import System.Process
import Text.ParserCombinators.ReadP
import Data.Char (isSpace)
import Data.List (dropWhileEnd)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty


-- | Takes a path to the GHC binary to query.
--   Throws if anything goes wrong.
getGhcVersion :: FilePath -> IO Version
getGhcVersion :: FilePath -> IO Version
getGhcVersion FilePath
fp = do
    FilePath
out <- FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
fp [FilePath
"--numeric-version"] FilePath
""
    case ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S (ReadP Version
parseVersion ReadP Version -> ReadP () -> ReadP Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
eof) (FilePath -> FilePath
trim FilePath
out) of
        [(Version
v, FilePath
"")] -> Version -> IO Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v
        [(Version, FilePath)]
_ -> FilePath -> IO Version
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO Version) -> FilePath -> IO Version
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse GHC version: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
out

trim :: String -> String
trim :: FilePath -> FilePath
trim = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

-- | Returns a list of possible paths for the GHC executable
guessExecutablePathFromLibdir :: FilePath -> NonEmpty FilePath
guessExecutablePathFromLibdir :: FilePath -> NonEmpty FilePath
guessExecutablePathFromLibdir FilePath
fp = [FilePath] -> NonEmpty FilePath
forall a. [a] -> NonEmpty a
NonEmpty.fromList
    [ FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> FilePath
"ghc"               -- Linux
    , FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
".." FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> FilePath
"ghc"      -- Linux (Relocatable GHC build)
    , FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
".." FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> FilePath
"ghc.exe"  -- Windows
    ]