-- |
-- Module      :  Cryptol.Version
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE Safe #-}

module Cryptol.Version (
    commitHash
  , commitShortHash
  , commitBranch
  , commitDirty
  , version
  , displayVersion
  ) where

import Paths_cryptol
import qualified GitRev
import Data.Version (showVersion)

commitHash :: String
commitHash :: String
commitHash = String
GitRev.hash

commitShortHash :: String
commitShortHash :: String
commitShortHash = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
7 String
GitRev.hash

commitBranch :: String
commitBranch :: String
commitBranch = String
GitRev.branch

commitDirty :: Bool
commitDirty :: Bool
commitDirty = Bool
GitRev.dirty

displayVersion :: Monad m => (String -> m ()) -> m ()
displayVersion :: (String -> m ()) -> m ()
displayVersion String -> m ()
putLn = do
    let ver :: String
ver = Version -> String
showVersion Version
version
    String -> m ()
putLn (String
"Cryptol " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ver)
    String -> m ()
putLn (String
"Git commit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
commitHash)
    String -> m ()
putLn (String
"    branch " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
commitBranch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dirtyLab)
      where
      dirtyLab :: String
dirtyLab | Bool
commitDirty = String
" (non-committed files present during build)"
               | Bool
otherwise   = String
""