{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Version.TH
-- Copyright   :  (c) Masahiro Sakai 2015
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
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 |]