    {- |
       Module      : Data.FileStore.Mercurial
       Copyright   : Copyright (C) 2009 John MacFarlane
       License     : BSD 3

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

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

    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)

    -- | Return a filestore implemented using the mercurial distributed revision control system
    -- (<http://mercurial.selenic.com/>).
    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
      }

    -- | Initialize a repository, creating the directory if needed.
    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
           -- Add a hook so that changes made remotely via hg will be reflected in
           -- the working directory.  See:
           -- http://mercurial.selenic.com/wiki/FAQ#FAQ.2BAC8-CommonProblems.Any_way_to_.27hg_push.27_and_have_an_automatic_.27hg_update.27_on_the_remote_server.3F
           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

    -- | Commit changes to a resource.  Raise 'Unchanged' exception if there were
    -- no changes.
    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

    -- | Save changes (creating file and directory if needed), add, and commit.
    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

    -- | Retrieve contents from resource.
    --   Mercurial does not track directories so catting from a directory returns all files
    mercurialRetrieve :: Contents a
                => FilePath
                -> FilePath
                -> Maybe RevisionId    -- ^ @Just@ revision ID, or @Nothing@ for latest
                -> 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

    -- | Delete a resource from the repository.
    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

    -- | Change the name of a resource.
    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   -- will throw a NotFound error if oldName doesn't exist
      (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

    -- | Return revision ID for latest commit for a resource.
    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

    -- | Get revision information for a particular revision ID, or latest revision.
    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

    -- | Get a list of all known files inside and managed by a repository.
    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 [] -- if error, will return empty list

    -- | Get list of resources in one directory of the repository.  Mercurial does not store or track directories,
    --   so the locate command does not return any directories.  Instead we first list all the files, then list all
    --   files in subdirectories of the given directory and use that to contruct the list of directories.
    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

    -- | Use generic grep to search
    mercurialSearch :: FilePath -> SearchQuery -> IO [SearchMatch]
    mercurialSearch :: String -> SearchQuery -> IO [SearchMatch]
    mercurialSearch = (String -> IO [String])
    -> String -> SearchQuery -> IO [SearchMatch]
    grepSearchRepo String -> IO [String]
    mercurialIndex

    {- The following code goes not work because of a bug in mercurial.  If the final line of a file
    does not end with a newline and you search for a word in the final line, hg does not display
    the line from the file correctly.  In the results, the last character line is not printed.
    mercurialSearch repo query = do
      let patterns = map escapeRegexSpecialChars $ queryPatterns query
          pattern = if queryWholeWords query
                      then "(\\b" ++ foldr1 (\a b -> a ++ "\\b|\\b" ++ b) patterns ++ "\\b)"
                      else "(" ++ foldr1 (\a b -> a ++ "|" ++ b) patterns ++ ")"
      (status, errOutput, output) <- runMercurialCommand repo "grep" (["--ignore-case" | queryIgnoreCase query] ++ ["-n", "-0", pattern])
      case status of
         ExitSuccess   -> do
                           putStrLn $ show output
                           case P.parse parseMercurialSearch "" (toString output) of
                            Left err'    -> throwIO $ UnknownError $ "Error parsing mercurial search results.\n" ++ show err'
                            Right parsed -> return parsed
         ExitFailure 1 -> return []  -- status of 1 means no matches
         ExitFailure _ -> throwIO $ UnknownError $ "mercurial grep returned error status.\n" ++ errOutput
    -}

    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"

    -- | Return list of log entries for the given time frame and list of resources.
    -- If list of resources is empty, log entries for all resources are returned.
    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   -> []

    --
    -- Parsers to parse mercurial log into Revisions.
    --

    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
                }

    {-
    parseMercurialSearch :: P.Parser [SearchMatch]
    parseMercurialSearch = P.manyTill mercurialSearchFormat P.eof

    mercurialSearchFormat :: P.Parser SearchMatch
    mercurialSearchFormat = do
      fname <- nullStr
      nullStr -- revision number
      lineNum <- nullStr
      txt <- nullStr
      return SearchMatch {
                 matchResourceName = fname
               , matchLineNumber = read lineNum
               , matchLine = txt
               }
    -}