module Data.FileStore.Mercurial
( mercurialFileStore
)
where
import Data.FileStore.Types
import Data.Maybe (fromJust)
import System.Exit
import Data.FileStore.Utils (withSanityCheck, hashsMatch, withVerifyDir, grepSearchRepo, encodeArg)
import Data.FileStore.MercurialCommandServer
import Data.ByteString.Lazy.UTF8 (toString)
import qualified Data.ByteString.Lazy as B
import qualified Text.ParserCombinators.Parsec as P
import Data.List (nub)
import Control.Monad (when, liftM, unless)
import System.FilePath ((</>), splitDirectories, takeFileName)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
import Control.Exception (throwIO)
import Data.FileStore.Compat.Locale (defaultTimeLocale)
import Data.Time (parseTimeM, formatTime)
mercurialFileStore :: FilePath -> FileStore
mercurialFileStore :: String -> FileStore
mercurialFileStore String
repo = FileStore {
initialize :: IO ()
initialize = String -> IO ()
mercurialInit String
repo
, save :: forall a. Contents a => String -> Author -> String -> a -> IO ()
save = String -> String -> Author -> String -> a -> IO ()
forall a.
Contents a =>
String -> String -> Author -> String -> a -> IO ()
mercurialSave String
repo
, retrieve :: forall a. Contents a => String -> Maybe String -> IO a
retrieve = String -> String -> Maybe String -> IO a
forall a. Contents a => String -> String -> Maybe String -> IO a
mercurialRetrieve String
repo
, delete :: String -> Author -> String -> IO ()
delete = String -> String -> Author -> String -> IO ()
mercurialDelete String
repo
, rename :: String -> String -> Author -> String -> IO ()
rename = String -> String -> String -> Author -> String -> IO ()
mercurialMove String
repo
, history :: [String] -> TimeRange -> Maybe Int -> IO [Revision]
history = String -> [String] -> TimeRange -> Maybe Int -> IO [Revision]
mercurialLog String
repo
, latest :: String -> IO String
latest = String -> String -> IO String
mercurialLatestRevId String
repo
, revision :: String -> IO Revision
revision = String -> String -> IO Revision
mercurialGetRevision String
repo
, index :: IO [String]
index = String -> IO [String]
mercurialIndex String
repo
, directory :: String -> IO [Resource]
directory = String -> String -> IO [Resource]
mercurialDirectory String
repo
, search :: SearchQuery -> IO [SearchMatch]
search = String -> SearchQuery -> IO [SearchMatch]
mercurialSearch String
repo
, idsMatch :: String -> String -> Bool
idsMatch = (String -> String -> Bool) -> String -> String -> String -> Bool
forall a b. a -> b -> a
const String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
hashsMatch String
repo
}
mercurialInit :: FilePath -> IO ()
mercurialInit :: String -> IO ()
mercurialInit String
repo = do
Bool
exists <- String -> IO Bool
doesDirectoryExist String
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
withVerifyDir String
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 -> String -> IO ()
createDirectoryIfMissing Bool
True String
repo
(ExitCode
status, String
err, ByteString
_) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
rawRunMercurialCommand String
repo String
"init" []
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then
String -> ByteString -> IO ()
B.writeFile (String
repo String -> String -> String
</> String
".hg" String -> String -> String
</> String
"hgrc") (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> ByteString
forall a. Contents a => a -> ByteString
toByteString String
"[hooks]\nchangegroup = hg update >&2\n"
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"mercurial init failed:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
mercurialCommit :: FilePath -> [FilePath] -> Author -> String -> IO ()
mercurialCommit :: String -> [String] -> Author -> String -> IO ()
mercurialCommit String
repo [String]
names Author
author String
logMsg = do
let email :: String
email = Author -> String
authorEmail Author
author
email' :: String
email' = if Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
email)
then String
" <" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
email String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
else String
""
(ExitCode
statusCommit, String
errCommit, ByteString
_) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"commit" ([String] -> IO (ExitCode, String, ByteString))
-> [String] -> IO (ExitCode, String, ByteString)
forall a b. (a -> b) -> a -> b
$ [String
"--user", Author -> String
authorName Author
author String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
email', String
"-m", String
logMsg] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
names
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
statusCommit ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
errCommit
then FileStoreError
Unchanged
else String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"Could not hg commit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
names String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errCommit
mercurialSave :: Contents a => FilePath -> FilePath -> Author -> Description -> a -> IO ()
mercurialSave :: forall a.
Contents a =>
String -> String -> Author -> String -> a -> IO ()
mercurialSave String
repo String
name Author
author String
logMsg a
contents = do
String -> [String] -> String -> IO () -> IO ()
forall b. String -> [String] -> String -> IO b -> IO b
withSanityCheck String
repo [String
".hg"] String
name (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
B.writeFile (String
repo String -> String -> String
</> String -> String
encodeArg String
name) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Contents a => a -> ByteString
toByteString a
contents
(ExitCode
statusAdd, String
errAdd, ByteString
_) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"add" [String
"path:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name]
if ExitCode
statusAdd ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then String -> [String] -> Author -> String -> IO ()
mercurialCommit String
repo [String
name] Author
author String
logMsg
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"Could not hg add '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errAdd
mercurialRetrieve :: Contents a
=> FilePath
-> FilePath
-> Maybe RevisionId
-> IO a
mercurialRetrieve :: forall a. Contents a => String -> String -> Maybe String -> IO a
mercurialRetrieve String
repo String
name Maybe String
revid = do
let revname :: String
revname = case Maybe String
revid of
Maybe String
Nothing -> String
"tip"
Just String
rev -> String
rev
(ExitCode
statcheck, String
_, ByteString
_) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"locate" [String
"-r", String
revname, String
"-X", String
"glob:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
</> String
"*", String
"path:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
statcheck ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
(ExitCode
status, String
err, ByteString
output) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"cat" [String
"-r", String
revname, String
"-X", String
"glob:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
</> String
"*", String
"path:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name]
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
$ String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"Error in mercurial cat:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
mercurialDelete :: FilePath -> FilePath -> Author -> Description -> IO ()
mercurialDelete :: String -> String -> Author -> String -> IO ()
mercurialDelete String
repo String
name Author
author String
logMsg = String -> [String] -> String -> IO () -> IO ()
forall b. String -> [String] -> String -> IO b -> IO b
withSanityCheck String
repo [String
".hg"] String
name (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(ExitCode
statusAdd, String
errRm, ByteString
_) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"remove" [String
"path:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name]
if ExitCode
statusAdd ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then String -> [String] -> Author -> String -> IO ()
mercurialCommit String
repo [String
name] Author
author String
logMsg
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"Could not hg rm '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errRm
mercurialMove :: FilePath -> FilePath -> FilePath -> Author -> Description -> IO ()
mercurialMove :: String -> String -> String -> Author -> String -> IO ()
mercurialMove String
repo String
oldName String
newName Author
author String
logMsg = do
String -> String -> IO String
mercurialLatestRevId String
repo String
oldName
(ExitCode
statusAdd, String
err, ByteString
_) <- String
-> [String]
-> String
-> IO (ExitCode, String, ByteString)
-> IO (ExitCode, String, ByteString)
forall b. String -> [String] -> String -> IO b -> IO b
withSanityCheck String
repo [String
".hg"] String
newName (IO (ExitCode, String, ByteString)
-> IO (ExitCode, String, ByteString))
-> IO (ExitCode, String, ByteString)
-> IO (ExitCode, String, ByteString)
forall a b. (a -> b) -> a -> b
$ String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"mv" [String
oldName, String
newName]
if ExitCode
statusAdd ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then String -> [String] -> Author -> String -> IO ()
mercurialCommit String
repo [String
oldName, String
newName] Author
author String
logMsg
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"Could not hg mv " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
oldName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
newName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
mercurialLatestRevId :: FilePath -> FilePath -> IO RevisionId
mercurialLatestRevId :: String -> String -> IO String
mercurialLatestRevId String
repo String
name = do
(ExitCode
status, String
_, ByteString
output) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"log" [String
"--template", String
"{node}\\n{file_dels}\\n", String
"--limit", String
"1", String
"--removed", String
"path:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name]
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then do
let result :: [String]
result = String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
toString ByteString
output
if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
result Bool -> Bool -> Bool
|| String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
result
then FileStoreError -> IO String
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
else String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
result
else FileStoreError -> IO String
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
mercurialGetRevision :: FilePath -> RevisionId -> IO Revision
mercurialGetRevision :: String -> String -> IO Revision
mercurialGetRevision String
repo String
revid = do
(ExitCode
status, String
_, ByteString
output) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"log" [String
"--template", String
mercurialLogFormat, String
"--limit", String
"1", String
"-r", String
revid]
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then case Parsec String () [Revision]
-> String -> String -> Either ParseError [Revision]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec String () [Revision]
parseMercurialLog String
"" (ByteString -> String
toString ByteString
output) of
Left ParseError
err' -> 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
$ String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"error parsing mercurial log: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err'
Right [Revision
r] -> Revision -> IO Revision
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Revision
r
Right [] -> FileStoreError -> IO Revision
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
Right [Revision]
xs -> 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
$ String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"mercurial log returned more than one result: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Revision] -> String
forall a. Show a => a -> String
show [Revision]
xs
else FileStoreError -> IO Revision
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
mercurialIndex :: FilePath ->IO [FilePath]
mercurialIndex :: String -> IO [String]
mercurialIndex String
repo = String -> IO [String] -> IO [String]
forall a. String -> IO a -> IO a
withVerifyDir String
repo (IO [String] -> IO [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ do
(ExitCode
status, String
_err, ByteString
output) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"manifest" [String
"-r", String
"tip"]
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
toString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
output
else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
mercurialDirectory :: FilePath -> FilePath -> IO [Resource]
mercurialDirectory :: String -> String -> IO [Resource]
mercurialDirectory String
repo String
dir = String -> IO [Resource] -> IO [Resource]
forall a. String -> IO a -> IO a
withVerifyDir (String
repo String -> String -> String
</> String
dir) (IO [Resource] -> IO [Resource]) -> IO [Resource] -> IO [Resource]
forall a b. (a -> b) -> a -> b
$ do
(ExitCode
status, String
_, ByteString
output) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"locate" [String
"-r", String
"tip", String
"glob:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
dir String -> String -> String
</> String
"*")]
let files :: [Resource]
files = if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then (String -> Resource) -> [String] -> [Resource]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Resource
FSFile (String -> Resource) -> (String -> String) -> String -> Resource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeFileName (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall {t :: * -> *} {a} {a}. Foldable t => t a -> [a] -> [a]
removePrefix String
dir) ([String] -> [Resource]) -> [String] -> [Resource]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
toString ByteString
output
else []
(ExitCode
status2, String
_, ByteString
output2) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"locate" [String
"-r", String
"tip", String
"glob:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
dir String -> String -> String
</> String
"*" String -> String -> String
</> String
"*")]
let dirs :: [Resource]
dirs = if ExitCode
status2 ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then (String -> Resource) -> [String] -> [Resource]
forall a b. (a -> b) -> [a] -> [b]
map String -> Resource
FSDirectory ([String] -> [Resource]) -> [String] -> [Resource]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
forall a. HasCallStack => [a] -> a
head ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall {t :: * -> *} {a} {a}. Foldable t => t a -> [a] -> [a]
removePrefix String
dir) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
toString ByteString
output2
else []
[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]
files [Resource] -> [Resource] -> [Resource]
forall a. [a] -> [a] -> [a]
++ [Resource]
dirs
where removePrefix :: t a -> [a] -> [a]
removePrefix t a
d = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> [a] -> [a]) -> Int -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
d
mercurialSearch :: FilePath -> SearchQuery -> IO [SearchMatch]
mercurialSearch :: String -> SearchQuery -> IO [SearchMatch]
mercurialSearch = (String -> IO [String])
-> String -> SearchQuery -> IO [SearchMatch]
grepSearchRepo String -> IO [String]
mercurialIndex
mercurialLogFormat :: String
mercurialLogFormat :: String
mercurialLogFormat = String
"{node}\\n{date|rfc822date}\\n{author|person}\\n{author|email}\\n{desc}\\x00{file_adds}\\x00{file_mods}\\x00{file_dels}\\x00"
mercurialLog :: FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
mercurialLog :: String -> [String] -> TimeRange -> Maybe Int -> IO [Revision]
mercurialLog String
repo [String]
names (TimeRange Maybe UTCTime
mbSince Maybe UTCTime
mbUntil) Maybe Int
mblimit = do
(ExitCode
status, String
err, ByteString
output) <- String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
"log" ([String] -> IO (ExitCode, String, ByteString))
-> [String] -> IO (ExitCode, String, ByteString)
forall a b. (a -> b) -> a -> b
$ [String
"--template", String
mercurialLogFormat] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Maybe UTCTime -> Maybe UTCTime -> [String]
revOpts Maybe UTCTime
mbSince Maybe UTCTime
mbUntil [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
limit [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
names
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then case Parsec String () [Revision]
-> String -> String -> Either ParseError [Revision]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec String () [Revision]
parseMercurialLog String
"" (ByteString -> String
toString ByteString
output) of
Left ParseError
err' -> 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
$ String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"Error parsing mercurial log.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err'
Right [Revision]
parsed -> [Revision] -> IO [Revision]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Revision]
parsed
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
$ String -> FileStoreError
UnknownError (String -> FileStoreError) -> String -> FileStoreError
forall a b. (a -> b) -> a -> b
$ String
"mercurial log returned error status.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
where revOpts :: Maybe UTCTime -> Maybe UTCTime -> [String]
revOpts Maybe UTCTime
Nothing Maybe UTCTime
Nothing = []
revOpts Maybe UTCTime
Nothing (Just UTCTime
u) = [String
"-d", String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UTCTime -> String
showTime UTCTime
u]
revOpts (Just UTCTime
s) Maybe UTCTime
Nothing = [String
"-d", String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UTCTime -> String
showTime UTCTime
s]
revOpts (Just UTCTime
s) (Just UTCTime
u) = [String
"-d", UTCTime -> String
showTime UTCTime
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UTCTime -> String
showTime UTCTime
u]
showTime :: UTCTime -> String
showTime = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %X"
limit :: [String]
limit = case Maybe Int
mblimit of
Just Int
lim -> [String
"--limit", Int -> String
forall a. Show a => a -> String
show Int
lim]
Maybe Int
Nothing -> []
parseMercurialLog :: P.Parser [Revision]
parseMercurialLog :: Parsec String () [Revision]
parseMercurialLog = ParsecT String () Identity Revision
-> ParsecT String () Identity () -> Parsec String () [Revision]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill ParsecT String () Identity Revision
mercurialLogEntry ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof
wholeLine :: P.GenParser Char st String
wholeLine :: forall st. GenParser Char st String
wholeLine = ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> ParsecT String st Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline
nonblankLine :: P.GenParser Char st String
nonblankLine :: forall st. GenParser Char st String
nonblankLine = ParsecT String st Identity Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
P.notFollowedBy ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall a b.
ParsecT String st Identity a
-> ParsecT String st Identity b -> ParsecT String st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
wholeLine
nullStr :: P.GenParser Char st String
nullStr :: forall st. GenParser Char st String
nullStr = ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> ParsecT String st Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\x00'))
mercurialLogEntry :: P.Parser Revision
mercurialLogEntry :: ParsecT String () Identity Revision
mercurialLogEntry = do
String
rev <- GenParser Char () String
forall st. GenParser Char st String
nonblankLine
String
date <- GenParser Char () String
forall st. GenParser Char st String
nonblankLine
String
author <- GenParser Char () String
forall st. GenParser Char st String
nonblankLine
String
email <- GenParser Char () String
forall st. GenParser Char st String
wholeLine
String
subject <- GenParser Char () String
forall st. GenParser Char st String
nullStr
ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
[Change]
file_add <- (String -> [Change])
-> GenParser Char () String -> ParsecT String () Identity [Change]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((String -> Change) -> [String] -> [Change]
forall a b. (a -> b) -> [a] -> [b]
map String -> Change
Added ([String] -> [Change])
-> (String -> [String]) -> String -> [Change]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (GenParser Char () String -> ParsecT String () Identity [Change])
-> GenParser Char () String -> ParsecT String () Identity [Change]
forall a b. (a -> b) -> a -> b
$ GenParser Char () String
forall st. GenParser Char st String
nullStr
ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
[Change]
file_mod <- (String -> [Change])
-> GenParser Char () String -> ParsecT String () Identity [Change]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((String -> Change) -> [String] -> [Change]
forall a b. (a -> b) -> [a] -> [b]
map String -> Change
Modified ([String] -> [Change])
-> (String -> [String]) -> String -> [Change]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (GenParser Char () String -> ParsecT String () Identity [Change])
-> GenParser Char () String -> ParsecT String () Identity [Change]
forall a b. (a -> b) -> a -> b
$ GenParser Char () String
forall st. GenParser Char st String
nullStr
ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
[Change]
file_del <- (String -> [Change])
-> GenParser Char () String -> ParsecT String () Identity [Change]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((String -> Change) -> [String] -> [Change]
forall a b. (a -> b) -> [a] -> [b]
map String -> Change
Deleted ([String] -> [Change])
-> (String -> [String]) -> String -> [Change]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (GenParser Char () String -> ParsecT String () Identity [Change])
-> GenParser Char () String -> ParsecT String () Identity [Change]
forall a b. (a -> b) -> a -> b
$ GenParser Char () String
forall st. GenParser Char st String
nullStr
ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
let stripTrailingNewlines :: String -> String
stripTrailingNewlines = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
Revision -> ParsecT String () Identity Revision
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Revision {
revId :: String
revId = String
rev
, revDateTime :: UTCTime
revDateTime = Maybe UTCTime -> UTCTime
forall a. HasCallStack => Maybe a -> a
fromJust (Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%a, %d %b %Y %H:%M:%S %z" String
date :: Maybe UTCTime)
, revAuthor :: Author
revAuthor = Author { authorName :: String
authorName = String
author, authorEmail :: String
authorEmail = String
email }
, revDescription :: String
revDescription = String -> String
stripTrailingNewlines String
subject
, revChanges :: [Change]
revChanges = [Change]
file_add [Change] -> [Change] -> [Change]
forall a. [a] -> [a] -> [a]
++ [Change]
file_mod [Change] -> [Change] -> [Change]
forall a. [a] -> [a] -> [a]
++ [Change]
file_del
}