    {-# LANGUAGE CPP, ScopedTypeVariables #-}
    {- |
       Module      : Data.FileStore.Utils
       Copyright   : Copyright (C) 2009 John MacFarlane, Gwern Branwen
       License     : BSD 3

       Maintainer  : John MacFarlane <jgm@berkeley.edu>
       Stability   : alpha
       Portability : portable

       Utility functions for running external processes.
    -}

    module Data.FileStore.Utils (
              runShellCommand
            , mergeContents
            , hashsMatch
            , escapeRegexSpecialChars
            , parseMatchLine
            , splitEmailAuthor
            , ensureFileExists
            , regSearchFiles
            , regsSearchFile
            , withSanityCheck
            , grepSearchRepo
            , withVerifyDir
            , encodeArg ) where

    import Control.Exception (throwIO)
    import Control.Applicative ((<$>))
    import Control.Monad (liftM, liftM2, when, unless)
    import Data.ByteString.Lazy.UTF8 (toString)
    import Data.Char (isSpace)
    import Data.List (intersect, nub, isPrefixOf, isInfixOf)
    import Data.List.Split (splitWhen)
    import Data.Maybe (isJust)
    import System.Directory (doesFileExist, getTemporaryDirectory, removeFile, findExecutable, createDirectoryIfMissing, getDirectoryContents)
    import System.Exit (ExitCode(..))
    import System.FilePath ((</>), takeDirectory)
    import System.IO (openTempFile, hClose)
    import System.IO.Error (isDoesNotExistError)
    import System.Process (runProcess, waitForProcess)
    import System.Environment (getEnvironment)
    import qualified Data.ByteString.Lazy as B
    import qualified Data.ByteString as S
    import qualified Control.Exception as E
    #if MIN_VERSION_base(4,5,0)
    #else
    import Codec.Binary.UTF8.String (encodeString)
    #endif

    import Data.FileStore.Types (SearchMatch(..), FileStoreError(IllegalResourceName, NotFound, UnknownError), SearchQuery(..))

    -- | Encode argument for raw command.
    encodeArg :: String -> String
    #if MIN_VERSION_base(4,5,0)
    encodeArg :: String -> String
    encodeArg = String -> String
    forall a. a -> a
    id
    #else
    encodeArg = encodeString
    #endif

    -- | Run shell command and return error status, standard output, and error output.  Assumes
    -- UTF-8 locale. Note that this does not actually go through \/bin\/sh!
    runShellCommand :: FilePath                     -- ^ Working directory
                    -> Maybe [(String, String)]     -- ^ Environment
                    -> String                       -- ^ Command
                    -> [String]                     -- ^ Arguments
                    -> IO (ExitCode, B.ByteString, B.ByteString)
    runShellCommand :: String
    -> Maybe [(String, String)]
    -> String
    -> [String]
    -> IO (ExitCode, ByteString, ByteString)
    runShellCommand workingDir :: String
    workingDir environment :: Maybe [(String, String)]
    environment command :: String
    command optionList :: [String]
    optionList = do
      String
    tempPath <- IO String -> (SomeException -> IO String) -> IO String
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch IO String
    getTemporaryDirectory (\(SomeException
    _ :: E.SomeException) -> String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return ".")
      (outputPath :: String
    outputPath, hOut :: Handle
    hOut) <- String -> String -> IO (String, Handle)
    openTempFile String
    tempPath "out"
      (errorPath :: String
    errorPath, hErr :: Handle
    hErr) <- String -> String -> IO (String, Handle)
    openTempFile String
    tempPath "err"
      Maybe [(String, String)]
    env <- ([(String, String)] -> [(String, String)] -> [(String, String)])
    -> Maybe [(String, String)]
    -> Maybe [(String, String)]
    -> Maybe [(String, String)]
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 [(String, String)] -> [(String, String)] -> [(String, String)]
    forall a. [a] -> [a] -> [a]
    (++) Maybe [(String, String)]
    environment (Maybe [(String, String)] -> Maybe [(String, String)])
    -> ([(String, String)] -> Maybe [(String, String)])
    -> [(String, String)]
    -> Maybe [(String, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(String, String)] -> Maybe [(String, String)]
    forall a. a -> Maybe a
    Just ([(String, String)] -> Maybe [(String, String)])
    -> IO [(String, String)] -> IO (Maybe [(String, String)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [(String, String)]
    getEnvironment
      ProcessHandle
    hProcess <- String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> IO ProcessHandle
    runProcess (String -> String
    encodeArg String
    command) ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    encodeArg [String]
    optionList) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    workingDir) Maybe [(String, String)]
    env Maybe Handle
    forall a. Maybe a
    Nothing (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    hOut) (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    hErr)
      ExitCode
    status <- ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    hProcess
      ByteString
    errorOutput <- String -> IO ByteString
    S.readFile String
    errorPath
      ByteString
    output <- String -> IO ByteString
    S.readFile String
    outputPath
      String -> IO ()
    removeFile String
    errorPath
      String -> IO ()
    removeFile String
    outputPath
      (ExitCode, ByteString, ByteString)
    -> IO (ExitCode, ByteString, ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExitCode
    status, [ByteString] -> ByteString
    B.fromChunks [ByteString
    errorOutput], [ByteString] -> ByteString
    B.fromChunks [ByteString
    output])

    -- | Do a three way merge, using either git merge-file or RCS merge.  Assumes
    -- that either @git@ or @merge@ is in the system path.  Assumes UTF-8 locale.
    mergeContents :: (String, B.ByteString)     -- ^ (label, contents) of edited version
                  -> (String, B.ByteString)     -- ^ (label, contents) of original revision
                  -> (String, B.ByteString)     -- ^ (label, contents) of latest version
                  -> IO (Bool, String)          -- ^ (were there conflicts?, merged contents)
    mergeContents :: (String, ByteString)
    -> (String, ByteString)
    -> (String, ByteString)
    -> IO (Bool, String)
    mergeContents (newLabel :: String
    newLabel, newContents :: ByteString
    newContents) (originalLabel :: String
    originalLabel, originalContents :: ByteString
    originalContents) (latestLabel :: String
    latestLabel, latestContents :: ByteString
    latestContents) = do
      String
    tempPath <- IO String -> (SomeException -> IO String) -> IO String
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch IO String
    getTemporaryDirectory (\(SomeException
    _ :: E.SomeException) -> String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return ".")
      (originalPath :: String
    originalPath, hOriginal :: Handle
    hOriginal) <- String -> String -> IO (String, Handle)
    openTempFile String
    tempPath "orig"
      (latestPath :: String
    latestPath, hLatest :: Handle
    hLatest)     <- String -> String -> IO (String, Handle)
    openTempFile String
    tempPath "latest"
      (newPath :: String
    newPath, hNew :: Handle
    hNew)           <- String -> String -> IO (String, Handle)
    openTempFile String
    tempPath "new"
      Handle -> ByteString -> IO ()
    B.hPutStr Handle
    hOriginal ByteString
    originalContents IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    hOriginal
      Handle -> ByteString -> IO ()
    B.hPutStr Handle
    hLatest ByteString
    latestContents IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    hLatest
      Handle -> ByteString -> IO ()
    B.hPutStr Handle
    hNew ByteString
    newContents IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    hNew
      Bool
    gitExists <- (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (String -> IO (Maybe String)
    findExecutable "git")
      (conflicts :: Bool
    conflicts, mergedContents :: ByteString
    mergedContents) <-
        if Bool
    gitExists
           then do
             (status :: ExitCode
    status, err :: ByteString
    err, out :: ByteString
    out) <- String
    -> Maybe [(String, String)]
    -> String
    -> [String]
    -> IO (ExitCode, ByteString, ByteString)
    runShellCommand String
    tempPath Maybe [(String, String)]
    forall a. Maybe a
    Nothing "git" ["merge-file", "--stdout", "-L", String
    newLabel, "-L",
                                         String
    originalLabel, "-L", String
    latestLabel, String
    newPath, String
    originalPath, String
    latestPath]
             case ExitCode
    status of
                  ExitSuccess             -> (Bool, ByteString) -> IO (Bool, ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, ByteString
    out)
                  ExitFailure n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 0  -> (Bool, ByteString) -> IO (Bool, ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, ByteString
    out)
                  _                       -> String -> IO (Bool, ByteString)
    forall a. HasCallStack => String -> a
    error (String -> IO (Bool, ByteString))
    -> String -> IO (Bool, ByteString)
    forall a b. (a -> b) -> a -> b
    $ "merge failed: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    toString ByteString
    err
           else do
             Bool
    mergeExists <- (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (String -> IO (Maybe String)
    findExecutable "merge")
             if Bool
    mergeExists
                then do
                   (status :: ExitCode
    status, err :: ByteString
    err, out :: ByteString
    out) <- String
    -> Maybe [(String, String)]
    -> String
    -> [String]
    -> IO (ExitCode, ByteString, ByteString)
    runShellCommand String
    tempPath Maybe [(String, String)]
    forall a. Maybe a
    Nothing "merge" ["-p", "-q", "-L", String
    newLabel, "-L",
                                              String
    originalLabel, "-L", String
    latestLabel, String
    newPath, String
    originalPath, String
    latestPath]
                   case ExitCode
    status of
                        ExitSuccess             -> (Bool, ByteString) -> IO (Bool, ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, ByteString
    out)
                        ExitFailure 1           -> (Bool, ByteString) -> IO (Bool, ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, ByteString
    out)
                        _                       -> String -> IO (Bool, ByteString)
    forall a. HasCallStack => String -> a
    error (String -> IO (Bool, ByteString))
    -> String -> IO (Bool, ByteString)
    forall a b. (a -> b) -> a -> b
    $ "merge failed: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    toString ByteString
    err
                else String -> IO (Bool, ByteString)
    forall a. HasCallStack => String -> a
    error "mergeContents requires 'git' or 'merge', and neither was found in the path."
      String -> IO ()
    removeFile String
    originalPath
      String -> IO ()
    removeFile String
    latestPath
      String -> IO ()
    removeFile String
    newPath
      (Bool, String) -> IO (Bool, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    conflicts, ByteString -> String
    toString ByteString
    mergedContents)

    escapeRegexSpecialChars :: String -> String
    escapeRegexSpecialChars :: String -> String
    escapeRegexSpecialChars = String -> String -> String
    forall (t :: * -> *). Foldable t => t Char -> String -> String
    backslashEscape "?*+{}[]\\^$.()"
      where backslashEscape :: t Char -> String -> String
    backslashEscape chars :: t Char
    chars (x :: Char
    x:xs :: String
    xs) | Char
    x Char -> t Char -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t Char
    chars = '\\' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : t Char -> String -> String
    backslashEscape t Char
    chars String
    xs
            backslashEscape chars :: t Char
    chars (x :: Char
    x:xs :: String
    xs)                  = Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : t Char -> String -> String
    backslashEscape t Char
    chars String
    xs
            backslashEscape _ []                          = []

    -- | A number of VCS systems uniquely identify a particular revision or change via a
    --   cryptographic hash of some sort. These hashs can be very long, and so systems like
    --   Git and Darcs don't require the entire hash - a *unique prefix*. Thus a definition
    --   of hash equality is '==', certainly, but also simply whether either is a prefix of the
    --   other. If both are reasonably long, then the likelihood the shorter one is not a unique
    --   prefix of the longer (that is, clashes with another hash) is small.
    --   The burden of proof is on the caller to not pass a uselessly short short-hash like '1', however.
    hashsMatch :: (Eq a) => [a] -> [a] -> Bool
    hashsMatch :: [a] -> [a] -> Bool
    hashsMatch r1 :: [a]
    r1 r2 :: [a]
    r2 = [a]
    r1 [a] -> [a] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [a]
    r2 Bool -> Bool -> Bool
    || [a]
    r2 [a] -> [a] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [a]
    r1

    -- | Inquire of a certain directory whether another file lies within its ambit.
    --   This is basically asking whether the file is 'above' the directory in the filesystems's
    --   directory tree. Useful for checking the legality of a filename.
    --   Note: due to changes in canonicalizePath in ghc 7, we no longer have
    --   a reliable way to do this; so isInsideDir is False whenever either
    --   the file or the directory contains "..".
    isInsideDir :: FilePath -> FilePath -> Bool
    isInsideDir :: String -> String -> Bool
    isInsideDir name :: String
    name dir :: String
    dir = String
    dir String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    name
      Bool -> Bool -> Bool
    && Bool -> Bool
    not (".." String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String
    dir) Bool -> Bool -> Bool
    && Bool -> Bool
    not (".." String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String
    name)

    -- | A parser function. This is intended for use on strings which are output by grep programs
    --   or programs which mimic the standard grep output - which uses colons as delimiters and has
    --   3 fields: the filename, the line number, and then the matching line itself. Note that this
    --   is for use on only strings meeting that format - if it goes "file:match", this will throw
    --   a pattern-match exception.
    --
    -- > parseMatchLine "foo:10:bar baz quux" ~>
    -- > SearchMatch {matchResourceName = "foo", matchLineNumber = 10, matchLine = "bar baz quux"}
    parseMatchLine :: String -> SearchMatch
    parseMatchLine :: String -> SearchMatch
    parseMatchLine str :: String
    str =
      let (fn :: String
    fn:n :: String
    n:res :: String
    res:_) = (Char -> Bool) -> String -> [String]
    forall a. (a -> Bool) -> [a] -> [[a]]
    splitWhen (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==':') String
    str
      in  SearchMatch :: String -> Integer -> String -> SearchMatch
    SearchMatch{matchResourceName :: String
    matchResourceName = String
    fn, matchLineNumber :: Integer
    matchLineNumber = String -> Integer
    forall a. Read a => String -> a
    read String
    n, matchLine :: String
    matchLine = String
    res}

    -- | Our policy is: if the input is clearly a "name \<e\@mail.com\>" input, then we return "(Just Address, Name)"
    --   If there is no '<' in the input, then it clearly can't be of that format, and so we just return "(Nothing, Name)"
    --
    -- > splitEmailAuthor "foo bar baz@gmail.com" ~> (Nothing,"foo bar baz@gmail.com")
    -- > splitEmailAuthor "foo bar <baz@gmail.com>" ~> (Just "baz@gmail.com","foo bar")
    splitEmailAuthor :: String -> (Maybe String, String)
    splitEmailAuthor :: String -> (Maybe String, String)
    splitEmailAuthor x :: String
    x = (Maybe String
    mbEmail, String -> String
    trim String
    name)
      where (name :: String
    name, rest :: String
    rest) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    =='<') String
    x
            mbEmail :: Maybe String
    mbEmail = if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rest
                         then Maybe String
    forall a. Maybe a
    Nothing
                         else String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /='>') (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop 1 String
    rest

    -- | Trim leading and trailing spaces
    trim :: String -> String
    trim :: String -> String
    trim = 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 -> Bool
    isSpace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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 -> Bool
    isSpace

    -- | Search multiple files with a single regexp.
    --   This calls out to grep, and so supports the regular expressions grep does.
    regSearchFiles :: FilePath -> [String] -> String -> IO [String]
    regSearchFiles :: String -> [String] -> String -> IO [String]
    regSearchFiles repo :: String
    repo filesToCheck :: [String]
    filesToCheck pattern :: String
    pattern = do (_, _, result :: ByteString
    result) <- String
    -> Maybe [(String, String)]
    -> String
    -> [String]
    -> IO (ExitCode, ByteString, ByteString)
    runShellCommand String
    repo
                                                                 Maybe [(String, String)]
    forall a. Maybe a
    Nothing  "grep" ([String] -> IO (ExitCode, ByteString, ByteString))
    -> [String] -> IO (ExitCode, ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ ["--line-number", "-I", "-l", "-E", "-e", String
    pattern] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    filesToCheck
                                                  let results :: [String]
    results = [String] -> [String] -> [String]
    forall a. Eq a => [a] -> [a] -> [a]
    intersect [String]
    filesToCheck ([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
    result
                                                  [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String]
    results

    -- | Search a single file with multiple regexps.
    regsSearchFile :: [String] -> FilePath -> [String] -> String -> IO [String]
    regsSearchFile :: [String] -> String -> [String] -> String -> IO [String]
    regsSearchFile os :: [String]
    os repo :: String
    repo patterns :: [String]
    patterns file :: String
    file = do [[String]]
    res <- (String -> IO [String]) -> [String] -> IO [[String]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String -> String -> IO [String]
    run String
    file) [String]
    patterns
                                              [String] -> IO [String]
    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. Eq a => [a] -> [a]
    nub ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[String]]
    res
          where run :: String -> String -> IO [String]
    run f :: String
    f p :: String
    p = do (_,_,r :: ByteString
    r) <- String
    -> Maybe [(String, String)]
    -> String
    -> [String]
    -> IO (ExitCode, ByteString, ByteString)
    runShellCommand String
    repo Maybe [(String, String)]
    forall a. Maybe a
    Nothing "grep" ([String]
    os [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    p, String
    f])
                             [String] -> IO [String]
    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
    r

    -- | If name doesn't exist in repo or is not a file, throw 'NotFound' exception.
    ensureFileExists :: FilePath -> FilePath -> IO ()
    ensureFileExists :: String -> String -> IO ()
    ensureFileExists repo :: String
    repo name :: String
    name = do
      Bool
    isFile <- String -> IO Bool
    doesFileExist (String
    repo String -> String -> String
    </> String -> String
    encodeArg String
    name)
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    isFile (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FileStoreError -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO FileStoreError
    NotFound

    -- | Check that the filename/location is within the given repo, and not inside
    -- any of the (relative) paths in @excludes@.  Create the directory if needed.
    -- If everything checks out, then perform the specified action.
    withSanityCheck :: FilePath
                    -> [FilePath]
                    -> FilePath
                    -> IO b
                    -> IO b
    withSanityCheck :: String -> [String] -> String -> IO b -> IO b
    withSanityCheck repo :: String
    repo excludes :: [String]
    excludes name :: String
    name action :: IO b
    action = do
      let filename :: String
    filename = String
    repo String -> String -> String
    </> String -> String
    encodeArg String
    name
      let insideRepo :: Bool
    insideRepo = String
    filename String -> String -> Bool
    `isInsideDir` String
    repo
      let insideExcludes :: Bool
    insideExcludes = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or ([Bool] -> Bool) -> [Bool] -> Bool
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    filename String -> String -> Bool
    `isInsideDir`)
                              ([String] -> [Bool]) -> [String] -> [Bool]
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    repo String -> String -> String
    </>) [String]
    excludes
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    insideExcludes Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    insideRepo)
        (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FileStoreError -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO FileStoreError
    IllegalResourceName
      Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String
    takeDirectory String
    filename
      IO b
    action

    -- | Uses grep to search a file-based repository. Note that this calls out to grep; and so
    --   is generic over repos like git or darcs-based repos. (The git FileStore instance doesn't
    --   use this because git has builtin grep functionality.)
    --   Expected usage is to specialize this function with a particular backend's 'index'.
    grepSearchRepo :: (FilePath -> IO [String]) -> FilePath -> SearchQuery -> IO [SearchMatch]
    grepSearchRepo :: (String -> IO [String])
    -> String -> SearchQuery -> IO [SearchMatch]
    grepSearchRepo indexer :: String -> IO [String]
    indexer repo :: String
    repo query :: SearchQuery
    query = do
      let opts :: [String]
    opts = ["-I", "--line-number", "--with-filename"] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                 ["-i" | SearchQuery -> Bool
    queryIgnoreCase SearchQuery
    query] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                 (if SearchQuery -> Bool
    queryWholeWords SearchQuery
    query then ["--word-regexp"] else ["-E"])
      let regexps :: [String]
    regexps = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    escapeRegexSpecialChars ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ SearchQuery -> [String]
    queryPatterns SearchQuery
    query
      [String]
    files <- String -> IO [String]
    indexer String
    repo
      if SearchQuery -> Bool
    queryMatchAll SearchQuery
    query
         then do
           [String]
    filesMatchingAllPatterns <- ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (([String] -> [String] -> [String]) -> [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 [String] -> [String] -> [String]
    forall a. Eq a => [a] -> [a] -> [a]
    intersect) (IO [[String]] -> IO [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> IO [String]) -> [String] -> IO [[String]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String -> [String] -> String -> IO [String]
    regSearchFiles String
    repo [String]
    files) [String]
    regexps
           [[String]]
    output <- (String -> IO [String]) -> [String] -> IO [[String]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ([String] -> String -> [String] -> String -> IO [String]
    regsSearchFile [String]
    opts String
    repo [String]
    regexps) [String]
    filesMatchingAllPatterns
           [SearchMatch] -> IO [SearchMatch]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([SearchMatch] -> IO [SearchMatch])
    -> [SearchMatch] -> IO [SearchMatch]
    forall a b. (a -> b) -> a -> b
    $ (String -> SearchMatch) -> [String] -> [SearchMatch]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> SearchMatch
    parseMatchLine ([String] -> [SearchMatch]) -> [String] -> [SearchMatch]
    forall a b. (a -> b) -> a -> b
    $ [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[String]]
    output
         else do
           (_status :: ExitCode
    _status, _errOutput :: ByteString
    _errOutput, output :: ByteString
    output) <-
                String
    -> Maybe [(String, String)]
    -> String
    -> [String]
    -> IO (ExitCode, ByteString, ByteString)
    runShellCommand String
    repo Maybe [(String, String)]
    forall a. Maybe a
    Nothing "grep" ([String] -> IO (ExitCode, ByteString, ByteString))
    -> [String] -> IO (ExitCode, ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ [String]
    opts [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                                                      (String -> [String]) -> [String] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\term :: String
    term -> ["-e", String
    term]) [String]
    regexps [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                                                      [String]
    files
           let results :: [String]
    results = String -> [String]
    lines (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> String
    toString ByteString
    output
           [SearchMatch] -> IO [SearchMatch]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([SearchMatch] -> IO [SearchMatch])
    -> [SearchMatch] -> IO [SearchMatch]
    forall a b. (a -> b) -> a -> b
    $ (String -> SearchMatch) -> [String] -> [SearchMatch]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> SearchMatch
    parseMatchLine [String]
    results

    -- | we don't actually need the contents, just want to check that the directory exists and we have enough permissions
    withVerifyDir :: FilePath -> IO a -> IO a
    withVerifyDir :: String -> IO a -> IO a
    withVerifyDir d :: String
    d a :: IO a
    a =
      IO a -> (IOException -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch (([String] -> String) -> IO [String] -> IO String
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM [String] -> String
    forall a. [a] -> a
    head (String -> IO [String]
    getDirectoryContents (String -> IO [String]) -> String -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ String -> String
    encodeArg String
    d) IO String -> IO a -> IO a
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO a
    a) ((IOException -> IO a) -> IO a) -> (IOException -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \(IOException
    e :: E.IOException) ->
        if IOException -> Bool
    isDoesNotExistError IOException
    e
           then FileStoreError -> IO a
    forall e a. Exception e => e -> IO a
    throwIO FileStoreError
    NotFound
           else FileStoreError -> IO a
    forall e a. Exception e => e -> IO a
    throwIO (FileStoreError -> IO a)
    -> (IOException -> FileStoreError) -> IOException -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> FileStoreError
    UnknownError (String -> FileStoreError)
    -> (IOException -> String) -> IOException -> FileStoreError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IOException -> String
    forall a. Show a => a -> String
    show (IOException -> IO a) -> IOException -> IO a
    forall a b. (a -> b) -> a -> b
    $ IOException
    e