biohazard-2.1: Setup.hs

import Data.List                            ( isPrefixOf )
import Distribution.Compat.Exception        ( tryIO )
import Distribution.PackageDescription      ( PackageDescription(..) )
import Distribution.Simple                  ( UserHooks(..), defaultMainWithHooks, simpleUserHooks )
import Distribution.Simple.LocalBuildInfo   ( LocalBuildInfo(..) )
import Distribution.Simple.Program.Run      ( getProgramInvocationOutput, simpleProgramInvocation )
import Distribution.Simple.Utils            ( createDirectoryIfMissingVerbose )
import Distribution.Verbosity               ( Verbosity, silent )

main :: IO ()
main = defaultMainWithHooks $ simpleUserHooks
    { buildHook = \pkgDesc lbi hooks flags -> do
         git_version <- gitDescribe
         git_branch <- gitBranch
         let git_full_version = fmap (maybe "" (++":") git_branch ++) git_version
         createDirectoryIfMissingVerbose silent False (buildDir lbi ++ "/autogen")
         writeFileIfChanged (buildDir lbi ++ "/autogen/GitVersion.hs") $ unlines
            [ "module GitVersion (gitVersion,gitBranch,gitFullVersion) where"
            , "import Prelude"
            , "gitVersion :: Maybe String"
            , "gitVersion = " ++ show git_version
            , "{-# NOINLINE gitVersion #-}"
            , "gitBranch :: Maybe String"
            , "gitBranch = " ++ show git_branch
            , "{-# NOINLINE gitBranch #-}"
            , "gitFullVersion :: Maybe String"
            , "gitFullVersion = " ++ show git_full_version
            , "{-# NOINLINE gitFullVersion #-}" ]
         buildHook simpleUserHooks pkgDesc lbi hooks flags
    }

writeFileIfChanged :: FilePath -> String -> IO ()
writeFileIfChanged fp new = do
    old <- tryIO $ do s <- readFile fp ; length s `seq` return s
    if old == Right new then return () else writeFile fp new

gitDescribe :: IO (Maybe String)
gitDescribe =
    fmap (either (const Nothing) (Just . unwords . lines)) $ tryIO $
    getProgramInvocationOutput silent $ simpleProgramInvocation "git" ["describe", "--always", "--long"]

gitBranch :: IO (Maybe String)
gitBranch =
    fmap (either (const Nothing) get_branch) $ tryIO $
    getProgramInvocationOutput silent $ simpleProgramInvocation "git" ["branch"]
  where
    get_branch s = case map words . filter ("*" `isPrefixOf`) $ lines s of
        [_:b:_] -> Just b
        _       -> Nothing