{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}
-- | Information and display strings for HIE's version
-- and the current project's version
module Ide.Version where


import           Data.Maybe                    (listToMaybe)
import           Data.Version
import           GitHash                       (giCommitCount, tGitInfoCwdTry)
import           Options.Applicative.Simple    (simpleVersion)
import qualified Paths_haskell_language_server as Meta
import           System.Directory
import           System.Exit
import           System.Info
import           System.Process
import           Text.ParserCombinators.ReadP

-- >>> hlsVersion
hlsVersion :: String
hlsVersion :: [Char]
hlsVersion =
  let gi :: Either [Char] GitInfo
gi = $$[Char]
[Char] -> Either [Char] GitInfo
forall a b. a -> Either a b
tGitInfoCwdTry
      commitCount :: [Char]
commitCount = case Either [Char] GitInfo
gi of
        Right GitInfo
gi -> Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ GitInfo -> Int
giCommitCount GitInfo
gi
        Left [Char]
_   -> [Char]
"UNKNOWN"
  in [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [$(simpleVersion Meta.version)]
      -- Leave out number of commits for --depth=1 clone
      -- See https://github.com/commercialhaskell/stack/issues/792
    , [[Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
commitCount [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" commits)" | [Char]
commitCount [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= ([Char]
"1"::String) Bool -> Bool -> Bool
&&
                                            [Char]
commitCount [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= ([Char]
"UNKNOWN" :: String)]
    , [[Char]
" ", [Char]
arch]
    , [[Char]
" ", [Char]
hlsGhcDisplayVersion]
    ]
  where
    hlsGhcDisplayVersion :: [Char]
hlsGhcDisplayVersion = [Char]
compilerName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ VERSION_ghc

data ProgramsOfInterest = ProgramsOfInterest
  { ProgramsOfInterest -> Maybe Version
cabalVersion :: Maybe Version
  , ProgramsOfInterest -> Maybe Version
stackVersion :: Maybe Version
  , ProgramsOfInterest -> Maybe Version
ghcVersion   :: Maybe Version
  }

showProgramVersionOfInterest :: ProgramsOfInterest -> String
showProgramVersionOfInterest :: ProgramsOfInterest -> [Char]
showProgramVersionOfInterest ProgramsOfInterest {Maybe Version
cabalVersion :: ProgramsOfInterest -> Maybe Version
stackVersion :: ProgramsOfInterest -> Maybe Version
ghcVersion :: ProgramsOfInterest -> Maybe Version
cabalVersion :: Maybe Version
stackVersion :: Maybe Version
ghcVersion :: Maybe Version
..} =
  [[Char]] -> [Char]
unlines
    [ [Char] -> Maybe Version -> [Char]
showProgramVersion [Char]
"cabal" Maybe Version
cabalVersion
    , [Char] -> Maybe Version -> [Char]
showProgramVersion [Char]
"stack" Maybe Version
stackVersion
    , [Char] -> Maybe Version -> [Char]
showProgramVersion [Char]
"ghc" Maybe Version
ghcVersion
    ]

showProgramVersion :: String -> Maybe Version -> String
showProgramVersion :: [Char] -> Maybe Version -> [Char]
showProgramVersion [Char]
name Maybe Version
version =
  Int -> [Char] -> [Char]
pad Int
16 ([Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe Version -> [Char]
showVersionWithDefault Maybe Version
version
  where
    showVersionWithDefault :: Maybe Version -> [Char]
showVersionWithDefault = [Char] -> (Version -> [Char]) -> Maybe Version -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"Not found" Version -> [Char]
showVersion
    pad :: Int -> [Char] -> [Char]
pad Int
n [Char]
s = [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
' '

findProgramVersions :: IO ProgramsOfInterest
findProgramVersions :: IO ProgramsOfInterest
findProgramVersions = Maybe Version
-> Maybe Version -> Maybe Version -> ProgramsOfInterest
ProgramsOfInterest
  (Maybe Version
 -> Maybe Version -> Maybe Version -> ProgramsOfInterest)
-> IO (Maybe Version)
-> IO (Maybe Version -> Maybe Version -> ProgramsOfInterest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe Version)
findVersionOf [Char]
"cabal"
  IO (Maybe Version -> Maybe Version -> ProgramsOfInterest)
-> IO (Maybe Version) -> IO (Maybe Version -> ProgramsOfInterest)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Version)
findVersionOf [Char]
"stack"
  IO (Maybe Version -> ProgramsOfInterest)
-> IO (Maybe Version) -> IO ProgramsOfInterest
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Version)
findVersionOf [Char]
"ghc"

-- | Find the version of the given program.
-- Assumes the program accepts the cli argument "--numeric-version".
-- If the invocation has a non-zero exit-code, we return 'Nothing'
findVersionOf :: FilePath -> IO (Maybe Version)
findVersionOf :: [Char] -> IO (Maybe Version)
findVersionOf [Char]
tool =
  [Char] -> IO (Maybe [Char])
findExecutable [Char]
tool IO (Maybe [Char])
-> (Maybe [Char] -> IO (Maybe Version)) -> IO (Maybe Version)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe [Char]
Nothing -> Maybe Version -> IO (Maybe Version)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing
    Just [Char]
path ->
      [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
path [[Char]
"--numeric-version"] [Char]
"" IO (ExitCode, [Char], [Char])
-> ((ExitCode, [Char], [Char]) -> IO (Maybe Version))
-> IO (Maybe Version)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (ExitCode
ExitSuccess, [Char]
sout, [Char]
_) -> Maybe Version -> IO (Maybe Version)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe Version
mkVersion [Char]
sout
        (ExitCode, [Char], [Char])
_                      -> Maybe Version -> IO (Maybe Version)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing

mkVersion :: String -> Maybe Version
mkVersion :: [Char] -> Maybe Version
mkVersion = ReadP Version -> [Char] -> Maybe Version
forall a. ReadP a -> [Char] -> Maybe a
consumeParser ReadP Version
myVersionParser
  where
    myVersionParser :: ReadP Version
myVersionParser = do
      ReadP ()
skipSpaces
      Version
version <- ReadP Version
parseVersion
      ReadP ()
skipSpaces
      Version -> ReadP Version
forall a. a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
version

    consumeParser :: ReadP a -> String -> Maybe a
    consumeParser :: forall a. ReadP a -> [Char] -> Maybe a
consumeParser ReadP a
p [Char]
input =
      [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ ((a, [Char]) -> a) -> [(a, [Char])] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, [Char]) -> a
forall a b. (a, b) -> a
fst ([(a, [Char])] -> [a])
-> ([(a, [Char])] -> [(a, [Char])]) -> [(a, [Char])] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [Char]) -> Bool) -> [(a, [Char])] -> [(a, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool) -> ((a, [Char]) -> [Char]) -> (a, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [Char]) -> [Char]
forall a b. (a, b) -> b
snd) ([(a, [Char])] -> [a]) -> [(a, [Char])] -> [a]
forall a b. (a -> b) -> a -> b
$ ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
p [Char]
input