module Darcs.UI.Commands.ShowIndex
( showIndex
, showPristine
) where
import Darcs.Prelude
import Control.Monad ( (>=>) )
import Darcs.UI.Flags ( DarcsFlag, useCache )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInRepository )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Options ( (^), oid, odesc, ocheck, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository ( withRepository, RepoJob(..), readIndex )
import Darcs.Repository.State ( readRecorded )
import Darcs.Util.Hash( encodeBase16, Hash( NoHash ) )
import Darcs.Util.Tree( list, expand, itemHash, Tree, TreeItem( SubTree ) )
import Darcs.Util.Index( treeFromIndex, listFileIDs )
import Darcs.Util.Path( anchorPath, AbsolutePath, floatPath )
import Darcs.Util.Printer ( Doc, text )
import System.Posix.Types ( FileID )
import qualified Data.ByteString.Char8 as BC
import Data.Maybe ( fromJust )
import qualified Data.Map as M ( Map, lookup, fromList )
showIndexHelp :: Doc
showIndexHelp :: Doc
showIndexHelp = String -> Doc
text forall a b. (a -> b) -> a -> b
$
String
"The `darcs show index` command lists all version-controlled files and " forall a. [a] -> [a] -> [a]
++
String
"directories along with their hashes as stored in `_darcs/index`. " forall a. [a] -> [a] -> [a]
++
String
"For files, the fields correspond to file size, sha256 of the current " forall a. [a] -> [a] -> [a]
++
String
"file content and the filename."
showIndex :: DarcsCommand
showIndex :: DarcsCommand
showIndex = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"index"
, commandDescription :: String
commandDescription = String
"Dump contents of working tree index."
, commandHelp :: Doc
commandHelp = Doc
showIndexHelp
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showIndexCmd
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = []
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (Bool -> Maybe String -> a)
showIndexBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(Bool
-> Maybe String
-> Maybe StdCmdAction
-> Verbosity
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
showIndexOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(Bool
-> Maybe String
-> Maybe StdCmdAction
-> Verbosity
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
showIndexOpts
}
where
showIndexBasicOpts :: OptSpec DarcsOptDescr DarcsFlag a (Bool -> Maybe String -> a)
showIndexBasicOpts = PrimDarcsOption Bool
O.nullFlag forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe String)
O.repoDir
showIndexOpts :: DarcsOption
a
(Bool
-> Maybe String
-> Maybe StdCmdAction
-> Verbosity
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
showIndexOpts = forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (Bool -> Maybe String -> a)
showIndexBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall (d :: * -> *) f a. OptSpec d f a a
oid
dump :: [DarcsFlag] -> Maybe (M.Map FilePath FileID) -> Tree IO -> IO ()
dump :: [DarcsFlag] -> Maybe (Map String FileID) -> Tree IO -> IO ()
dump [DarcsFlag]
opts Maybe (Map String FileID)
fileids Tree IO
tree = do
let line :: String -> IO ()
line | PrimDarcsOption Bool
O.nullFlag forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts = \String
t -> String -> IO ()
putStr String
t forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> IO ()
putChar Char
'\0'
| Bool
otherwise = String -> IO ()
putStrLn
output :: (AnchoredPath, TreeItem m) -> IO ()
output (AnchoredPath
p, TreeItem m
i) = do
let hash :: String
hash = case forall (m :: * -> *). TreeItem m -> Hash
itemHash TreeItem m
i of
Hash
NoHash -> String
"(no hash available)"
Hash
h -> ByteString -> String
BC.unpack forall a b. (a -> b) -> a -> b
$ Hash -> ByteString
encodeBase16 Hash
h
path :: String
path = String -> AnchoredPath -> String
anchorPath String
"" AnchoredPath
p
isdir :: String
isdir = case TreeItem m
i of
SubTree Tree m
_ -> String
"/"
TreeItem m
_ -> String
""
fileid :: String
fileid = case Maybe (Map String FileID)
fileids of
Maybe (Map String FileID)
Nothing -> String
""
Just Map String FileID
fileids' -> String
" " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
path Map String FileID
fileids')
String -> IO ()
line forall a b. (a -> b) -> a -> b
$ String
hash forall a. [a] -> [a] -> [a]
++ String
fileid forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
path forall a. [a] -> [a] -> [a]
++ String
isdir
Tree IO
x <- forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand Tree IO
tree
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {m :: * -> *}. (AnchoredPath, TreeItem m) -> IO ()
output forall a b. (a -> b) -> a -> b
$ (String -> AnchoredPath
floatPath String
".", forall (m :: * -> *). Tree m -> TreeItem m
SubTree Tree IO
x) forall a. a -> [a] -> [a]
: forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree IO
x
showIndexCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showIndexCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showIndexCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_ = forall a. UseCache -> RepoJob a -> IO a
withRepository (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob forall a b. (a -> b) -> a -> b
$ \Repository rt p wR wU wR
repo ->
do Index
index <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO Index
readIndex Repository rt p wR wU wR
repo
Tree IO
index_tree <- Index -> IO (Tree IO)
treeFromIndex Index
index
Map String FileID
fileids <- (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\((AnchoredPath
a,ItemType
_),FileID
b) -> (String -> AnchoredPath -> String
anchorPath String
"" AnchoredPath
a,FileID
b))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> IO [((AnchoredPath, ItemType), FileID)]
listFileIDs Index
index
[DarcsFlag] -> Maybe (Map String FileID) -> Tree IO -> IO ()
dump [DarcsFlag]
opts (forall a. a -> Maybe a
Just Map String FileID
fileids) Tree IO
index_tree
showPristineCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showPristineCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showPristineCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_ = forall a. UseCache -> RepoJob a -> IO a
withRepository (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob forall a b. (a -> b) -> a -> b
$
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [DarcsFlag] -> Maybe (Map String FileID) -> Tree IO -> IO ()
dump [DarcsFlag]
opts forall a. Maybe a
Nothing
showPristineHelp :: Doc
showPristineHelp :: Doc
showPristineHelp = String -> Doc
text forall a b. (a -> b) -> a -> b
$
String
"The `darcs show pristine` command lists all version-controlled files " forall a. [a] -> [a] -> [a]
++
String
"and directories along with the hashes of their pristine copies. " forall a. [a] -> [a] -> [a]
++
String
"For files, the fields correspond to file size, sha256 of the pristine " forall a. [a] -> [a] -> [a]
++
String
"file content and the filename."
showPristine :: DarcsCommand
showPristine :: DarcsCommand
showPristine = DarcsCommand
showIndex
{ commandName :: String
commandName = String
"pristine"
, commandDescription :: String
commandDescription = String
"Dump contents of pristine cache."
, commandHelp :: Doc
commandHelp = Doc
showPristineHelp
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showPristineCmd
}