{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

#ifdef USE_GIT_INFO
{-# LANGUAGE TemplateHaskell   #-}
#endif

-- Extracted from "Stack" so that module does not use CPP or Template Haskell,

-- and therefore doesn't need to be recompiled as often.

module Stack.BuildInfo
  ( versionString'
  , hpackVersion
  , maybeGitHash
  ) where

#ifndef HIDE_DEP_VERSIONS
import qualified Build_stack
#endif
import           Data.Version ( versionBranch )
import           Distribution.System ( buildArch )
import qualified Distribution.Text as Cabal ( display )
#ifdef USE_GIT_INFO
import           GitHash ( giCommitCount, giHash, tGitInfoCwdTry )
import           Options.Applicative.Simple ( simpleVersion )
#endif
import qualified Paths_stack as Meta
import           Stack.Constants ( isStackUploadDisabled )
import           Stack.Prelude
#ifndef USE_GIT_INFO
import           Stack.Types.Version ( showStackVersion )
#endif

versionString' :: String
#ifdef USE_GIT_INFO
versionString' :: [Char]
versionString' = [[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

  , case GitInfo -> Int
giCommitCount (GitInfo -> Int) -> Either [Char] GitInfo -> Either [Char] Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> $$Bool
Int
[Char]
[[Char]]
[Char]
-> [Char]
-> Bool
-> [Char]
-> Int
-> [[Char]]
-> [Char]
-> [Char]
-> [Char]
-> GitInfo
GitInfo -> Either [Char] GitInfo
forall a b. b -> Either a b
tGitInfoCwdTry of
      Left [Char]
_ -> []
      Right Int
1 -> []
      Right Int
count -> [[Char]
" (", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
count, [Char]
" commits)"]
  , [[Char]
afterVersion]
  ]
#else
versionString' = showStackVersion ++ afterVersion
#endif
 where
  afterVersion :: [Char]
afterVersion = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Char]
preReleaseString
    , Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Arch -> [Char]
forall a. Pretty a => a -> [Char]
Cabal.display Arch
buildArch
    , [Char]
depsString
    , [Char]
warningString
    , [Char]
stackUploadDisabledWarningString
    ]
  preReleaseString :: [Char]
preReleaseString =
    case Version -> [Int]
versionBranch Version
Meta.version of
      (Int
_:Int
y:[Int]
_) | Int -> Bool
forall a. Integral a => a -> Bool
even Int
y -> [Char]
" PRE-RELEASE"
      (Int
_:Int
_:Int
z:[Int]
_) | Int -> Bool
forall a. Integral a => a -> Bool
even Int
z -> [Char]
" RELEASE-CANDIDATE"
      [Int]
_ -> [Char]
""
#ifdef HIDE_DEP_VERSIONS
  depsString = " hpack-" ++ VERSION_hpack
#else
  depsString :: [Char]
depsString = [Char]
"\nCompiled with:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"- " ++) [[Char]]
Build_stack.deps)
#endif
#ifdef SUPPORTED_BUILD
  warningString = ""
#else
  warningString :: [Char]
warningString = [[Char]] -> [Char]
unlines
    [ [Char]
""
    , [Char]
"Warning: this is an unsupported build that may use different versions of"
    , [Char]
"dependencies and GHC than the officially released binaries, and therefore may"
    , [Char]
"not behave identically.  If you encounter problems, please try the latest"
    , [Char]
"official build by running 'stack upgrade --force-download'."
    ]
#endif
  stackUploadDisabledWarningString :: [Char]
stackUploadDisabledWarningString = if Bool
isStackUploadDisabled
    then [[Char]] -> [Char]
unlines
      [ [Char]
""
      , [Char]
"Warning: 'stack upload' is disabled and will not make HTTP request(s). It will"
      , [Char]
"output information about the HTTP request(s) that would have been made if it"
      , [Char]
"was enabled."
      ]
    else [Char]
""

-- | Hpack version we're compiled against

hpackVersion :: String
hpackVersion :: [Char]
hpackVersion = VERSION_hpack

-- | If USE_GIT_INFO is enabled, the Git hash in the build directory, otherwise

-- Nothing.

maybeGitHash :: Maybe String
maybeGitHash :: Maybe [Char]
maybeGitHash =
#ifdef USE_GIT_INFO
  (([Char] -> Maybe [Char])
-> (GitInfo -> Maybe [Char])
-> Either [Char] GitInfo
-> Maybe [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe [Char] -> [Char] -> Maybe [Char]
forall a b. a -> b -> a
const Maybe [Char]
forall a. Maybe a
Nothing) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> (GitInfo -> [Char]) -> GitInfo -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GitInfo -> [Char]
giHash) $$Bool
Int
[Char]
[[Char]]
[Char]
-> [Char]
-> Bool
-> [Char]
-> Int
-> [[Char]]
-> [Char]
-> [Char]
-> [Char]
-> GitInfo
GitInfo -> Either [Char] GitInfo
forall a b. b -> Either a b
tGitInfoCwdTry)
#else
  Nothing
#endif