{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module ToySolver.Version.TH
( gitHashQ
, compilationTimeQ
) where
import Control.Exception
import Control.Monad
import Data.Time
import System.Process
import Language.Haskell.TH
getGitHash :: IO (Maybe String)
getGitHash :: IO (Maybe String)
getGitHash =
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'\n')) (String -> [String] -> String -> IO String
readProcess String
"git" [String
"rev-parse", String
"--short", String
"HEAD"] String
"")
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
_::SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
gitHashQ :: ExpQ
gitHashQ :: ExpQ
gitHashQ = do
Maybe String
m <- forall a. IO a -> Q a
runIO IO (Maybe String)
getGitHash
case Maybe String
m of
Maybe String
Nothing -> [| Nothing |]
Just String
s -> [| Just |] forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` forall (m :: * -> *). Quote m => Lit -> m Exp
litE (String -> Lit
stringL String
s)
compilationTimeQ :: ExpQ
compilationTimeQ :: ExpQ
compilationTimeQ = do
UTCTime
tm <- forall a. IO a -> Q a
runIO IO UTCTime
getCurrentTime
[| read $(litE (stringL (show tm))) :: UTCTime |]