module Darcs.UI.Commands.ShowContents ( showContents ) where
import Control.Monad ( filterM, forM_, forM, when )
import System.IO ( stdout )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Darcs.Prelude
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, findRepository )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags ( DarcsFlag, useCache, pathsFromArgs )
import Darcs.UI.Options ( (^), oid, odesc, ocheck, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Patch.Match ( patchSetMatch )
import Darcs.Repository ( withRepository, RepoJob(..), readRecorded )
import Darcs.Util.Lock ( withDelayedDir )
import Darcs.Repository.Match ( getRecordedUpToMatch )
import Darcs.Util.Tree.Plain( readPlainTree )
import qualified Darcs.Util.Tree.Monad as TM
import Darcs.Util.Path( AbsolutePath )
import Darcs.Util.Printer ( Doc, text )
showContentsDescription :: String
showContentsDescription = "Outputs a specific version of a file."
showContentsHelp :: Doc
showContentsHelp = text $
"Show contents can be used to display an earlier version of some file(s).\n"++
"If you give show contents no version arguments, it displays the recorded\n"++
"version of the file(s).\n"
showContents :: DarcsCommand
showContents = DarcsCommand
{ commandProgramName = "darcs"
, commandName = "contents"
, commandHelp = showContentsHelp
, commandDescription = showContentsDescription
, commandExtraArgs = -1
, commandExtraArgHelp = ["[FILE]..."]
, commandCommand = showContentsCmd
, commandPrereq = findRepository
, commandCompleteArgs = noArgs
, commandArgdefaults = nodefaults
, commandAdvancedOptions = []
, commandBasicOptions = odesc showContentsBasicOpts
, commandDefaults = defaultFlags showContentsOpts
, commandCheckOptions = ocheck showContentsOpts
}
where
showContentsBasicOpts = O.matchUpToOne ^ O.repoDir
showContentsOpts = O.matchUpToOne ^ O.repoDir `withStdOpts` oid
showContentsCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showContentsCmd _ _ [] = fail "show contents needs at least one argument."
showContentsCmd fps opts args = do
paths <- pathsFromArgs fps args
when (null paths) $ fail "No valid repository paths were given."
let matchFlags = parseFlags O.matchUpToOne opts
withRepository (useCache ? opts) $ RepoJob $ \repository -> do
let readContents = do
okpaths <- filterM TM.fileExists paths
forM okpaths $ \f -> (B.concat . BL.toChunks) `fmap` TM.readFile f
execReadContents tree = fst `fmap` TM.virtualTreeIO readContents tree
files <-
case patchSetMatch matchFlags of
Just psm ->
withDelayedDir "show.contents" $ \_ -> do
getRecordedUpToMatch repository psm
readPlainTree "." >>= execReadContents
Nothing ->
readRecorded repository >>= execReadContents
forM_ files $ B.hPut stdout