{-# LANGUAGE CPP #-}
{- |
   Module      : Data.FileStore.Darcs
   Copyright   : Copyright (C) 2009 Gwern Branwen
   License     : BSD 3

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : GHC 6.10 required

   A versioned filestore implemented using darcs.
   Normally this module should not be imported: import
   "Data.FileStore" instead. -}

module Data.FileStore.Darcs ( darcsFileStore ) where

import Control.Exception (throwIO)
import Control.Monad (when)
import Data.Time (formatTime)
import Data.FileStore.Compat.Locale (defaultTimeLocale)
import Data.List (sort, isPrefixOf)
#ifdef USE_MAXCOUNT
import Data.List (isInfixOf)
#endif
import System.Exit (ExitCode(..))
import System.Directory (doesDirectoryExist, createDirectoryIfMissing)
import System.FilePath ((</>), dropFileName, addTrailingPathSeparator)

import Data.FileStore.DarcsXml (parseDarcsXML)
import Data.FileStore.Types
import Data.FileStore.Utils (withSanityCheck, hashsMatch, runShellCommand, ensureFileExists, grepSearchRepo, withVerifyDir, encodeArg)

import Data.ByteString.Lazy.UTF8 (toString)
import qualified Data.ByteString.Lazy as B (ByteString, writeFile, null)

-- | Return a filestore implemented using the Darcs distributed revision control system
-- (<http://darcs.net/>).
darcsFileStore :: FilePath -> FileStore
darcsFileStore :: FilePath -> FileStore
darcsFileStore FilePath
repo = FileStore {
    initialize :: IO ()
initialize      = FilePath -> IO ()
darcsInit FilePath
repo
  , save :: forall a.
Contents a =>
FilePath -> Author -> FilePath -> a -> IO ()
save            = FilePath -> FilePath -> Author -> FilePath -> a -> IO ()
forall a.
Contents a =>
FilePath -> FilePath -> Author -> FilePath -> a -> IO ()
darcsSave FilePath
repo
  , retrieve :: forall a. Contents a => FilePath -> Maybe FilePath -> IO a
retrieve        = FilePath -> FilePath -> Maybe FilePath -> IO a
forall a.
Contents a =>
FilePath -> FilePath -> Maybe FilePath -> IO a
darcsRetrieve FilePath
repo
  , delete :: FilePath -> Author -> FilePath -> IO ()
delete          = FilePath -> FilePath -> Author -> FilePath -> IO ()
darcsDelete FilePath
repo
  , rename :: FilePath -> FilePath -> Author -> FilePath -> IO ()
rename          = FilePath -> FilePath -> FilePath -> Author -> FilePath -> IO ()
darcsMove FilePath
repo
  , history :: [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
history         = FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
darcsLog FilePath
repo
  , latest :: FilePath -> IO FilePath
latest          = FilePath -> FilePath -> IO FilePath
darcsLatestRevId FilePath
repo
  , revision :: FilePath -> IO Revision
revision        = FilePath -> FilePath -> IO Revision
darcsGetRevision FilePath
repo
  , index :: IO [FilePath]
index           = FilePath -> IO [FilePath]
darcsIndex FilePath
repo
  , directory :: FilePath -> IO [Resource]
directory       = FilePath -> FilePath -> IO [Resource]
darcsDirectory FilePath
repo
  , search :: SearchQuery -> IO [SearchMatch]
search          = FilePath -> SearchQuery -> IO [SearchMatch]
darcsSearch FilePath
repo
  , idsMatch :: FilePath -> FilePath -> Bool
idsMatch        = (FilePath -> FilePath -> Bool)
-> FilePath -> FilePath -> FilePath -> Bool
forall a b. a -> b -> a
const FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
hashsMatch FilePath
repo }

-- | Run a darcs command and return error status, error output, standard output.  The repository
-- is used as working directory.
runDarcsCommand :: FilePath -> String -> [String] -> IO (ExitCode, String, B.ByteString)
runDarcsCommand :: FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
command [FilePath]
args = do
  (ExitCode
status, ByteString
err, ByteString
out) <- FilePath
-> Maybe [(FilePath, FilePath)]
-> FilePath
-> [FilePath]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand FilePath
repo Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing FilePath
"darcs" (FilePath
command FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
args)
  (ExitCode, FilePath, ByteString)
-> IO (ExitCode, FilePath, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
status, ByteString -> FilePath
toString ByteString
err, ByteString
out)

---------------------------
-- End utility functions and types
-- Begin repository creation & modification
---------------------------

-- | Initialize a repository, creating the directory if needed.
darcsInit :: FilePath -> IO ()
darcsInit :: FilePath -> IO ()
darcsInit FilePath
repo = do
  Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
repo
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
withVerifyDir FilePath
repo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileStoreError
RepositoryExists
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
repo
  (ExitCode
status, FilePath
err, ByteString
_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"init" []
  if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
     then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"darcs init failed:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err

-- | Save changes (creating the file and directory if needed), add, and commit.
darcsSave :: Contents a => FilePath -> FilePath -> Author -> Description -> a -> IO ()
darcsSave :: forall a.
Contents a =>
FilePath -> FilePath -> Author -> FilePath -> a -> IO ()
darcsSave FilePath
repo FilePath
name Author
author FilePath
logMsg a
contents = do
  FilePath -> [FilePath] -> FilePath -> IO () -> IO ()
forall b. FilePath -> [FilePath] -> FilePath -> IO b -> IO b
withSanityCheck FilePath
repo [FilePath
"_darcs"] FilePath
name (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
B.writeFile (FilePath
repo FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
encodeArg FilePath
name) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Contents a => a -> ByteString
toByteString a
contents
  -- Just in case it hasn't been added yet; we ignore failures since darcs will
  -- fail if the file doesn't exist *and* if the file exists but has been added already.
  FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"add" [FilePath
name]
  FilePath -> [FilePath] -> Author -> FilePath -> IO ()
darcsCommit FilePath
repo [FilePath
name] Author
author FilePath
logMsg

-- | Commit changes to a resource.  Raise 'Unchanged' exception if there were none.
--   This is not for creating a new file; see 'darcsSave'. This is just for updating.
darcsCommit :: FilePath -> [FilePath] -> Author -> Description -> IO ()
darcsCommit :: FilePath -> [FilePath] -> Author -> FilePath -> IO ()
darcsCommit FilePath
repo [FilePath]
names Author
author FilePath
logMsg = do
  let args :: [FilePath]
args = [FilePath
"--all", FilePath
"-A", (Author -> FilePath
authorName Author
author FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" <" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Author -> FilePath
authorEmail Author
author FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
">"), FilePath
"-m", FilePath
logMsg] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
names
  (ExitCode
statusCommit, FilePath
errCommit, ByteString
_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"record" [FilePath]
args
  if ExitCode
statusCommit ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
     then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
errCommit
                       then FileStoreError
Unchanged
                       else FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not darcs record " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
names FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errCommit

-- | Change the name of a resource.
darcsMove :: FilePath -> FilePath -> FilePath -> Author -> Description -> IO ()
darcsMove :: FilePath -> FilePath -> FilePath -> Author -> FilePath -> IO ()
darcsMove FilePath
repo FilePath
oldName FilePath
newName Author
author FilePath
logMsg = do
  FilePath -> [FilePath] -> FilePath -> IO () -> IO ()
forall b. FilePath -> [FilePath] -> FilePath -> IO b -> IO b
withSanityCheck FilePath
repo [FilePath
"_darcs"] FilePath
newName (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (ExitCode
statusAdd, FilePath
_, ByteString
_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"add" [FilePath -> FilePath
dropFileName FilePath
newName]
    (ExitCode
statusAdd', FilePath
_,ByteString
_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"mv" [FilePath
oldName, FilePath
newName]
    if ExitCode
statusAdd ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
&& ExitCode
statusAdd' ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
       then FilePath -> [FilePath] -> Author -> FilePath -> IO ()
darcsCommit FilePath
repo [FilePath
oldName, FilePath
newName] Author
author FilePath
logMsg
       else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound

-- | Delete a resource from the repository.
darcsDelete :: FilePath -> FilePath -> Author -> Description -> IO ()
darcsDelete :: FilePath -> FilePath -> Author -> FilePath -> IO ()
darcsDelete FilePath
repo FilePath
name Author
author FilePath
logMsg = FilePath -> [FilePath] -> FilePath -> IO () -> IO ()
forall b. FilePath -> [FilePath] -> FilePath -> IO b -> IO b
withSanityCheck FilePath
repo [FilePath
"_darcs"] FilePath
name (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  FilePath
-> Maybe [(FilePath, FilePath)]
-> FilePath
-> [FilePath]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand FilePath
repo Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing FilePath
"rm" [FilePath
name]
  FilePath -> [FilePath] -> Author -> FilePath -> IO ()
darcsCommit FilePath
repo [FilePath
name] Author
author FilePath
logMsg

---------------------------
-- End repository creation & modification
-- Begin repository & history queries
--------------------------

-- | Return list of log entries for the list of resources.
-- If list of resources is empty, log entries for all resources are returned.
darcsLog :: FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
darcsLog :: FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
darcsLog FilePath
repo [FilePath]
names (TimeRange Maybe UTCTime
begin Maybe UTCTime
end) Maybe Int
mblimit = do
       (ExitCode
status, FilePath
err, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"changes" ([FilePath] -> IO (ExitCode, FilePath, ByteString))
-> [FilePath] -> IO (ExitCode, FilePath, ByteString)
forall a b. (a -> b) -> a -> b
$ [FilePath
"--xml-output", FilePath
"--summary"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
names [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
opts
       if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
        then case FilePath -> Maybe [Revision]
parseDarcsXML (FilePath -> Maybe [Revision]) -> FilePath -> Maybe [Revision]
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
toString ByteString
output of
            Maybe [Revision]
Nothing      -> FileStoreError -> IO [Revision]
forall e a. Exception e => e -> IO a
throwIO FileStoreError
ResourceExists
            Just [Revision]
parsed -> [Revision] -> IO [Revision]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Revision] -> IO [Revision]) -> [Revision] -> IO [Revision]
forall a b. (a -> b) -> a -> b
$
#ifdef USE_MAXCOUNT
                              [Revision]
parsed
#else
                              case mblimit of
                                   Just lim -> take lim parsed
                                   Nothing  -> parsed
#endif
        else FileStoreError -> IO [Revision]
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO [Revision])
-> FileStoreError -> IO [Revision]
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"darcs changes returned error status.\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
    where
        opts :: [FilePath]
opts = Maybe UTCTime -> Maybe UTCTime -> [FilePath]
timeOpts Maybe UTCTime
begin Maybe UTCTime
end [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
limit
        limit :: [FilePath]
limit = case Maybe Int
mblimit of
#ifdef USE_MAXCOUNT
                    Just Int
lim  -> [FilePath
"--max-count",Int -> FilePath
forall a. Show a => a -> FilePath
show Int
lim]
#else
                    Just _    -> []
#endif
                    Maybe Int
Nothing   -> []
        timeOpts :: Maybe UTCTime -> Maybe UTCTime ->[String]
        timeOpts :: Maybe UTCTime -> Maybe UTCTime -> [FilePath]
timeOpts Maybe UTCTime
b Maybe UTCTime
e = case (Maybe UTCTime
b,Maybe UTCTime
e) of
                (Maybe UTCTime
Nothing,Maybe UTCTime
Nothing) -> []
                (Just UTCTime
b', Just UTCTime
e') -> UTCTime -> [FilePath]
from UTCTime
b' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ UTCTime -> [FilePath]
to UTCTime
e'
                (Just UTCTime
b', Maybe UTCTime
Nothing) -> UTCTime -> [FilePath]
from UTCTime
b'
                (Maybe UTCTime
Nothing, Just UTCTime
e') -> UTCTime -> [FilePath]
to UTCTime
e'
                where from :: UTCTime -> [FilePath]
from UTCTime
z = [FilePath
"--match=date \"after " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UTCTime -> FilePath
undate UTCTime
z FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\""]
                      to :: UTCTime -> [FilePath]
to UTCTime
z = [FilePath
"--to-match=date \"before " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UTCTime -> FilePath
undate UTCTime
z FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\""]
                      undate :: UTCTime -> FilePath
undate = UTCTime -> FilePath
toSqlString
                      toSqlString :: UTCTime -> FilePath
toSqlString = TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%FT%X"

-- | Get revision information for a particular revision ID, or latest revision.
darcsGetRevision :: FilePath -> RevisionId -> IO Revision
darcsGetRevision :: FilePath -> FilePath -> IO Revision
darcsGetRevision FilePath
repo FilePath
hash = do (ExitCode
_,FilePath
_,ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"changes"
                                                [FilePath
"--xml-output", FilePath
"--summary", FilePath
"--match=hash " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
hash]
                                let hists :: Maybe [Revision]
hists = FilePath -> Maybe [Revision]
parseDarcsXML (FilePath -> Maybe [Revision]) -> FilePath -> Maybe [Revision]
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
toString ByteString
output
                                case Maybe [Revision]
hists of
                                    Maybe [Revision]
Nothing -> FileStoreError -> IO Revision
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
                                    Just [Revision]
a  -> Revision -> IO Revision
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Revision -> IO Revision) -> Revision -> IO Revision
forall a b. (a -> b) -> a -> b
$ [Revision] -> Revision
forall a. HasCallStack => [a] -> a
head [Revision]
a

-- | Return revision ID for latest commit for a resource.
darcsLatestRevId :: FilePath -> FilePath -> IO RevisionId
darcsLatestRevId :: FilePath -> FilePath -> IO FilePath
darcsLatestRevId FilePath
repo FilePath
name = do
  FilePath -> FilePath -> IO ()
ensureFileExists FilePath
repo FilePath
name
#ifdef USE_MAXCOUNT
  (ExitCode
status, FilePath
err, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"changes" [FilePath
"--xml-output", FilePath
"--max-count=1", FilePath
name]
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess Bool -> Bool -> Bool
&& FilePath
"unrecognized option" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NoMaxCount
#else
  (_, _, output) <- runDarcsCommand repo "changes" ["--xml-output", name]
#endif
  let patchs :: Maybe [Revision]
patchs = FilePath -> Maybe [Revision]
parseDarcsXML (FilePath -> Maybe [Revision]) -> FilePath -> Maybe [Revision]
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
toString ByteString
output
  case Maybe [Revision]
patchs of
      Maybe [Revision]
Nothing -> FileStoreError -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
      Just [] -> FileStoreError -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
      Just (Revision
x:[Revision]
_) -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Revision -> FilePath
revId Revision
x

-- | Retrieve the contents of a resource.
darcsRetrieve :: Contents a
            => FilePath
            -> FilePath
            -> Maybe RevisionId    -- ^ @Just@ revision ID, or @Nothing@ for latest
            -> IO a
darcsRetrieve :: forall a.
Contents a =>
FilePath -> FilePath -> Maybe FilePath -> IO a
darcsRetrieve FilePath
repo FilePath
name Maybe FilePath
mbId = do
  let opts :: [FilePath]
opts = case Maybe FilePath
mbId of
              Maybe FilePath
Nothing    -> [FilePath
"contents", FilePath
name]
              Just FilePath
revid -> [FilePath
"contents", FilePath
"--match=hash " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
revid, FilePath
name]
  (ExitCode
status, FilePath
err, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"show" [FilePath]
opts
  if ByteString -> Bool
B.null ByteString
output
     then do
       (ExitCode
_, FilePath
_, ByteString
out) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"show" ([FilePath
"files", FilePath
"--no-directories"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
opts)
       if ByteString -> Bool
B.null ByteString
out Bool -> Bool -> Bool
|| [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
name) ([FilePath] -> [FilePath])
-> (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [FilePath]
getNames (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString
output)
          then FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
          else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
     then a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall a. Contents a => ByteString -> a
fromByteString ByteString
output
     else FileStoreError -> IO a
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO a) -> FileStoreError -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"Error in darcs query contents:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
          
getNames :: B.ByteString -> [String]
getNames :: ByteString -> [FilePath]
getNames = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
2) ([FilePath] -> [FilePath])
-> (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [FilePath])
-> (ByteString -> FilePath) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
toString

-- | Get a list of all known files inside and managed by a repository.
darcsIndex :: FilePath ->IO [FilePath]
darcsIndex :: FilePath -> IO [FilePath]
darcsIndex FilePath
repo = FilePath -> IO [FilePath] -> IO [FilePath]
forall a. FilePath -> IO a -> IO a
withVerifyDir FilePath
repo (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
  (ExitCode
status, FilePath
_errOutput, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"query"  [FilePath
"files",FilePath
"--no-directories"]
  if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
     then [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath])
-> (ByteString -> [FilePath]) -> ByteString -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [FilePath]
getNames (ByteString -> IO [FilePath]) -> ByteString -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString
output
     else [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []   -- return empty list if invalid path (see gitIndex)

-- | Get a list of all resources inside a directory in the repository.
darcsDirectory :: FilePath -> FilePath -> IO [Resource]
darcsDirectory :: FilePath -> FilePath -> IO [Resource]
darcsDirectory FilePath
repo FilePath
dir = FilePath -> IO [Resource] -> IO [Resource]
forall a. FilePath -> IO a -> IO a
withVerifyDir (FilePath
repo FilePath -> FilePath -> FilePath
</> FilePath
dir) (IO [Resource] -> IO [Resource]) -> IO [Resource] -> IO [Resource]
forall a b. (a -> b) -> a -> b
$ do
  let dir' :: FilePath
dir' = if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir then FilePath
"" else FilePath -> FilePath
addTrailingPathSeparator FilePath
dir
  (ExitCode
status1, FilePath
_errOutput1, ByteString
output1) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"query"  [FilePath
"files",FilePath
"--no-directories"]
  (ExitCode
status2, FilePath
_errOutput2, ByteString
output2) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo FilePath
"query" [FilePath
"files",FilePath
"--no-files"]
  if ExitCode
status1 ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
&& ExitCode
status2 ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
     then do
       let files :: [FilePath]
files = FilePath -> [FilePath] -> [FilePath]
adhocParsing FilePath
dir' ([FilePath] -> [FilePath])
-> (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [FilePath])
-> (ByteString -> FilePath) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
toString (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString
output1
       -- We need to do 'drop $ length dir' + 3' because Darcs returns files like ["./foo/foobar"].
       let dirs :: [FilePath]
dirs  = FilePath -> [FilePath] -> [FilePath]
adhocParsing FilePath
dir' ([FilePath] -> [FilePath])
-> (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
1 ([FilePath] -> [FilePath])
-> (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [FilePath])
-> (ByteString -> FilePath) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
toString (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString
output2
       -- We need the drop 1 to eliminate the root directory, which appears first.
       -- Now, select the ones that are in THIS directory and convert to Resources:
       let files' :: [Resource]
files' = (FilePath -> Resource) -> [FilePath] -> [Resource]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Resource
FSFile  ([FilePath] -> [Resource]) -> [FilePath] -> [Resource]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'/' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`) [FilePath]
files
       let dirs' :: [Resource]
dirs'  = (FilePath -> Resource) -> [FilePath] -> [Resource]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Resource
FSDirectory ([FilePath] -> [Resource]) -> [FilePath] -> [Resource]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'/' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`) [FilePath]
dirs
       [Resource] -> IO [Resource]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Resource] -> IO [Resource]) -> [Resource] -> IO [Resource]
forall a b. (a -> b) -> a -> b
$ [Resource] -> [Resource]
forall a. Ord a => [a] -> [a]
sort ([Resource]
files' [Resource] -> [Resource] -> [Resource]
forall a. [a] -> [a] -> [a]
++ [Resource]
dirs') 
     else [Resource] -> IO [Resource]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []  -- returns empty list for invalid path (see gitDirectory)
              where adhocParsing :: FilePath -> [FilePath] -> [FilePath]
adhocParsing FilePath
d = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop (Int -> FilePath -> FilePath) -> Int -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath
"." FilePath -> FilePath -> FilePath
</> FilePath
d) FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)

-- Use the generic grep-based search of a repo.
darcsSearch :: FilePath -> SearchQuery -> IO [SearchMatch]
darcsSearch :: FilePath -> SearchQuery -> IO [SearchMatch]
darcsSearch = (FilePath -> IO [FilePath])
-> FilePath -> SearchQuery -> IO [SearchMatch]
grepSearchRepo FilePath -> IO [FilePath]
darcsIndex