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