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

import           Development.GitRev            (gitCommitCount)
import           Options.Applicative.Simple    (simpleVersion)
import qualified Paths_haskell_language_server as Meta
import           System.Info
import           Data.Version
import           Data.Maybe (listToMaybe)
import           System.Directory
import           System.Process
import           System.Exit
import           Text.ParserCombinators.ReadP

-- >>> hlsVersion
hlsVersion :: String
hlsVersion :: String
hlsVersion =
  let commitCount :: String
commitCount = String
$gitCommitCount
  in [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
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
    , [String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
commitCount String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" commits)" | String
commitCount String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= (String
"1"::String) Bool -> Bool -> Bool
&&
                                            String
commitCount String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= (String
"UNKNOWN" :: String)]
    , [String
" ", String
arch]
    , [String
" ", String
hlsGhcDisplayVersion]
    ]
  where
    hlsGhcDisplayVersion :: String
hlsGhcDisplayVersion = String
compilerName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
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 -> String
showProgramVersionOfInterest ProgramsOfInterest {Maybe Version
ghcVersion :: Maybe Version
stackVersion :: Maybe Version
cabalVersion :: Maybe Version
ghcVersion :: ProgramsOfInterest -> Maybe Version
stackVersion :: ProgramsOfInterest -> Maybe Version
cabalVersion :: ProgramsOfInterest -> Maybe Version
..} =
  [String] -> String
unlines
    [ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"cabal:\t\t", Maybe Version -> String
showVersionWithDefault Maybe Version
cabalVersion]
    , [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"stack:\t\t", Maybe Version -> String
showVersionWithDefault Maybe Version
stackVersion]
    , [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"ghc:\t\t", Maybe Version -> String
showVersionWithDefault Maybe Version
ghcVersion]
    ]
  where
    showVersionWithDefault :: Maybe Version -> String
    showVersionWithDefault :: Maybe Version -> String
showVersionWithDefault = String -> (Version -> String) -> Maybe Version -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"Not found") Version -> String
showVersion

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
<$> String -> IO (Maybe Version)
findVersionOf String
"cabal"
  IO (Maybe Version -> Maybe Version -> ProgramsOfInterest)
-> IO (Maybe Version) -> IO (Maybe Version -> ProgramsOfInterest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO (Maybe Version)
findVersionOf String
"stack"
  IO (Maybe Version -> ProgramsOfInterest)
-> IO (Maybe Version) -> IO ProgramsOfInterest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO (Maybe Version)
findVersionOf String
"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 :: String -> IO (Maybe Version)
findVersionOf String
tool =
  String -> IO (Maybe String)
findExecutable String
tool IO (Maybe String)
-> (Maybe String -> IO (Maybe Version)) -> IO (Maybe Version)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> Maybe Version -> IO (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing
    Just String
path ->
      String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
path [String
"--numeric-version"] String
"" IO (ExitCode, String, String)
-> ((ExitCode, String, String) -> IO (Maybe Version))
-> IO (Maybe Version)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (ExitCode
ExitSuccess, String
sout, String
_) -> Maybe Version -> IO (Maybe Version)
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
$ ReadP Version -> String -> Maybe Version
forall a. ReadP a -> String -> Maybe a
consumeParser ReadP Version
myVersionParser String
sout
        (ExitCode, String, String)
_ -> Maybe Version -> IO (Maybe Version)
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
$ Maybe Version
forall a. Maybe a
Nothing
  where
    myVersionParser :: ReadP Version
myVersionParser = do
      ReadP ()
skipSpaces
      Version
version <- ReadP Version
parseVersion
      ReadP ()
skipSpaces
      Version -> ReadP Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
version

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