mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-09-11 04:45:28 +03:00
Support digesting on Linux with md5sum
This introduces behavior searching for an available program to calculate digests across directories. OS X ships with md5, but on *nix-based systems, it's md5sum. The output is largely the same, apart from the final digest calculation, which includes a "file path": da52a1a5d5a3c9672371746e4d32708a - This strips the trailing whitespace and dash: da52a1a5d5a3c9672371746e4d32708a Closes #49
This commit is contained in:
parent
1892f8c0ba
commit
240b5bbb19
12
app/App.hs
12
app/App.hs
@ -28,6 +28,7 @@ type AppConfig = MonadReader Options
|
||||
data AppError
|
||||
= TagError TagSearchOutcome
|
||||
| InvalidConfigError [ParseConfigError]
|
||||
| CacheError FingerprintOutcome
|
||||
|
||||
newtype App a = App {
|
||||
runApp :: ReaderT Options (ExceptT AppError IO) a
|
||||
@ -68,6 +69,7 @@ termsWithAlternatesFromConfig = do
|
||||
renderError :: AppError -> IO ()
|
||||
renderError (TagError e) = V.missingTagsFileError e
|
||||
renderError (InvalidConfigError e) = V.invalidConfigError e
|
||||
renderError (CacheError e) = V.fingerprintError e
|
||||
|
||||
retrieveGitContext :: TermMatchSet -> App TermMatchSet
|
||||
retrieveGitContext tms = do
|
||||
@ -97,10 +99,14 @@ calculateTagInput = do
|
||||
|
||||
withCache :: IO SearchResults -> App SearchResults
|
||||
withCache f =
|
||||
liftIO . operateCache =<< runWithCache
|
||||
operateCache =<< runWithCache
|
||||
where
|
||||
operateCache b = if b then withCache' f else f
|
||||
withCache' = fmap SearchResults . cached "term-matches" . fmap fromResults
|
||||
operateCache b = if b then withCache' f else liftIO f
|
||||
withCache' :: IO SearchResults -> App SearchResults
|
||||
withCache' r =
|
||||
either (throwError . CacheError) (return . SearchResults) =<<
|
||||
liftIO (cached "term-matches" $ fmap fromResults r)
|
||||
|
||||
|
||||
optionFilters :: AppConfig m => TermMatchSet -> m TermMatchSet
|
||||
optionFilters tms = foldl (>>=) (pure tms) matchSetFilters
|
||||
|
@ -7,4 +7,5 @@ import Unused.CLI.Views.AnalysisHeader as X
|
||||
import Unused.CLI.Views.GitSHAsHeader as X
|
||||
import Unused.CLI.Views.MissingTagsFileError as X
|
||||
import Unused.CLI.Views.InvalidConfigError as X
|
||||
import Unused.CLI.Views.FingerprintError as X
|
||||
import Unused.CLI.Views.SearchResult as X
|
||||
|
19
src/Unused/CLI/Views/FingerprintError.hs
Normal file
19
src/Unused/CLI/Views/FingerprintError.hs
Normal file
@ -0,0 +1,19 @@
|
||||
module Unused.CLI.Views.FingerprintError
|
||||
( fingerprintError
|
||||
) where
|
||||
|
||||
import Data.List (intercalate)
|
||||
import Unused.Cache.DirectoryFingerprint
|
||||
import Unused.CLI.Views.Error
|
||||
|
||||
fingerprintError :: FingerprintOutcome -> IO ()
|
||||
fingerprintError e = do
|
||||
errorHeader "There was a problem generating a cache fingerprint:"
|
||||
|
||||
printOutcomeMessage e
|
||||
|
||||
printOutcomeMessage :: FingerprintOutcome -> IO ()
|
||||
printOutcomeMessage (MD5ExecutableNotFound execs) =
|
||||
putStrLn $
|
||||
"Unable to find any of the following executables \
|
||||
\in your PATH: " ++ intercalate ", " execs
|
@ -1,5 +1,6 @@
|
||||
module Unused.Cache
|
||||
( cached
|
||||
( FingerprintOutcome(..)
|
||||
, cached
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
@ -8,16 +9,16 @@ import System.Directory
|
||||
import Data.Csv (FromRecord, ToRecord, HasHeader(..), encode, decode)
|
||||
import Data.Vector (toList)
|
||||
import qualified Data.ByteString.Lazy as BS
|
||||
import Unused.Cache.DirectoryFingerprint (sha)
|
||||
import Unused.Cache.DirectoryFingerprint
|
||||
|
||||
newtype CacheFileName = CacheFileName String
|
||||
type Cache = ReaderT CacheFileName IO
|
||||
|
||||
cached :: (FromRecord a, ToRecord a) => String -> IO [a] -> IO [a]
|
||||
cached context f =
|
||||
runReaderT fromCache =<< cacheFileName context
|
||||
cached :: (FromRecord a, ToRecord a) => String -> IO [a] -> IO (Either FingerprintOutcome [a])
|
||||
cached cachePrefix f =
|
||||
mapM fromCache =<< cacheFileName cachePrefix
|
||||
where
|
||||
fromCache = maybe (writeCache =<< liftIO f) return =<< readCache
|
||||
fromCache = runReaderT $ maybe (writeCache =<< liftIO f) return =<< readCache
|
||||
|
||||
writeCache :: ToRecord a => [a] -> Cache [a]
|
||||
writeCache [] = return []
|
||||
@ -38,11 +39,12 @@ readCache = do
|
||||
where
|
||||
processCsv = either (const Nothing) (Just . toList)
|
||||
|
||||
cacheFileName :: String -> IO CacheFileName
|
||||
cacheFileName :: String -> IO (Either FingerprintOutcome CacheFileName)
|
||||
cacheFileName context = do
|
||||
putStrLn "\n\nCalculating cache fingerprint... "
|
||||
currentSha <- sha
|
||||
return $ CacheFileName $ cacheDirectory ++ "/" ++ context ++ "-" ++ currentSha ++ ".csv"
|
||||
fmap toFileName <$> sha
|
||||
where
|
||||
toFileName s = CacheFileName $ cacheDirectory ++ "/" ++ context ++ "-" ++ s ++ ".csv"
|
||||
|
||||
cacheDirectory :: String
|
||||
cacheDirectory = "tmp/unused"
|
||||
|
@ -1,31 +1,53 @@
|
||||
module Unused.Cache.DirectoryFingerprint
|
||||
( sha
|
||||
( FingerprintOutcome(..)
|
||||
, sha
|
||||
) where
|
||||
|
||||
import System.Process
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Reader
|
||||
import qualified System.Directory as D
|
||||
import qualified Data.Char as C
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Unused.Cache.FindArgsFromIgnoredPaths
|
||||
import Unused.Util (readIfFileExists)
|
||||
import Unused.Util (safeHead, readIfFileExists)
|
||||
|
||||
sha :: IO String
|
||||
sha =
|
||||
getSha <$> (fileList >>= sortInput >>= md5Result)
|
||||
type MD5Config = ReaderT String IO
|
||||
|
||||
data FingerprintOutcome
|
||||
= MD5ExecutableNotFound [String]
|
||||
|
||||
sha :: IO (Either FingerprintOutcome String)
|
||||
sha = do
|
||||
md5Executable' <- md5Executable
|
||||
case md5Executable' of
|
||||
Just exec ->
|
||||
Right . getSha <$> runReaderT (fileList >>= sortInput >>= md5Result) exec
|
||||
Nothing -> return $ Left $ MD5ExecutableNotFound supportedMD5Executables
|
||||
where
|
||||
getSha = head' . lines
|
||||
head' (x:_) = x
|
||||
head' _ = ""
|
||||
getSha = takeWhile C.isAlphaNum . fromMaybe "" . safeHead . lines
|
||||
|
||||
fileList :: IO String
|
||||
fileList :: MD5Config String
|
||||
fileList = do
|
||||
filterNamePathArgs <- findArgs <$> ignoredPaths
|
||||
let args = [".", "-type", "f", "-not", "-path", "*/.git/*"] ++ filterNamePathArgs ++ ["-exec", "md5", "{}", "+"]
|
||||
readProcess "find" args ""
|
||||
filterNamePathArgs <- liftIO $ findArgs <$> ignoredPaths
|
||||
md5exec <- ask
|
||||
let args = [".", "-type", "f", "-not", "-path", "*/.git/*"] ++ filterNamePathArgs ++ ["-exec", md5exec, "{}", "+"]
|
||||
liftIO $ readProcess "find" args ""
|
||||
|
||||
sortInput :: String -> IO String
|
||||
sortInput = readProcess "sort" ["-k", "2"]
|
||||
sortInput :: String -> MD5Config String
|
||||
sortInput = liftIO . readProcess "sort" ["-k", "2"]
|
||||
|
||||
md5Result :: String -> IO String
|
||||
md5Result = readProcess "md5" []
|
||||
md5Result :: String -> MD5Config String
|
||||
md5Result r = do
|
||||
md5exec <- ask
|
||||
liftIO $ readProcess md5exec [] r
|
||||
|
||||
ignoredPaths :: IO [String]
|
||||
ignoredPaths = fromMaybe [] <$> (fmap lines <$> readIfFileExists ".gitignore")
|
||||
|
||||
md5Executable :: IO (Maybe String)
|
||||
md5Executable =
|
||||
safeHead . concat <$> mapM D.findExecutables supportedMD5Executables
|
||||
|
||||
supportedMD5Executables :: [String]
|
||||
supportedMD5Executables = ["md5", "md5sum"]
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Unused.Util
|
||||
( groupBy
|
||||
, stringToInt
|
||||
, safeHead
|
||||
, readIfFileExists
|
||||
) where
|
||||
|
||||
@ -15,6 +16,10 @@ groupBy f = map (f . head &&& id)
|
||||
. L.groupBy ((==) `on` f)
|
||||
. L.sortBy (compare `on` f)
|
||||
|
||||
safeHead :: [a] -> Maybe a
|
||||
safeHead (x:_) = Just x
|
||||
safeHead _ = Nothing
|
||||
|
||||
stringToInt :: String -> Maybe Int
|
||||
stringToInt xs
|
||||
| all isDigit xs = Just $ loop 0 xs
|
||||
|
@ -48,6 +48,7 @@ library
|
||||
, Unused.CLI.Views.GitSHAsHeader
|
||||
, Unused.CLI.Views.MissingTagsFileError
|
||||
, Unused.CLI.Views.InvalidConfigError
|
||||
, Unused.CLI.Views.FingerprintError
|
||||
, Unused.CLI.Views.SearchResult
|
||||
, Unused.CLI.Views.SearchResult.ColumnFormatter
|
||||
, Unused.CLI.Views.SearchResult.Internal
|
||||
|
Loading…
Reference in New Issue
Block a user