{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}

module Simplex.Messaging.Server.Main.GitCommit
  ( gitCommit,
  ) where

import Language.Haskell.TH
import System.Process
import Control.Exception
import System.Exit

gitCommit :: Q Exp
gitCommit :: Q Exp
gitCommit = String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp)
-> (Either SomeException (ExitCode, String, String) -> String)
-> Either SomeException (ExitCode, String, String)
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException (ExitCode, String, String) -> String
commit (Either SomeException (ExitCode, String, String) -> Q Exp)
-> Q (Either SomeException (ExitCode, String, String)) -> Q Exp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either SomeException (ExitCode, String, String))
-> Q (Either SomeException (ExitCode, String, String))
forall a. IO a -> Q a
runIO (IO (ExitCode, String, String)
-> IO (Either SomeException (ExitCode, String, String))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (ExitCode, String, String)
 -> IO (Either SomeException (ExitCode, String, String)))
-> IO (ExitCode, String, String)
-> IO (Either SomeException (ExitCode, String, String))
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"git" [String
"rev-parse", String
"HEAD"] String
"")
  where
    commit :: Either SomeException (ExitCode, String, String) -> String
    commit :: Either SomeException (ExitCode, String, String) -> String
commit = \case
      Right (ExitCode
ExitSuccess, String
out, String
_) -> Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
40 String
out
      Either SomeException (ExitCode, String, String)
_ -> String
""