{-# LANGUAGE CPP, ScopedTypeVariables #-}
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(..))
encodeArg :: String -> String
#if MIN_VERSION_base(4,5,0)
encodeArg :: String -> String
encodeArg = forall a. a -> a
id
#else
encodeArg = encodeString
#endif
runShellCommand :: FilePath
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, B.ByteString, B.ByteString)
runShellCommand :: String
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand String
workingDir Maybe [(String, String)]
environment String
command [String]
optionList = do
String
tempPath <- forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch IO String
getTemporaryDirectory (\(SomeException
_ :: E.SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
".")
(String
outputPath, Handle
hOut) <- String -> String -> IO (String, Handle)
openTempFile String
tempPath String
"out"
(String
errorPath, Handle
hErr) <- String -> String -> IO (String, Handle)
openTempFile String
tempPath String
"err"
Maybe [(String, String)]
env <- forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. [a] -> [a] -> [a]
(++) Maybe [(String, String)]
environment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just 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) (forall a b. (a -> b) -> [a] -> [b]
map String -> String
encodeArg [String]
optionList) (forall a. a -> Maybe a
Just String
workingDir) Maybe [(String, String)]
env forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Handle
hOut) (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
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
status, [ByteString] -> ByteString
B.fromChunks [ByteString
errorOutput], [ByteString] -> ByteString
B.fromChunks [ByteString
output])
mergeContents :: (String, B.ByteString)
-> (String, B.ByteString)
-> (String, B.ByteString)
-> IO (Bool, String)
mergeContents :: (String, ByteString)
-> (String, ByteString)
-> (String, ByteString)
-> IO (Bool, String)
mergeContents (String
newLabel, ByteString
newContents) (String
originalLabel, ByteString
originalContents) (String
latestLabel, ByteString
latestContents) = do
String
tempPath <- forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch IO String
getTemporaryDirectory (\(SomeException
_ :: E.SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
".")
(String
originalPath, Handle
hOriginal) <- String -> String -> IO (String, Handle)
openTempFile String
tempPath String
"orig"
(String
latestPath, Handle
hLatest) <- String -> String -> IO (String, Handle)
openTempFile String
tempPath String
"latest"
(String
newPath, Handle
hNew) <- String -> String -> IO (String, Handle)
openTempFile String
tempPath String
"new"
Handle -> ByteString -> IO ()
B.hPutStr Handle
hOriginal ByteString
originalContents 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 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
hNew
Bool
gitExists <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Maybe a -> Bool
isJust (String -> IO (Maybe String)
findExecutable String
"git")
(Bool
conflicts, ByteString
mergedContents) <-
if Bool
gitExists
then do
(ExitCode
status, ByteString
err, ByteString
out) <- String
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand String
tempPath forall a. Maybe a
Nothing String
"git" [String
"merge-file", String
"--stdout", String
"-L", String
newLabel, String
"-L",
String
originalLabel, String
"-L", String
latestLabel, String
newPath, String
originalPath, String
latestPath]
case ExitCode
status of
ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, ByteString
out)
ExitFailure Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, ByteString
out)
ExitCode
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"merge failed: " forall a. [a] -> [a] -> [a]
++ ByteString -> String
toString ByteString
err
else do
Bool
mergeExists <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Maybe a -> Bool
isJust (String -> IO (Maybe String)
findExecutable String
"merge")
if Bool
mergeExists
then do
(ExitCode
status, ByteString
err, ByteString
out) <- String
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand String
tempPath forall a. Maybe a
Nothing String
"merge" [String
"-p", String
"-q", String
"-L", String
newLabel, String
"-L",
String
originalLabel, String
"-L", String
latestLabel, String
newPath, String
originalPath, String
latestPath]
case ExitCode
status of
ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, ByteString
out)
ExitFailure Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, ByteString
out)
ExitCode
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"merge failed: " forall a. [a] -> [a] -> [a]
++ ByteString -> String
toString ByteString
err
else forall a. HasCallStack => String -> a
error String
"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
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
conflicts, ByteString -> String
toString ByteString
mergedContents)
escapeRegexSpecialChars :: String -> String
escapeRegexSpecialChars :: String -> String
escapeRegexSpecialChars = forall {t :: * -> *}. Foldable t => t Char -> String -> String
backslashEscape String
"?*+{}[]\\^$.()"
where backslashEscape :: t Char -> String -> String
backslashEscape t Char
chars (Char
x:String
xs) | Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
chars = Char
'\\' forall a. a -> [a] -> [a]
: Char
x forall a. a -> [a] -> [a]
: t Char -> String -> String
backslashEscape t Char
chars String
xs
backslashEscape t Char
chars (Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: t Char -> String -> String
backslashEscape t Char
chars String
xs
backslashEscape t Char
_ [] = []
hashsMatch :: (Eq a) => [a] -> [a] -> Bool
hashsMatch :: forall a. Eq a => [a] -> [a] -> Bool
hashsMatch [a]
r1 [a]
r2 = [a]
r1 forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
r2 Bool -> Bool -> Bool
|| [a]
r2 forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
r1
isInsideDir :: FilePath -> FilePath -> Bool
isInsideDir :: String -> String -> Bool
isInsideDir String
name String
dir = String
dir forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name
Bool -> Bool -> Bool
&& Bool -> Bool
not (String
".." forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
dir) Bool -> Bool -> Bool
&& Bool -> Bool
not (String
".." forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
name)
parseMatchLine :: String -> SearchMatch
parseMatchLine :: String -> SearchMatch
parseMatchLine String
str =
let (String
fn:String
n:String
res:[String]
_) = forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (forall a. Eq a => a -> a -> Bool
==Char
':') String
str
in SearchMatch{matchResourceName :: String
matchResourceName = String
fn, matchLineNumber :: Integer
matchLineNumber = forall a. Read a => String -> a
read String
n, matchLine :: String
matchLine = String
res}
splitEmailAuthor :: String -> (Maybe String, String)
splitEmailAuthor :: String -> (Maybe String, String)
splitEmailAuthor String
x = (Maybe String
mbEmail, String -> String
trim String
name)
where (String
name, String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
'<') String
x
mbEmail :: Maybe String
mbEmail = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'>') forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 String
rest
trim :: String -> String
trim :: String -> String
trim = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
regSearchFiles :: FilePath -> [String] -> String -> IO [String]
regSearchFiles :: String -> [String] -> String -> IO [String]
regSearchFiles String
repo [String]
filesToCheck String
pattern = do (ExitCode
_, ByteString
_, ByteString
result) <- String
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand String
repo
forall a. Maybe a
Nothing String
"grep" forall a b. (a -> b) -> a -> b
$ [String
"--line-number", String
"-I", String
"-l", String
"-E", String
"-e", String
pattern] forall a. [a] -> [a] -> [a]
++ [String]
filesToCheck
let results :: [String]
results = forall a. Eq a => [a] -> [a] -> [a]
intersect [String]
filesToCheck forall a b. (a -> b) -> a -> b
$ String -> [String]
lines forall a b. (a -> b) -> a -> b
$ ByteString -> String
toString ByteString
result
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
results
regsSearchFile :: [String] -> FilePath -> [String] -> String -> IO [String]
regsSearchFile :: [String] -> String -> [String] -> String -> IO [String]
regsSearchFile [String]
os String
repo [String]
patterns String
file = do [[String]]
res <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
res
where run :: String -> String -> IO [String]
run String
f String
p = do (ExitCode
_,ByteString
_,ByteString
r) <- String
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand String
repo forall a. Maybe a
Nothing String
"grep" ([String]
os forall a. [a] -> [a] -> [a]
++ [String
p, String
f])
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> [String]
lines forall a b. (a -> b) -> a -> b
$ ByteString -> String
toString ByteString
r
ensureFileExists :: FilePath -> FilePath -> IO ()
ensureFileExists :: String -> String -> IO ()
ensureFileExists String
repo String
name = do
Bool
isFile <- String -> IO Bool
doesFileExist (String
repo String -> String -> String
</> String -> String
encodeArg String
name)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isFile forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
withSanityCheck :: FilePath
-> [FilePath]
-> FilePath
-> IO b
-> IO b
withSanityCheck :: forall b. String -> [String] -> String -> IO b -> IO b
withSanityCheck String
repo [String]
excludes String
name 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 = forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String
filename String -> String -> Bool
`isInsideDir`)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String
repo String -> String -> String
</>) [String]
excludes
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
insideExcludes Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
insideRepo)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO FileStoreError
IllegalResourceName
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
filename
IO b
action
grepSearchRepo :: (FilePath -> IO [String]) -> FilePath -> SearchQuery -> IO [SearchMatch]
grepSearchRepo :: (String -> IO [String])
-> String -> SearchQuery -> IO [SearchMatch]
grepSearchRepo String -> IO [String]
indexer String
repo SearchQuery
query = do
let opts :: [String]
opts = [String
"-I", String
"--line-number", String
"--with-filename"] forall a. [a] -> [a] -> [a]
++
[String
"-i" | SearchQuery -> Bool
queryIgnoreCase SearchQuery
query] forall a. [a] -> [a] -> [a]
++
(if SearchQuery -> Bool
queryWholeWords SearchQuery
query then [String
"--word-regexp"] else [String
"-E"])
let regexps :: [String]
regexps = forall a b. (a -> b) -> [a] -> [b]
map String -> String
escapeRegexSpecialChars 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 <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a. Eq a => [a] -> [a] -> [a]
intersect) forall a b. (a -> b) -> a -> b
$ 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 <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> SearchMatch
parseMatchLine forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
output
else do
(ExitCode
_status, ByteString
_errOutput, ByteString
output) <-
String
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand String
repo forall a. Maybe a
Nothing String
"grep" forall a b. (a -> b) -> a -> b
$ [String]
opts forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
term -> [String
"-e", String
term]) [String]
regexps forall a. [a] -> [a] -> [a]
++
[String]
files
let results :: [String]
results = String -> [String]
lines forall a b. (a -> b) -> a -> b
$ ByteString -> String
toString ByteString
output
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> SearchMatch
parseMatchLine [String]
results
withVerifyDir :: FilePath -> IO a -> IO a
withVerifyDir :: forall a. String -> IO a -> IO a
withVerifyDir String
d IO a
a =
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [a] -> a
head (String -> IO [String]
getDirectoryContents forall a b. (a -> b) -> a -> b
$ String -> String
encodeArg String
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
a) forall a b. (a -> b) -> a -> b
$ \(IOException
e :: E.IOException) ->
if IOException -> Bool
isDoesNotExistError IOException
e
then forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
else forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FileStoreError
UnknownError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ IOException
e