{-# LANGUAGE CPP #-} #if MIN_VERSION_template_haskell(2,2,0) {-# LANGUAGE TemplateHaskell #-} #endif {-# OPTIONS_GHC -fforce-recomp #-} -- Recompilation is needed to obtain the correct build time. module Game.Hanabi.VersionInfo where import Data.Time #if MIN_VERSION_template_haskell(2,2,0) import Language.Haskell.TH #endif #ifdef CABAL import Paths_hanabi_dealer(version) import Data.Version(showVersion) #endif versionInfo, mhVersion, ghcVersion, now :: String versionInfo = mhVersion ++ compiler ++ ghcVersion ++ now #ifdef CABAL mhVersion = showVersion version #else mhVersion = "" #endif #ifdef ghcjs_HOST_OS compiler = " built with GHCJS-" #else compiler = " built with GHC-" #endif ghcVersion = case __GLASGOW_HASKELL__ `divMod` 100 of (b,s) -> shows b $ '.' : show s #if MIN_VERSION_template_haskell(2,2,0) now = " at " ++ $(runIO getCurrentTime >>= \t -> return (LitE $ StringL $ show t)) -- This requires the -fforce-recomp flag in order to be correct. #else now = "" #endif