module Darcs.UI.Commands.ShowContents ( showContents ) where
import Prelude ()
import Darcs.Prelude
import Prelude hiding ( (^) )
import Control.Monad ( filterM, forM_, forM )
import System.IO ( stdout )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, findRepository )
import Darcs.UI.Flags ( DarcsFlag, useCache, fixSubPaths )
import Darcs.UI.Options ( DarcsOption, (^), oid, odesc, ocheck, onormalise, defaultFlags, parseFlags )
import qualified Darcs.UI.Options.All as O
( MatchFlag
, matchUpToOne
, workingRepoDir
, StdCmdAction
, Verbosity
, UseCache )
import Darcs.Patch.Match ( haveNonrangeMatch )
import Darcs.Repository ( withRepository, RepoJob(..), readRecorded, repoPatchType )
import Darcs.Util.Lock ( withDelayedDir )
import Darcs.Repository.Match ( getNonrangeMatch )
import Darcs.Util.Tree.Plain( readPlainTree )
import qualified Darcs.Util.Tree.Monad as TM
import Darcs.Util.Path( floatPath, sp2fn, toFilePath, AbsolutePath )
showContentsDescription :: String
showContentsDescription = "Outputs a specific version of a file."
showContentsHelp :: String
showContentsHelp =
"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"
showContentsBasicOpts :: DarcsOption a ([O.MatchFlag] -> Maybe String -> a)
showContentsBasicOpts = O.matchUpToOne ^ O.workingRepoDir
showContentsOpts :: DarcsOption a
([O.MatchFlag]
-> Maybe String
-> Maybe O.StdCmdAction
-> Bool
-> Bool
-> O.Verbosity
-> Bool
-> O.UseCache
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> a)
showContentsOpts = O.matchUpToOne ^ O.workingRepoDir `withStdOpts` oid
showContents :: DarcsCommand [DarcsFlag]
showContents = DarcsCommand
{ commandProgramName = "darcs"
, commandName = "contents"
, commandHelp = showContentsHelp
, commandDescription = showContentsDescription
, commandExtraArgs = 1
, commandExtraArgHelp = ["[FILE]..."]
, commandCommand = showContentsCmd
, commandPrereq = findRepository
, commandGetArgPossibilities = return []
, commandArgdefaults = nodefaults
, commandAdvancedOptions = []
, commandBasicOptions = odesc showContentsBasicOpts
, commandDefaults = defaultFlags showContentsOpts
, commandCheckOptions = ocheck showContentsOpts
, commandParseOptions = onormalise showContentsOpts
}
showContentsCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showContentsCmd _ _ [] = fail "show contents needs at least one argument."
showContentsCmd fps opts args = do
floatedPaths <- map (floatPath . toFilePath . sp2fn) `fmap` fixSubPaths fps args
let matchFlags = parseFlags O.matchUpToOne opts
withRepository (useCache opts) $ RepoJob $ \repository -> do
let readContents = do
okpaths <- filterM TM.fileExists floatedPaths
forM okpaths $ \f -> (B.concat . BL.toChunks) `fmap` TM.readFile f
execReadContents tree = fst `fmap` TM.virtualTreeIO readContents tree
files <- if haveNonrangeMatch (repoPatchType repository) matchFlags then
withDelayedDir "show.contents" $ \_ -> do
getNonrangeMatch repository matchFlags
readPlainTree "." >>= execReadContents
else do
readRecorded repository >>= execReadContents
forM_ files $ B.hPut stdout