{-# LANGUAGE CPP #-}
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)
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 }
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)
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
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
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
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
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
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
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"
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
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
darcsRetrieve :: Contents a
=> FilePath
-> FilePath
-> Maybe RevisionId
-> 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
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 []
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
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
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 []
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`)
darcsSearch :: FilePath -> SearchQuery -> IO [SearchMatch]
darcsSearch :: FilePath -> SearchQuery -> IO [SearchMatch]
darcsSearch = (FilePath -> IO [FilePath])
-> FilePath -> SearchQuery -> IO [SearchMatch]
grepSearchRepo FilePath -> IO [FilePath]
darcsIndex