{-# 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 repo :: FilePath
repo = FileStore :: IO ()
-> (forall a.
    Contents a =>
    FilePath -> Author -> FilePath -> a -> IO ())
-> (forall a. Contents a => FilePath -> Maybe FilePath -> IO a)
-> (FilePath -> Author -> FilePath -> IO ())
-> (FilePath -> FilePath -> Author -> FilePath -> IO ())
-> ([FilePath] -> TimeRange -> Maybe Int -> IO [Revision])
-> (FilePath -> IO FilePath)
-> (FilePath -> IO Revision)
-> IO [FilePath]
-> (FilePath -> IO [Resource])
-> (FilePath -> FilePath -> Bool)
-> (SearchQuery -> IO [SearchMatch])
-> FileStore
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 repo :: FilePath
repo command :: FilePath
command args :: [FilePath]
args = do
  (status :: ExitCode
status, err :: ByteString
err, out :: ByteString
out) <- FilePath
-> Maybe [(FilePath, FilePath)]
-> FilePath
-> [FilePath]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand FilePath
repo Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing "darcs" (FilePath
command FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
args)
  (ExitCode, FilePath, ByteString)
-> IO (ExitCode, FilePath, ByteString)
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 repo :: 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
  (status :: ExitCode
status, err :: FilePath
err, _) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "init" []
  if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
     then () -> IO ()
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
$ "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 :: FilePath -> FilePath -> Author -> FilePath -> a -> IO ()
darcsSave repo :: FilePath
repo name :: FilePath
name author :: Author
author logMsg :: FilePath
logMsg contents :: a
contents = do
  FilePath -> [FilePath] -> FilePath -> IO () -> IO ()
forall b. FilePath -> [FilePath] -> FilePath -> IO b -> IO b
withSanityCheck FilePath
repo ["_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 "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 repo :: FilePath
repo names :: [FilePath]
names author :: Author
author logMsg :: FilePath
logMsg = do
  let args :: [FilePath]
args = ["--all", "-A", (Author -> FilePath
authorName Author
author FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " <" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Author -> FilePath
authorEmail Author
author FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ">"), "-m", FilePath
logMsg] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
names
  (statusCommit :: ExitCode
statusCommit, errCommit :: FilePath
errCommit, _) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "record" [FilePath]
args
  if ExitCode
statusCommit ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
     then () -> IO ()
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 (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
$ "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]
++ "\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 repo :: FilePath
repo oldName :: FilePath
oldName newName :: FilePath
newName author :: Author
author logMsg :: FilePath
logMsg = do
  FilePath -> [FilePath] -> FilePath -> IO () -> IO ()
forall b. FilePath -> [FilePath] -> FilePath -> IO b -> IO b
withSanityCheck FilePath
repo ["_darcs"] FilePath
newName (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (statusAdd :: ExitCode
statusAdd, _, _) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "add" [FilePath -> FilePath
dropFileName FilePath
newName]
    (statusAdd' :: ExitCode
statusAdd', _,_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "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 repo :: FilePath
repo name :: FilePath
name author :: Author
author logMsg :: FilePath
logMsg = FilePath -> [FilePath] -> FilePath -> IO () -> IO ()
forall b. FilePath -> [FilePath] -> FilePath -> IO b -> IO b
withSanityCheck FilePath
repo ["_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 "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 repo :: FilePath
repo names :: [FilePath]
names (TimeRange begin :: Maybe UTCTime
begin end :: Maybe UTCTime
end) mblimit :: Maybe Int
mblimit = do
       (status :: ExitCode
status, err :: FilePath
err, output :: ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "changes" ([FilePath] -> IO (ExitCode, FilePath, ByteString))
-> [FilePath] -> IO (ExitCode, FilePath, ByteString)
forall a b. (a -> b) -> a -> b
$ ["--xml-output", "--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
            Nothing      -> FileStoreError -> IO [Revision]
forall e a. Exception e => e -> IO a
throwIO FileStoreError
ResourceExists
            Just parsed :: [Revision]
parsed -> [Revision] -> IO [Revision]
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
$ "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 lim :: Int
lim  -> ["--max-count",Int -> FilePath
forall a. Show a => a -> FilePath
show Int
lim]
#else
                    Just _    -> []
#endif
                    Nothing   -> []
        timeOpts :: Maybe UTCTime -> Maybe UTCTime ->[String]
        timeOpts :: Maybe UTCTime -> Maybe UTCTime -> [FilePath]
timeOpts b :: Maybe UTCTime
b e :: Maybe UTCTime
e = case (Maybe UTCTime
b,Maybe UTCTime
e) of
                (Nothing,Nothing) -> []
                (Just b' :: UTCTime
b', Just e' :: UTCTime
e') -> UTCTime -> [FilePath]
from UTCTime
b' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ UTCTime -> [FilePath]
to UTCTime
e'
                (Just b' :: UTCTime
b', Nothing) -> UTCTime -> [FilePath]
from UTCTime
b'
                (Nothing, Just e' :: UTCTime
e') -> UTCTime -> [FilePath]
to UTCTime
e'
                where from :: UTCTime -> [FilePath]
from z :: UTCTime
z = ["--match=date \"after " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UTCTime -> FilePath
undate UTCTime
z FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\""]
                      to :: UTCTime -> [FilePath]
to z :: UTCTime
z = ["--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]
++ "\""]
                      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 "%FT%X"

-- | Get revision information for a particular revision ID, or latest revision.
darcsGetRevision :: FilePath -> RevisionId -> IO Revision
darcsGetRevision :: FilePath -> FilePath -> IO Revision
darcsGetRevision repo :: FilePath
repo hash :: FilePath
hash = do (_,_,output :: ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "changes"
                                                ["--xml-output", "--summary", "--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
                                    Nothing -> FileStoreError -> IO Revision
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
                                    Just a :: [Revision]
a  -> Revision -> IO Revision
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. [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 repo :: FilePath
repo name :: FilePath
name = do
  FilePath -> FilePath -> IO ()
ensureFileExists FilePath
repo FilePath
name
#ifdef USE_MAXCOUNT
  (status :: ExitCode
status, err :: FilePath
err, output :: ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "changes" ["--xml-output", "--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
&& "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
      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 (x :: Revision
x:_) -> FilePath -> IO FilePath
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 :: FilePath -> FilePath -> Maybe FilePath -> IO a
darcsRetrieve repo :: FilePath
repo name :: FilePath
name mbId :: Maybe FilePath
mbId = do
  let opts :: [FilePath]
opts = case Maybe FilePath
mbId of
              Nothing    -> ["contents", FilePath
name]
              Just revid :: FilePath
revid -> ["contents", "--match=hash " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
revid, FilePath
name]
  (status :: ExitCode
status, err :: FilePath
err, output :: ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "show" [FilePath]
opts
  if ByteString -> Bool
B.null ByteString
output
     then do
       (_, _, out :: ByteString
out) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "show" (["files", "--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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
     else () -> IO ()
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 (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
$ "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 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 repo :: 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
  (status :: ExitCode
status, _errOutput :: FilePath
_errOutput, output :: ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "query"  ["files","--no-directories"]
  if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
     then [FilePath] -> IO [FilePath]
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 (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 repo :: FilePath
repo dir :: 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 (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir then "" else FilePath -> FilePath
addTrailingPathSeparator FilePath
dir
  (status1 :: ExitCode
status1, _errOutput1 :: FilePath
_errOutput1, output1 :: ByteString
output1) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "query"  ["files","--no-directories"]
  (status2 :: ExitCode
status2, _errOutput2 :: FilePath
_errOutput2, output2 :: ByteString
output2) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runDarcsCommand FilePath
repo "query" ["files","--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 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 -> 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 -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`) [FilePath]
dirs
       [Resource] -> IO [Resource]
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 (m :: * -> *) a. Monad m => a -> m a
return []  -- returns empty list for invalid path (see gitDirectory)
              where adhocParsing :: FilePath -> [FilePath] -> [FilePath]
adhocParsing d :: 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 (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
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