1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
-- Copyright (C) 2007 Eric Kow
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING. If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.
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
-- Note: The two calls to execReadContents below are from
-- different working directories. This matters despite our
-- use of virtualTreeIO.
execReadContents tree = fst `fmap` TM.virtualTreeIO readContents tree
files <- if haveNonrangeMatch (repoPatchType repository) matchFlags then
withDelayedDir "show.contents" $ \_ -> do
-- this call populates our temporary directory, but note that
-- it does so lazily: the tree gets (partly) expanded inside
-- execReadContents, so it is important that we execute the
-- latter from the same working directory.
getNonrangeMatch repository matchFlags
readPlainTree "." >>= execReadContents
else do
-- we can use the existing pristine tree because we don't modify
-- anything in this case
readRecorded repository >>= execReadContents
forM_ files $ B.hPut stdout
|
