Revert "Add info about git commit and date to --version info."

This reverts commit 9d7c01e4a4.
This commit is contained in:
John MacFarlane 2022-04-11 13:14:38 -07:00
parent c13db98dce
commit 0ddddf2f37
2 changed files with 2 additions and 10 deletions

View file

@ -528,8 +528,7 @@ library
xml-types >= 0.3 && < 0.4,
yaml >= 0.11 && < 0.12,
zip-archive >= 0.2.3.4 && < 0.5,
zlib >= 0.5 && < 0.7,
githash >= 0.1.6.2 && < 0.2
zlib >= 0.5 && < 0.7
if !os(windows)
build-depends: unix >= 2.4 && < 2.8
if flag(lua53)

View file

@ -5,7 +5,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-}
{- |
Module : Text.Pandoc.App.CommandLineOptions
Copyright : Copyright (C) 2006-2022 John MacFarlane
@ -71,7 +70,6 @@ import qualified Data.ByteString.Lazy as B
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Text.Pandoc.UTF8 as UTF8
import GitHash
parseOptions :: [OptDescr (Opt -> IO Opt)] -> Opt -> IO Opt
parseOptions options' defaults = do
@ -954,14 +952,9 @@ options =
openlibs
getglobal "_VERSION"
peek top
let buildInfo = either
(\_ -> mempty)
(\gi -> "\nBuilt from commit " ++ giDescribe gi ++
" on " ++ giCommitDate gi)
$$tGitInfoCwdTry
UTF8.hPutStrLn stdout
$ T.pack
$ prg ++ " " ++ T.unpack pandocVersion ++ buildInfo ++
$ prg ++ " " ++ T.unpack pandocVersion ++
compileInfo ++ "\nScripting engine: " ++ luaVersion ++
"\nUser data directory: " ++ defaultDatadir ++
('\n':copyrightMessage)