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