a2ba701056
This is a work in progress. It compiles and is able to do basic command dispatch, including git autocorrection, while using optparse-applicative for the core commandline parsing. * Many commands are temporarily disabled before conversion. * Options are not wired in yet. * cmdnorepo actions don't work yet. Also, removed the [Command] list, which was only used in one place.
61 lines
1.5 KiB
Haskell
61 lines
1.5 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Version where
|
|
|
|
import Common.Annex
|
|
import Command
|
|
import qualified Build.SysConfig as SysConfig
|
|
import Annex.Version
|
|
import BuildFlags
|
|
import qualified Types.Backend as B
|
|
import qualified Types.Remote as R
|
|
import qualified Remote
|
|
import qualified Backend
|
|
|
|
cmd :: Command
|
|
cmd = withOptions [rawOption] $
|
|
noCommit $ noRepo startNoRepo $ dontCheck repoExists $
|
|
command "version" paramNothing seek SectionQuery "show version info"
|
|
|
|
rawOption :: Option
|
|
rawOption = flagOption [] "raw" "output only program version"
|
|
|
|
seek :: CommandSeek
|
|
seek = withNothing $ ifM (getOptionFlag rawOption) (startRaw, start)
|
|
|
|
startRaw :: CommandStart
|
|
startRaw = do
|
|
liftIO $ do
|
|
putStr SysConfig.packageversion
|
|
hFlush stdout
|
|
stop
|
|
|
|
start :: CommandStart
|
|
start = do
|
|
v <- getVersion
|
|
liftIO $ do
|
|
|
|
showPackageVersion
|
|
info "local repository version" $ fromMaybe "unknown" v
|
|
info "supported repository version" supportedVersion
|
|
info "upgrade supported from repository versions" $
|
|
unwords upgradableVersions
|
|
stop
|
|
|
|
startNoRepo :: CmdParams -> IO ()
|
|
startNoRepo _ = showPackageVersion
|
|
|
|
showPackageVersion :: IO ()
|
|
showPackageVersion = do
|
|
info "git-annex version" SysConfig.packageversion
|
|
info "build flags" $ unwords buildFlags
|
|
info "key/value backends" $ unwords $ map B.name Backend.list
|
|
info "remote types" $ unwords $ map R.typename Remote.remoteTypes
|
|
|
|
info :: String -> String -> IO ()
|
|
info k v = putStrLn $ k ++ ": " ++ v
|