mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-08-16 00:00:40 +03:00
Continue to update Haskell style
This commit: * Qualifies a number of imports across the codebase * Aligns imports
This commit is contained in:
parent
7618e6cb23
commit
c23f123ea6
42
app/App.hs
42
app/App.hs
@ -7,22 +7,22 @@ module App
|
|||||||
, runProgram
|
, runProgram
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Bifunctor as B
|
import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader (ReaderT, MonadReader, MonadIO, runReaderT, asks, liftIO)
|
||||||
import Control.Monad.Except
|
import qualified Data.Bifunctor as BF
|
||||||
import Data.Maybe (isJust)
|
import qualified Data.Bool as B
|
||||||
import Data.Bool (bool)
|
import qualified Data.Maybe as M
|
||||||
import Unused.Grouping (CurrentGrouping(..), groupedResponses)
|
import Unused.Aliases (termsAndAliases)
|
||||||
import Unused.Types (TermMatchSet, RemovalLikelihood(..))
|
import Unused.CLI (SearchRunner(..), loadGitContext, renderHeader, executeSearch, withRuntime)
|
||||||
import Unused.TermSearch (SearchResults(..), fromResults)
|
|
||||||
import Unused.ResponseFilter (withOneOccurrence, withLikelihoods, ignoringPaths)
|
|
||||||
import Unused.Cache
|
|
||||||
import Unused.TagsSource
|
|
||||||
import Unused.ResultsClassifier
|
|
||||||
import Unused.Aliases (termsAndAliases)
|
|
||||||
import Unused.Parser (parseResults)
|
|
||||||
import Unused.CLI (SearchRunner(..), loadGitContext, renderHeader, executeSearch, withRuntime)
|
|
||||||
import qualified Unused.CLI.Views as V
|
import qualified Unused.CLI.Views as V
|
||||||
|
import Unused.Cache (FingerprintOutcome(..), cached)
|
||||||
|
import Unused.Grouping (CurrentGrouping(..), groupedResponses)
|
||||||
|
import Unused.Parser (parseResults)
|
||||||
|
import Unused.ResponseFilter (withOneOccurrence, withLikelihoods, ignoringPaths)
|
||||||
|
import Unused.ResultsClassifier (ParseConfigError, LanguageConfiguration(..), loadAllConfigurations)
|
||||||
|
import Unused.TagsSource (TagSearchOutcome, loadTagsFromFile, loadTagsFromPipe)
|
||||||
|
import Unused.TermSearch (SearchResults(..), fromResults)
|
||||||
|
import Unused.Types (TermMatchSet, RemovalLikelihood(..))
|
||||||
|
|
||||||
type AppConfig = MonadReader Options
|
type AppConfig = MonadReader Options
|
||||||
|
|
||||||
@ -88,18 +88,18 @@ printResults tms = do
|
|||||||
loadAllConfigs :: App [LanguageConfiguration]
|
loadAllConfigs :: App [LanguageConfiguration]
|
||||||
loadAllConfigs =
|
loadAllConfigs =
|
||||||
either throwError return
|
either throwError return
|
||||||
=<< B.first InvalidConfigError <$> liftIO loadAllConfigurations
|
=<< BF.first InvalidConfigError <$> liftIO loadAllConfigurations
|
||||||
|
|
||||||
calculateTagInput :: App [String]
|
calculateTagInput :: App [String]
|
||||||
calculateTagInput =
|
calculateTagInput =
|
||||||
either throwError return
|
either throwError return
|
||||||
=<< liftIO .
|
=<< liftIO .
|
||||||
fmap (B.first TagError) .
|
fmap (BF.first TagError) .
|
||||||
bool loadTagsFromFile loadTagsFromPipe =<< readFromStdIn
|
B.bool loadTagsFromFile loadTagsFromPipe =<< readFromStdIn
|
||||||
|
|
||||||
withCache :: IO SearchResults -> App SearchResults
|
withCache :: IO SearchResults -> App SearchResults
|
||||||
withCache f =
|
withCache f =
|
||||||
bool (liftIO f) (withCache' f) =<< runWithCache
|
B.bool (liftIO f) (withCache' f) =<< runWithCache
|
||||||
where
|
where
|
||||||
withCache' :: IO SearchResults -> App SearchResults
|
withCache' :: IO SearchResults -> App SearchResults
|
||||||
withCache' r =
|
withCache' r =
|
||||||
@ -118,7 +118,7 @@ optionFilters tms = foldl (>>=) (pure tms) matchSetFilters
|
|||||||
|
|
||||||
singleOccurrenceFilter :: AppConfig m => TermMatchSet -> m TermMatchSet
|
singleOccurrenceFilter :: AppConfig m => TermMatchSet -> m TermMatchSet
|
||||||
singleOccurrenceFilter tms =
|
singleOccurrenceFilter tms =
|
||||||
bool tms (withOneOccurrence tms) <$> asks oSingleOccurrenceMatches
|
B.bool tms (withOneOccurrence tms) <$> asks oSingleOccurrenceMatches
|
||||||
|
|
||||||
likelihoodsFilter :: AppConfig m => TermMatchSet -> m TermMatchSet
|
likelihoodsFilter :: AppConfig m => TermMatchSet -> m TermMatchSet
|
||||||
likelihoodsFilter tms =
|
likelihoodsFilter tms =
|
||||||
@ -148,4 +148,4 @@ numberOfCommits :: AppConfig m => m (Maybe Int)
|
|||||||
numberOfCommits = asks oCommitCount
|
numberOfCommits = asks oCommitCount
|
||||||
|
|
||||||
resultFormatter :: AppConfig m => m V.ResultsFormat
|
resultFormatter :: AppConfig m => m V.ResultsFormat
|
||||||
resultFormatter = bool V.Column V.List . isJust <$> numberOfCommits
|
resultFormatter = B.bool V.Column V.List . M.isJust <$> numberOfCommits
|
||||||
|
16
app/Main.hs
16
app/Main.hs
@ -1,12 +1,12 @@
|
|||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import App
|
import App (runProgram, Options(Options))
|
||||||
import Options.Applicative
|
import qualified Data.Maybe as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Options.Applicative
|
||||||
import Unused.Grouping (CurrentGrouping(..))
|
import Unused.CLI (SearchRunner(..))
|
||||||
import Unused.Types (RemovalLikelihood(..))
|
import Unused.Grouping (CurrentGrouping(..))
|
||||||
import Unused.CLI (SearchRunner(..))
|
import Unused.Types (RemovalLikelihood(..))
|
||||||
import Unused.Util (stringToInt)
|
import Unused.Util (stringToInt)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = runProgram =<< parseCLI
|
main = runProgram =<< parseCLI
|
||||||
@ -80,7 +80,7 @@ parseIgnorePaths = many $ strOption $
|
|||||||
|
|
||||||
parseGroupings :: Parser CurrentGrouping
|
parseGroupings :: Parser CurrentGrouping
|
||||||
parseGroupings =
|
parseGroupings =
|
||||||
fromMaybe GroupByDirectory <$> maybeGroup
|
M.fromMaybe GroupByDirectory <$> maybeGroup
|
||||||
where
|
where
|
||||||
maybeGroup = optional $ parseGrouping <$> parseGroupingOption
|
maybeGroup = optional $ parseGrouping <$> parseGroupingOption
|
||||||
|
|
||||||
|
@ -5,13 +5,14 @@ module Unused.Aliases
|
|||||||
, termsAndAliases
|
, termsAndAliases
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Tuple (swap)
|
import Data.List ((\\))
|
||||||
import Data.List (nub, sort, find, (\\))
|
import qualified Data.List as L
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Unused.ResultsClassifier.Types
|
import qualified Data.Tuple as Tu
|
||||||
import Unused.Types (TermMatch, tmTerm)
|
import Unused.ResultsClassifier.Types
|
||||||
import Unused.Util (groupBy)
|
import Unused.Types (TermMatch, tmTerm)
|
||||||
|
import Unused.Util (groupBy)
|
||||||
|
|
||||||
type Alias = (Text, Text)
|
type Alias = (Text, Text)
|
||||||
type GroupedResult = (String, [TermMatch])
|
type GroupedResult = (String, [TermMatch])
|
||||||
@ -26,7 +27,7 @@ groupedTermsAndAliases as ms =
|
|||||||
termsAndAliases :: [TermAlias] -> [String] -> [String]
|
termsAndAliases :: [TermAlias] -> [String] -> [String]
|
||||||
termsAndAliases [] = id
|
termsAndAliases [] = id
|
||||||
termsAndAliases as =
|
termsAndAliases as =
|
||||||
nub . map T.unpack . concatMap (allAliases aliases . T.pack)
|
L.nub . map T.unpack . concatMap (allAliases aliases . T.pack)
|
||||||
where
|
where
|
||||||
aliases = map toAlias as
|
aliases = map toAlias as
|
||||||
allAliases :: [Alias] -> Text -> [Text]
|
allAliases :: [Alias] -> Text -> [Text]
|
||||||
@ -42,8 +43,8 @@ processResultsWithAliases as acc result@(term, matches) =
|
|||||||
where
|
where
|
||||||
packedTerm = T.pack term
|
packedTerm = T.pack term
|
||||||
noAliasesExist = null listOfAliases
|
noAliasesExist = null listOfAliases
|
||||||
listOfAliases = nub (concatMap (`aliasesForTerm` packedTerm) as) \\ [packedTerm]
|
listOfAliases = L.nub (concatMap (`aliasesForTerm` packedTerm) as) \\ [packedTerm]
|
||||||
closestAlias = find ((`elem` listOfAliases) . T.pack . fst) acc
|
closestAlias = L.find ((`elem` listOfAliases) . T.pack . fst) acc
|
||||||
|
|
||||||
toAlias :: TermAlias -> Alias
|
toAlias :: TermAlias -> Alias
|
||||||
toAlias TermAlias{taFrom = from, taTo = to} = (T.pack from, T.pack to)
|
toAlias TermAlias{taFrom = from, taTo = to} = (T.pack from, T.pack to)
|
||||||
@ -63,7 +64,7 @@ parsePatternForMatch aliasPattern term =
|
|||||||
findMatch _ = Left $ T.pack $ "There was a problem with the pattern: " ++ show aliasPattern
|
findMatch _ = Left $ T.pack $ "There was a problem with the pattern: " ++ show aliasPattern
|
||||||
|
|
||||||
aliasesForTerm :: Alias -> Text -> [Text]
|
aliasesForTerm :: Alias -> Text -> [Text]
|
||||||
aliasesForTerm a t = nub $ sort $ generateAliases a t ++ generateAliases (swap a) t
|
aliasesForTerm a t = L.nub $ L.sort $ generateAliases a t ++ generateAliases (Tu.swap a) t
|
||||||
|
|
||||||
wildcard :: Text
|
wildcard :: Text
|
||||||
wildcard = "%s"
|
wildcard = "%s"
|
||||||
|
@ -2,6 +2,6 @@ module Unused.CLI
|
|||||||
( module X
|
( module X
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Unused.CLI.Search as X
|
|
||||||
import Unused.CLI.GitContext as X
|
import Unused.CLI.GitContext as X
|
||||||
|
import Unused.CLI.Search as X
|
||||||
import Unused.CLI.Util as X
|
import Unused.CLI.Util as X
|
||||||
|
@ -2,16 +2,16 @@ module Unused.CLI.GitContext
|
|||||||
( loadGitContext
|
( loadGitContext
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Map.Strict as Map (toList, fromList)
|
import qualified Data.Map.Strict as Map
|
||||||
import Unused.Types (TermMatchSet)
|
import Unused.CLI.ProgressIndicator (createProgressBar, progressWithIndicator)
|
||||||
import Unused.CLI.Util
|
import qualified Unused.CLI.Util as U
|
||||||
import qualified Unused.CLI.Views as V
|
import qualified Unused.CLI.Views as V
|
||||||
import Unused.CLI.ProgressIndicator
|
import Unused.GitContext (gitContextForResults)
|
||||||
import Unused.GitContext
|
import Unused.Types (TermMatchSet)
|
||||||
|
|
||||||
loadGitContext :: Int -> TermMatchSet -> IO TermMatchSet
|
loadGitContext :: Int -> TermMatchSet -> IO TermMatchSet
|
||||||
loadGitContext i tms = do
|
loadGitContext i tms = do
|
||||||
resetScreen
|
U.resetScreen
|
||||||
V.loadingSHAsHeader i
|
V.loadingSHAsHeader i
|
||||||
Map.fromList <$> progressWithIndicator (gitContextForResults i) createProgressBar listTerms
|
Map.fromList <$> progressWithIndicator (gitContextForResults i) createProgressBar listTerms
|
||||||
where
|
where
|
||||||
|
@ -1,30 +1,30 @@
|
|||||||
module Unused.CLI.ProgressIndicator
|
module Unused.CLI.ProgressIndicator
|
||||||
( ProgressIndicator
|
( I.ProgressIndicator
|
||||||
, createProgressBar
|
, createProgressBar
|
||||||
, createSpinner
|
, createSpinner
|
||||||
, progressWithIndicator
|
, progressWithIndicator
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent.ParallelIO
|
import qualified Control.Concurrent.ParallelIO as PIO
|
||||||
import Unused.CLI.Util
|
import qualified Unused.CLI.ProgressIndicator.Internal as I
|
||||||
import Unused.CLI.ProgressIndicator.Types
|
import qualified Unused.CLI.ProgressIndicator.Types as I
|
||||||
import Unused.CLI.ProgressIndicator.Internal
|
import Unused.CLI.Util (Color(..), installChildInterruptHandler)
|
||||||
|
|
||||||
createProgressBar :: ProgressIndicator
|
createProgressBar :: I.ProgressIndicator
|
||||||
createProgressBar = ProgressBar Nothing Nothing
|
createProgressBar = I.ProgressBar Nothing Nothing
|
||||||
|
|
||||||
createSpinner :: ProgressIndicator
|
createSpinner :: I.ProgressIndicator
|
||||||
createSpinner =
|
createSpinner =
|
||||||
Spinner snapshots (length snapshots) 75000 colors Nothing
|
I.Spinner snapshots (length snapshots) 75000 colors Nothing
|
||||||
where
|
where
|
||||||
snapshots = ["⣾", "⣽", "⣻", "⢿", "⡿", "⣟", "⣯", "⣷"]
|
snapshots = ["⣾", "⣽", "⣻", "⢿", "⡿", "⣟", "⣯", "⣷"]
|
||||||
colors = cycle [Black, Red, Yellow, Green, Blue, Cyan, Magenta]
|
colors = cycle [Black, Red, Yellow, Green, Blue, Cyan, Magenta]
|
||||||
|
|
||||||
progressWithIndicator :: Monoid b => (a -> IO b) -> ProgressIndicator -> [a] -> IO b
|
progressWithIndicator :: Monoid b => (a -> IO b) -> I.ProgressIndicator -> [a] -> IO b
|
||||||
progressWithIndicator f i terms = do
|
progressWithIndicator f i terms = do
|
||||||
printPrefix i
|
I.printPrefix i
|
||||||
(tid, indicator) <- start i $ length terms
|
(tid, indicator) <- I.start i $ length terms
|
||||||
installChildInterruptHandler tid
|
installChildInterruptHandler tid
|
||||||
mconcat <$> parallel (ioOps indicator) <* stop indicator
|
mconcat <$> PIO.parallel (ioOps indicator) <* I.stop indicator
|
||||||
where
|
where
|
||||||
ioOps i' = map (\t -> f t <* increment i') terms
|
ioOps i' = map (\t -> f t <* I.increment i') terms
|
||||||
|
@ -5,27 +5,27 @@ module Unused.CLI.ProgressIndicator.Internal
|
|||||||
, printPrefix
|
, printPrefix
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (forever)
|
import qualified Control.Concurrent as CC
|
||||||
import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay)
|
import qualified Control.Monad as M
|
||||||
import System.ProgressBar (ProgressRef, startProgress, incProgress, msg, percentage)
|
import qualified System.ProgressBar as PB
|
||||||
import Unused.CLI.ProgressIndicator.Types
|
import Unused.CLI.ProgressIndicator.Types (ProgressIndicator(..))
|
||||||
import Unused.CLI.Util
|
import Unused.CLI.Util
|
||||||
|
|
||||||
start :: ProgressIndicator -> Int -> IO (ThreadId, ProgressIndicator)
|
start :: ProgressIndicator -> Int -> IO (CC.ThreadId, ProgressIndicator)
|
||||||
start s@Spinner{} _ = do
|
start s@Spinner{} _ = do
|
||||||
tid <- forkIO $ runSpinner 0 s
|
tid <- CC.forkIO $ runSpinner 0 s
|
||||||
return (tid, s { sThreadId = Just tid })
|
return (tid, s { sThreadId = Just tid })
|
||||||
start ProgressBar{} i = do
|
start ProgressBar{} i = do
|
||||||
(ref, tid) <- buildProgressBar $ toInteger i
|
(ref, tid) <- buildProgressBar $ toInteger i
|
||||||
return (tid, ProgressBar (Just ref) (Just tid))
|
return (tid, ProgressBar (Just ref) (Just tid))
|
||||||
|
|
||||||
stop :: ProgressIndicator -> IO ()
|
stop :: ProgressIndicator -> IO ()
|
||||||
stop ProgressBar{ pbThreadId = Just tid } = killThread tid
|
stop ProgressBar{ pbThreadId = Just tid } = CC.killThread tid
|
||||||
stop Spinner{ sThreadId = Just tid } = killThread tid
|
stop Spinner{ sThreadId = Just tid } = CC.killThread tid
|
||||||
stop _ = return ()
|
stop _ = return ()
|
||||||
|
|
||||||
increment :: ProgressIndicator -> IO ()
|
increment :: ProgressIndicator -> IO ()
|
||||||
increment ProgressBar{ pbProgressRef = Just ref } = incProgress ref 1
|
increment ProgressBar{ pbProgressRef = Just ref } = PB.incProgress ref 1
|
||||||
increment _ = return ()
|
increment _ = return ()
|
||||||
|
|
||||||
printPrefix :: ProgressIndicator -> IO ()
|
printPrefix :: ProgressIndicator -> IO ()
|
||||||
@ -33,11 +33,11 @@ printPrefix ProgressBar{} = putStr "\n\n"
|
|||||||
printPrefix Spinner{} = putStr " "
|
printPrefix Spinner{} = putStr " "
|
||||||
|
|
||||||
runSpinner :: Int -> ProgressIndicator -> IO ()
|
runSpinner :: Int -> ProgressIndicator -> IO ()
|
||||||
runSpinner i s@Spinner{ sDelay = delay, sSnapshots = snapshots, sColors = colors, sLength = length' } = forever $ do
|
runSpinner i s@Spinner{ sDelay = delay, sSnapshots = snapshots, sColors = colors, sLength = length' } = M.forever $ do
|
||||||
setSGR [SetColor Foreground Dull currentColor]
|
setSGR [SetColor Foreground Dull currentColor]
|
||||||
putStr currentSnapshot
|
putStr currentSnapshot
|
||||||
cursorBackward 1
|
cursorBackward 1
|
||||||
threadDelay delay
|
CC.threadDelay delay
|
||||||
runSpinner (i + 1) s
|
runSpinner (i + 1) s
|
||||||
where
|
where
|
||||||
currentSnapshot = snapshots !! (i `mod` snapshotLength)
|
currentSnapshot = snapshots !! (i `mod` snapshotLength)
|
||||||
@ -45,9 +45,9 @@ runSpinner i s@Spinner{ sDelay = delay, sSnapshots = snapshots, sColors = colors
|
|||||||
snapshotLength = length'
|
snapshotLength = length'
|
||||||
runSpinner _ _ = return ()
|
runSpinner _ _ = return ()
|
||||||
|
|
||||||
buildProgressBar :: Integer -> IO (ProgressRef, ThreadId)
|
buildProgressBar :: Integer -> IO (PB.ProgressRef, CC.ThreadId)
|
||||||
buildProgressBar =
|
buildProgressBar =
|
||||||
startProgress (msg message) percentage progressBarWidth
|
PB.startProgress (PB.msg message) PB.percentage progressBarWidth
|
||||||
where
|
where
|
||||||
message = "Working"
|
message = "Working"
|
||||||
progressBarWidth = 60
|
progressBarWidth = 60
|
||||||
|
@ -2,19 +2,19 @@ module Unused.CLI.ProgressIndicator.Types
|
|||||||
( ProgressIndicator(..)
|
( ProgressIndicator(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent (ThreadId)
|
import qualified Control.Concurrent as CC
|
||||||
import System.ProgressBar (ProgressRef)
|
import qualified System.Console.ANSI as ANSI
|
||||||
import System.Console.ANSI (Color)
|
import qualified System.ProgressBar as PB
|
||||||
|
|
||||||
data ProgressIndicator
|
data ProgressIndicator
|
||||||
= Spinner
|
= Spinner
|
||||||
{ sSnapshots :: [String]
|
{ sSnapshots :: [String]
|
||||||
, sLength :: Int
|
, sLength :: Int
|
||||||
, sDelay :: Int
|
, sDelay :: Int
|
||||||
, sColors :: [Color]
|
, sColors :: [ANSI.Color]
|
||||||
, sThreadId :: Maybe ThreadId
|
, sThreadId :: Maybe CC.ThreadId
|
||||||
}
|
}
|
||||||
| ProgressBar
|
| ProgressBar
|
||||||
{ pbProgressRef :: Maybe ProgressRef
|
{ pbProgressRef :: Maybe PB.ProgressRef
|
||||||
, pbThreadId :: Maybe ThreadId
|
, pbThreadId :: Maybe CC.ThreadId
|
||||||
}
|
}
|
||||||
|
@ -4,23 +4,23 @@ module Unused.CLI.Search
|
|||||||
, executeSearch
|
, executeSearch
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Unused.TermSearch (SearchResults, search)
|
import qualified Unused.CLI.ProgressIndicator as I
|
||||||
import Unused.CLI.Util
|
import qualified Unused.CLI.Util as U
|
||||||
import qualified Unused.CLI.Views as V
|
import qualified Unused.CLI.Views as V
|
||||||
import Unused.CLI.ProgressIndicator
|
import qualified Unused.TermSearch as TS
|
||||||
|
|
||||||
data SearchRunner = SearchWithProgress | SearchWithoutProgress
|
data SearchRunner = SearchWithProgress | SearchWithoutProgress
|
||||||
|
|
||||||
renderHeader :: [String] -> IO ()
|
renderHeader :: [String] -> IO ()
|
||||||
renderHeader terms = do
|
renderHeader terms = do
|
||||||
resetScreen
|
U.resetScreen
|
||||||
V.analysisHeader terms
|
V.analysisHeader terms
|
||||||
|
|
||||||
executeSearch :: SearchRunner -> [String] -> IO SearchResults
|
executeSearch :: SearchRunner -> [String] -> IO TS.SearchResults
|
||||||
executeSearch runner terms = do
|
executeSearch runner terms = do
|
||||||
renderHeader terms
|
renderHeader terms
|
||||||
runSearch runner terms <* resetScreen
|
runSearch runner terms <* U.resetScreen
|
||||||
|
|
||||||
runSearch :: SearchRunner -> [String] -> IO SearchResults
|
runSearch :: SearchRunner -> [String] -> IO TS.SearchResults
|
||||||
runSearch SearchWithProgress = progressWithIndicator search createProgressBar
|
runSearch SearchWithProgress = I.progressWithIndicator TS.search I.createProgressBar
|
||||||
runSearch SearchWithoutProgress = progressWithIndicator search createSpinner
|
runSearch SearchWithoutProgress = I.progressWithIndicator TS.search I.createSpinner
|
||||||
|
@ -5,19 +5,19 @@ module Unused.CLI.Util
|
|||||||
, module System.Console.ANSI
|
, module System.Console.ANSI
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent.ParallelIO
|
import qualified Control.Concurrent as CC
|
||||||
import Control.Monad (void)
|
import qualified Control.Concurrent.ParallelIO as PIO
|
||||||
import System.Console.ANSI
|
import qualified Control.Exception as E
|
||||||
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
|
import qualified Control.Monad as M
|
||||||
import Control.Exception (throwTo)
|
import System.Console.ANSI
|
||||||
import System.Posix.Signals (Handler(Catch), installHandler, keyboardSignal)
|
import qualified System.Exit as Ex
|
||||||
import Control.Concurrent (ThreadId, myThreadId, killThread)
|
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
|
||||||
import System.Exit (ExitCode(ExitFailure))
|
import qualified System.Posix.Signals as S
|
||||||
|
|
||||||
withRuntime :: IO a -> IO a
|
withRuntime :: IO a -> IO a
|
||||||
withRuntime a = do
|
withRuntime a = do
|
||||||
hSetBuffering stdout NoBuffering
|
hSetBuffering stdout NoBuffering
|
||||||
withInterruptHandler $ withoutCursor a <* stopGlobalPool
|
withInterruptHandler $ withoutCursor a <* PIO.stopGlobalPool
|
||||||
|
|
||||||
resetScreen :: IO ()
|
resetScreen :: IO ()
|
||||||
resetScreen = do
|
resetScreen = do
|
||||||
@ -31,30 +31,30 @@ withoutCursor body = do
|
|||||||
|
|
||||||
withInterruptHandler :: IO a -> IO a
|
withInterruptHandler :: IO a -> IO a
|
||||||
withInterruptHandler body = do
|
withInterruptHandler body = do
|
||||||
tid <- myThreadId
|
tid <- CC.myThreadId
|
||||||
void $ installHandler keyboardSignal (Catch (handleInterrupt tid)) Nothing
|
M.void $ S.installHandler S.keyboardSignal (S.Catch (handleInterrupt tid)) Nothing
|
||||||
body
|
body
|
||||||
|
|
||||||
installChildInterruptHandler :: ThreadId -> IO ()
|
installChildInterruptHandler :: CC.ThreadId -> IO ()
|
||||||
installChildInterruptHandler tid = do
|
installChildInterruptHandler tid = do
|
||||||
currentThread <- myThreadId
|
currentThread <- CC.myThreadId
|
||||||
void $ installHandler keyboardSignal (Catch (handleChildInterrupt currentThread tid)) Nothing
|
M.void $ S.installHandler S.keyboardSignal (S.Catch (handleChildInterrupt currentThread tid)) Nothing
|
||||||
|
|
||||||
handleInterrupt :: ThreadId -> IO ()
|
handleInterrupt :: CC.ThreadId -> IO ()
|
||||||
handleInterrupt tid = do
|
handleInterrupt tid = do
|
||||||
resetScreenState
|
resetScreenState
|
||||||
throwTo tid $ ExitFailure interruptExitCode
|
E.throwTo tid $ Ex.ExitFailure interruptExitCode
|
||||||
|
|
||||||
handleChildInterrupt :: ThreadId -> ThreadId -> IO ()
|
handleChildInterrupt :: CC.ThreadId -> CC.ThreadId -> IO ()
|
||||||
handleChildInterrupt parentTid childTid = do
|
handleChildInterrupt parentTid childTid = do
|
||||||
killThread childTid
|
CC.killThread childTid
|
||||||
resetScreenState
|
resetScreenState
|
||||||
throwTo parentTid $ ExitFailure interruptExitCode
|
E.throwTo parentTid $ Ex.ExitFailure interruptExitCode
|
||||||
handleInterrupt parentTid
|
handleInterrupt parentTid
|
||||||
|
|
||||||
interruptExitCode :: Int
|
interruptExitCode :: Int
|
||||||
interruptExitCode =
|
interruptExitCode =
|
||||||
signalToInt $ 128 + keyboardSignal
|
signalToInt $ 128 + S.keyboardSignal
|
||||||
where
|
where
|
||||||
signalToInt s = read $ show s :: Int
|
signalToInt s = read $ show s :: Int
|
||||||
|
|
||||||
|
@ -2,10 +2,10 @@ module Unused.CLI.Views
|
|||||||
( module X
|
( module X
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Unused.CLI.Views.NoResultsFound as X
|
|
||||||
import Unused.CLI.Views.AnalysisHeader as X
|
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.FingerprintError as X
|
||||||
|
import Unused.CLI.Views.GitSHAsHeader as X
|
||||||
|
import Unused.CLI.Views.InvalidConfigError as X
|
||||||
|
import Unused.CLI.Views.MissingTagsFileError as X
|
||||||
|
import Unused.CLI.Views.NoResultsFound as X
|
||||||
import Unused.CLI.Views.SearchResult as X
|
import Unused.CLI.Views.SearchResult as X
|
||||||
|
@ -2,13 +2,13 @@ module Unused.CLI.Views.FingerprintError
|
|||||||
( fingerprintError
|
( fingerprintError
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.List (intercalate)
|
import qualified Data.List as L
|
||||||
import Unused.Cache.DirectoryFingerprint
|
import qualified Unused.CLI.Views.Error as V
|
||||||
import Unused.CLI.Views.Error
|
import Unused.Cache.DirectoryFingerprint (FingerprintOutcome(..))
|
||||||
|
|
||||||
fingerprintError :: FingerprintOutcome -> IO ()
|
fingerprintError :: FingerprintOutcome -> IO ()
|
||||||
fingerprintError e = do
|
fingerprintError e = do
|
||||||
errorHeader "There was a problem generating a cache fingerprint:"
|
V.errorHeader "There was a problem generating a cache fingerprint:"
|
||||||
|
|
||||||
printOutcomeMessage e
|
printOutcomeMessage e
|
||||||
|
|
||||||
@ -16,4 +16,4 @@ printOutcomeMessage :: FingerprintOutcome -> IO ()
|
|||||||
printOutcomeMessage (MD5ExecutableNotFound execs) =
|
printOutcomeMessage (MD5ExecutableNotFound execs) =
|
||||||
putStrLn $
|
putStrLn $
|
||||||
"Unable to find any of the following executables \
|
"Unable to find any of the following executables \
|
||||||
\in your PATH: " ++ intercalate ", " execs
|
\in your PATH: " ++ L.intercalate ", " execs
|
||||||
|
@ -2,13 +2,13 @@ module Unused.CLI.Views.InvalidConfigError
|
|||||||
( invalidConfigError
|
( invalidConfigError
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Unused.CLI.Util
|
import Unused.CLI.Util
|
||||||
import Unused.CLI.Views.Error
|
import qualified Unused.CLI.Views.Error as V
|
||||||
import Unused.ResultsClassifier (ParseConfigError(..))
|
import Unused.ResultsClassifier (ParseConfigError(..))
|
||||||
|
|
||||||
invalidConfigError :: [ParseConfigError] -> IO ()
|
invalidConfigError :: [ParseConfigError] -> IO ()
|
||||||
invalidConfigError es = do
|
invalidConfigError es = do
|
||||||
errorHeader "There was a problem with the following config file(s):"
|
V.errorHeader "There was a problem with the following config file(s):"
|
||||||
|
|
||||||
mapM_ configError es
|
mapM_ configError es
|
||||||
|
|
||||||
|
@ -2,13 +2,13 @@ module Unused.CLI.Views.MissingTagsFileError
|
|||||||
( missingTagsFileError
|
( missingTagsFileError
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Unused.TagsSource
|
import Unused.CLI.Util
|
||||||
import Unused.CLI.Util
|
import qualified Unused.CLI.Views.Error as V
|
||||||
import Unused.CLI.Views.Error
|
import Unused.TagsSource (TagSearchOutcome(..))
|
||||||
|
|
||||||
missingTagsFileError :: TagSearchOutcome -> IO ()
|
missingTagsFileError :: TagSearchOutcome -> IO ()
|
||||||
missingTagsFileError e = do
|
missingTagsFileError e = do
|
||||||
errorHeader "There was a problem finding a tags file."
|
V.errorHeader "There was a problem finding a tags file."
|
||||||
printOutcomeMessage e
|
printOutcomeMessage e
|
||||||
|
|
||||||
putStr "\n"
|
putStr "\n"
|
||||||
@ -40,3 +40,6 @@ printOutcomeMessage :: TagSearchOutcome -> IO ()
|
|||||||
printOutcomeMessage (TagsFileNotFound directoriesSearched) = do
|
printOutcomeMessage (TagsFileNotFound directoriesSearched) = do
|
||||||
putStrLn "Looked for a 'tags' file in the following directories:\n"
|
putStrLn "Looked for a 'tags' file in the following directories:\n"
|
||||||
mapM_ (\d -> putStrLn $ "* " ++ d) directoriesSearched
|
mapM_ (\d -> putStrLn $ "* " ++ d) directoriesSearched
|
||||||
|
printOutcomeMessage (IOError e) = do
|
||||||
|
putStrLn "Received error when loading tags file:\n"
|
||||||
|
putStrLn $ " " ++ show e
|
||||||
|
@ -3,16 +3,16 @@ module Unused.CLI.Views.SearchResult
|
|||||||
, searchResults
|
, searchResults
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Arrow ((&&&))
|
import Control.Arrow ((&&&))
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Unused.Types
|
import Unused.CLI.Util
|
||||||
import Unused.Grouping (Grouping(..), GroupedTerms)
|
|
||||||
import Unused.CLI.Views.SearchResult.ColumnFormatter
|
|
||||||
import Unused.CLI.Util
|
|
||||||
import Unused.CLI.Views.SearchResult.Types
|
|
||||||
import qualified Unused.CLI.Views.NoResultsFound as V
|
import qualified Unused.CLI.Views.NoResultsFound as V
|
||||||
|
import Unused.CLI.Views.SearchResult.ColumnFormatter
|
||||||
import qualified Unused.CLI.Views.SearchResult.ListResult as V
|
import qualified Unused.CLI.Views.SearchResult.ListResult as V
|
||||||
import qualified Unused.CLI.Views.SearchResult.TableResult as V
|
import qualified Unused.CLI.Views.SearchResult.TableResult as V
|
||||||
|
import Unused.CLI.Views.SearchResult.Types
|
||||||
|
import Unused.Grouping (Grouping(..), GroupedTerms)
|
||||||
|
import Unused.Types (TermMatchSet, TermResults(..), TermMatch)
|
||||||
|
|
||||||
searchResults :: ResultsFormat -> [GroupedTerms] -> IO ()
|
searchResults :: ResultsFormat -> [GroupedTerms] -> IO ()
|
||||||
searchResults format terms = do
|
searchResults format terms = do
|
||||||
|
@ -3,7 +3,7 @@ module Unused.CLI.Views.SearchResult.ColumnFormatter
|
|||||||
, buildColumnFormatter
|
, buildColumnFormatter
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Text.Printf
|
import Text.Printf (printf)
|
||||||
import Unused.Types (TermResults(..), TermMatch(..), totalFileCount, totalOccurrenceCount)
|
import Unused.Types (TermResults(..), TermMatch(..), totalFileCount, totalOccurrenceCount)
|
||||||
|
|
||||||
data ColumnFormat = ColumnFormat
|
data ColumnFormat = ColumnFormat
|
||||||
|
@ -2,16 +2,17 @@ module Unused.CLI.Views.SearchResult.ListResult
|
|||||||
( printList
|
( printList
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (forM_, void, when)
|
import qualified Control.Monad as M
|
||||||
import Data.List (intercalate, (\\))
|
import Data.List ((\\))
|
||||||
import Unused.CLI.Util
|
import qualified Data.List as L
|
||||||
import Unused.Types
|
import Unused.CLI.Util
|
||||||
import Unused.CLI.Views.SearchResult.Internal
|
import qualified Unused.CLI.Views.SearchResult.Internal as SR
|
||||||
import Unused.CLI.Views.SearchResult.Types
|
import qualified Unused.CLI.Views.SearchResult.Types as SR
|
||||||
|
import Unused.Types (TermResults(..), GitContext(..), GitCommit(..), TermMatch(..), totalFileCount, totalOccurrenceCount)
|
||||||
|
|
||||||
printList :: TermResults -> [TermMatch] -> ResultsPrinter ()
|
printList :: TermResults -> [TermMatch] -> SR.ResultsPrinter ()
|
||||||
printList r ms = liftIO $
|
printList r ms = SR.liftIO $
|
||||||
forM_ ms $ \m -> do
|
M.forM_ ms $ \m -> do
|
||||||
printTermAndOccurrences r
|
printTermAndOccurrences r
|
||||||
printAliases r
|
printAliases r
|
||||||
printFilePath m
|
printFilePath m
|
||||||
@ -21,7 +22,7 @@ printList r ms = liftIO $
|
|||||||
|
|
||||||
printTermAndOccurrences :: TermResults -> IO ()
|
printTermAndOccurrences :: TermResults -> IO ()
|
||||||
printTermAndOccurrences r = do
|
printTermAndOccurrences r = do
|
||||||
setSGR [SetColor Foreground Dull (termColor r)]
|
setSGR [SetColor Foreground Dull (SR.termColor r)]
|
||||||
setSGR [SetConsoleIntensity BoldIntensity]
|
setSGR [SetConsoleIntensity BoldIntensity]
|
||||||
putStr " "
|
putStr " "
|
||||||
setSGR [SetUnderlining SingleUnderline]
|
setSGR [SetUnderlining SingleUnderline]
|
||||||
@ -39,9 +40,9 @@ printTermAndOccurrences r = do
|
|||||||
putStr "\n"
|
putStr "\n"
|
||||||
|
|
||||||
printAliases :: TermResults -> IO ()
|
printAliases :: TermResults -> IO ()
|
||||||
printAliases r = when anyAliases $ do
|
printAliases r = M.when anyAliases $ do
|
||||||
printHeader " Aliases: "
|
printHeader " Aliases: "
|
||||||
putStrLn $ intercalate ", " remainingAliases
|
putStrLn $ L.intercalate ", " remainingAliases
|
||||||
where
|
where
|
||||||
anyAliases = not $ null remainingAliases
|
anyAliases = not $ null remainingAliases
|
||||||
remainingAliases = trTerms r \\ [trTerm r]
|
remainingAliases = trTerms r \\ [trTerm r]
|
||||||
@ -56,17 +57,17 @@ printFilePath m = do
|
|||||||
printSHAs :: TermResults -> IO ()
|
printSHAs :: TermResults -> IO ()
|
||||||
printSHAs r =
|
printSHAs r =
|
||||||
case mshas of
|
case mshas of
|
||||||
Nothing -> void $ putStr ""
|
Nothing -> M.void $ putStr ""
|
||||||
Just shas' -> do
|
Just shas' -> do
|
||||||
printHeader " Recent SHAs: "
|
printHeader " Recent SHAs: "
|
||||||
putStrLn $ intercalate ", " shas'
|
putStrLn $ L.intercalate ", " shas'
|
||||||
where
|
where
|
||||||
mshas = (map gcSha . gcCommits) <$> trGitContext r
|
mshas = (map gcSha . gcCommits) <$> trGitContext r
|
||||||
|
|
||||||
printRemovalReason :: TermResults -> IO ()
|
printRemovalReason :: TermResults -> IO ()
|
||||||
printRemovalReason r = do
|
printRemovalReason r = do
|
||||||
printHeader " Reason: "
|
printHeader " Reason: "
|
||||||
putStrLn $ removalReason r
|
putStrLn $ SR.removalReason r
|
||||||
|
|
||||||
printHeader :: String -> IO ()
|
printHeader :: String -> IO ()
|
||||||
printHeader v = do
|
printHeader v = do
|
||||||
|
@ -2,21 +2,21 @@ module Unused.CLI.Views.SearchResult.TableResult
|
|||||||
( printTable
|
( printTable
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (forM_)
|
import qualified Control.Monad as M
|
||||||
import Unused.Types
|
import Unused.CLI.Util
|
||||||
import Unused.CLI.Util
|
import qualified Unused.CLI.Views.SearchResult.Internal as SR
|
||||||
import Unused.CLI.Views.SearchResult.Internal
|
import qualified Unused.CLI.Views.SearchResult.Types as SR
|
||||||
import Unused.CLI.Views.SearchResult.Types
|
import Unused.Types (TermResults, TermMatch(..), totalFileCount, totalOccurrenceCount)
|
||||||
|
|
||||||
printTable :: TermResults -> [TermMatch] -> ResultsPrinter ()
|
printTable :: TermResults -> [TermMatch] -> SR.ResultsPrinter ()
|
||||||
printTable r ms = do
|
printTable r ms = do
|
||||||
cf <- columnFormat
|
cf <- SR.columnFormat
|
||||||
let printTerm = cfPrintTerm cf
|
let printTerm = SR.cfPrintTerm cf
|
||||||
let printPath = cfPrintPath cf
|
let printPath = SR.cfPrintPath cf
|
||||||
let printNumber = cfPrintNumber cf
|
let printNumber = SR.cfPrintNumber cf
|
||||||
|
|
||||||
liftIO $ forM_ ms $ \m -> do
|
SR.liftIO $ M.forM_ ms $ \m -> do
|
||||||
setSGR [SetColor Foreground Dull (termColor r)]
|
setSGR [SetColor Foreground Dull (SR.termColor r)]
|
||||||
setSGR [SetConsoleIntensity NormalIntensity]
|
setSGR [SetConsoleIntensity NormalIntensity]
|
||||||
putStr $ " " ++ printTerm (tmTerm m)
|
putStr $ " " ++ printTerm (tmTerm m)
|
||||||
setSGR [Reset]
|
setSGR [Reset]
|
||||||
@ -31,5 +31,5 @@ printTable r ms = do
|
|||||||
putStr $ " " ++ printPath (tmPath m)
|
putStr $ " " ++ printPath (tmPath m)
|
||||||
setSGR [Reset]
|
setSGR [Reset]
|
||||||
|
|
||||||
putStr $ " " ++ removalReason r
|
putStr $ " " ++ SR.removalReason r
|
||||||
putStr "\n"
|
putStr "\n"
|
||||||
|
@ -6,12 +6,11 @@ module Unused.CLI.Views.SearchResult.Types
|
|||||||
, columnFormat
|
, columnFormat
|
||||||
, outputFormat
|
, outputFormat
|
||||||
, R.runReaderT
|
, R.runReaderT
|
||||||
, M.liftIO
|
, R.liftIO
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Control.Monad.Trans.Reader as R
|
import qualified Control.Monad.Reader as R
|
||||||
import qualified Control.Monad.IO.Class as M
|
import Unused.CLI.Views.SearchResult.ColumnFormatter
|
||||||
import Unused.CLI.Views.SearchResult.ColumnFormatter
|
|
||||||
|
|
||||||
data ResultsOptions = ResultsOptions
|
data ResultsOptions = ResultsOptions
|
||||||
{ roColumnFormat :: ColumnFormat
|
{ roColumnFormat :: ColumnFormat
|
||||||
|
@ -3,14 +3,13 @@ module Unused.Cache
|
|||||||
, cached
|
, cached
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
|
||||||
import Control.Monad.Trans.Reader
|
|
||||||
import Data.Csv (FromRecord, ToRecord, HasHeader(..), encode, decode)
|
|
||||||
import Data.Vector (toList)
|
|
||||||
import System.Directory (createDirectoryIfMissing)
|
|
||||||
import qualified Data.ByteString.Lazy as BS
|
import qualified Data.ByteString.Lazy as BS
|
||||||
import Unused.Cache.DirectoryFingerprint
|
import Data.Csv (FromRecord, ToRecord, HasHeader(..), encode, decode)
|
||||||
import Unused.Util (safeReadFile)
|
import qualified Data.Vector as V
|
||||||
|
import qualified System.Directory as D
|
||||||
|
import Unused.Cache.DirectoryFingerprint (FingerprintOutcome(..), sha)
|
||||||
|
import Unused.Util (safeReadFile)
|
||||||
|
|
||||||
newtype CacheFileName = CacheFileName String
|
newtype CacheFileName = CacheFileName String
|
||||||
type Cache = ReaderT CacheFileName IO
|
type Cache = ReaderT CacheFileName IO
|
||||||
@ -24,7 +23,7 @@ cached cachePrefix f =
|
|||||||
writeCache :: ToRecord a => [a] -> Cache [a]
|
writeCache :: ToRecord a => [a] -> Cache [a]
|
||||||
writeCache [] = return []
|
writeCache [] = return []
|
||||||
writeCache contents = do
|
writeCache contents = do
|
||||||
liftIO $ createDirectoryIfMissing True cacheDirectory
|
liftIO $ D.createDirectoryIfMissing True cacheDirectory
|
||||||
(CacheFileName fileName) <- ask
|
(CacheFileName fileName) <- ask
|
||||||
liftIO $ BS.writeFile fileName $ encode contents
|
liftIO $ BS.writeFile fileName $ encode contents
|
||||||
return contents
|
return contents
|
||||||
@ -36,16 +35,16 @@ readCache = do
|
|||||||
either
|
either
|
||||||
(const Nothing)
|
(const Nothing)
|
||||||
(processCsv . decode NoHeader)
|
(processCsv . decode NoHeader)
|
||||||
<$> (liftIO $ safeReadFile fileName)
|
<$> liftIO (safeReadFile fileName)
|
||||||
where
|
where
|
||||||
processCsv = either (const Nothing) (Just . toList)
|
processCsv = either (const Nothing) (Just . V.toList)
|
||||||
|
|
||||||
cacheFileName :: String -> IO (Either FingerprintOutcome CacheFileName)
|
cacheFileName :: String -> IO (Either FingerprintOutcome CacheFileName)
|
||||||
cacheFileName context = do
|
cacheFileName context = do
|
||||||
putStrLn "\n\nCalculating cache fingerprint... "
|
putStrLn "\n\nCalculating cache fingerprint... "
|
||||||
fmap toFileName <$> sha
|
fmap (CacheFileName . toFileName) <$> sha
|
||||||
where
|
where
|
||||||
toFileName s = CacheFileName $ cacheDirectory ++ "/" ++ context ++ "-" ++ s ++ ".csv"
|
toFileName s = cacheDirectory ++ "/" ++ context ++ "-" ++ s ++ ".csv"
|
||||||
|
|
||||||
cacheDirectory :: String
|
cacheDirectory :: String
|
||||||
cacheDirectory = "tmp/unused"
|
cacheDirectory = "tmp/unused"
|
||||||
|
@ -3,16 +3,17 @@ module Unused.Cache.DirectoryFingerprint
|
|||||||
, sha
|
, sha
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Process
|
import Control.Monad.Reader (ReaderT, runReaderT, asks, liftIO)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Control.Monad.Trans.Reader
|
|
||||||
import qualified System.Directory as D
|
|
||||||
import qualified Data.Char as C
|
import qualified Data.Char as C
|
||||||
import Data.Maybe (fromMaybe)
|
import qualified Data.Maybe as M
|
||||||
import Unused.Cache.FindArgsFromIgnoredPaths
|
import qualified System.Directory as D
|
||||||
import Unused.Util (safeHead, safeReadFile)
|
import qualified System.Process as P
|
||||||
|
import Unused.Cache.FindArgsFromIgnoredPaths (findArgs)
|
||||||
|
import Unused.Util (safeHead, safeReadFile)
|
||||||
|
|
||||||
type MD5Config = ReaderT String IO
|
newtype MD5ExecutablePath = MD5ExecutablePath { toMD5String :: String }
|
||||||
|
|
||||||
|
type MD5Config = ReaderT MD5ExecutablePath IO
|
||||||
|
|
||||||
data FingerprintOutcome
|
data FingerprintOutcome
|
||||||
= MD5ExecutableNotFound [String]
|
= MD5ExecutableNotFound [String]
|
||||||
@ -22,25 +23,25 @@ sha = do
|
|||||||
md5Executable' <- md5Executable
|
md5Executable' <- md5Executable
|
||||||
case md5Executable' of
|
case md5Executable' of
|
||||||
Just exec ->
|
Just exec ->
|
||||||
Right . getSha <$> runReaderT (fileList >>= sortInput >>= md5Result) exec
|
Right . getSha <$> runReaderT (fileList >>= sortInput >>= md5Result) (MD5ExecutablePath exec)
|
||||||
Nothing -> return $ Left $ MD5ExecutableNotFound supportedMD5Executables
|
Nothing -> return $ Left $ MD5ExecutableNotFound supportedMD5Executables
|
||||||
where
|
where
|
||||||
getSha = takeWhile C.isAlphaNum . fromMaybe "" . safeHead . lines
|
getSha = takeWhile C.isAlphaNum . M.fromMaybe "" . safeHead . lines
|
||||||
|
|
||||||
fileList :: MD5Config String
|
fileList :: MD5Config String
|
||||||
fileList = do
|
fileList = do
|
||||||
filterNamePathArgs <- liftIO $ findArgs <$> ignoredPaths
|
filterNamePathArgs <- liftIO $ findArgs <$> ignoredPaths
|
||||||
md5exec <- ask
|
md5exec <- asks toMD5String
|
||||||
let args = [".", "-type", "f", "-not", "-path", "*/.git/*"] ++ filterNamePathArgs ++ ["-exec", md5exec, "{}", "+"]
|
let args = [".", "-type", "f", "-not", "-path", "*/.git/*"] ++ filterNamePathArgs ++ ["-exec", md5exec, "{}", "+"]
|
||||||
liftIO $ readProcess "find" args ""
|
liftIO $ P.readProcess "find" args ""
|
||||||
|
|
||||||
sortInput :: String -> MD5Config String
|
sortInput :: String -> MD5Config String
|
||||||
sortInput = liftIO . readProcess "sort" ["-k", "2"]
|
sortInput = liftIO . P.readProcess "sort" ["-k", "2"]
|
||||||
|
|
||||||
md5Result :: String -> MD5Config String
|
md5Result :: String -> MD5Config String
|
||||||
md5Result r = do
|
md5Result r = do
|
||||||
md5exec <- ask
|
md5exec <- asks toMD5String
|
||||||
liftIO $ readProcess md5exec [] r
|
liftIO $ P.readProcess md5exec [] r
|
||||||
|
|
||||||
ignoredPaths :: IO [String]
|
ignoredPaths :: IO [String]
|
||||||
ignoredPaths = either (const []) id <$> (fmap lines <$> safeReadFile ".gitignore")
|
ignoredPaths = either (const []) id <$> (fmap lines <$> safeReadFile ".gitignore")
|
||||||
|
@ -2,9 +2,9 @@ module Unused.Cache.FindArgsFromIgnoredPaths
|
|||||||
( findArgs
|
( findArgs
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Char (isAlphaNum)
|
import qualified Data.Char as C
|
||||||
import Data.List (isSuffixOf)
|
import qualified Data.List as L
|
||||||
import System.FilePath
|
import qualified System.FilePath as FP
|
||||||
|
|
||||||
findArgs :: [String] -> [String]
|
findArgs :: [String] -> [String]
|
||||||
findArgs = concatMap ignoreToFindArgs . validIgnoreOptions
|
findArgs = concatMap ignoreToFindArgs . validIgnoreOptions
|
||||||
@ -28,14 +28,14 @@ ignoreToFindArgs = toExclusions . wildcardPrefix
|
|||||||
wildcardSuffix :: String -> String
|
wildcardSuffix :: String -> String
|
||||||
wildcardSuffix s
|
wildcardSuffix s
|
||||||
| isWildcardFilename s = s
|
| isWildcardFilename s = s
|
||||||
| "/" `isSuffixOf` s = s ++ "*"
|
| "/" `L.isSuffixOf` s = s ++ "*"
|
||||||
| otherwise = s ++ "/*"
|
| otherwise = s ++ "/*"
|
||||||
|
|
||||||
isWildcardFilename :: String -> Bool
|
isWildcardFilename :: String -> Bool
|
||||||
isWildcardFilename = elem '*' . takeFileName
|
isWildcardFilename = elem '*' . FP.takeFileName
|
||||||
|
|
||||||
isMissingFilename :: String -> Bool
|
isMissingFilename :: String -> Bool
|
||||||
isMissingFilename s = takeFileName s == ""
|
isMissingFilename = null . FP.takeFileName
|
||||||
|
|
||||||
validIgnoreOptions :: [String] -> [String]
|
validIgnoreOptions :: [String] -> [String]
|
||||||
validIgnoreOptions =
|
validIgnoreOptions =
|
||||||
@ -44,4 +44,4 @@ validIgnoreOptions =
|
|||||||
isPath "" = False
|
isPath "" = False
|
||||||
isPath ('/':_) = True
|
isPath ('/':_) = True
|
||||||
isPath ('.':_) = True
|
isPath ('.':_) = True
|
||||||
isPath s = isAlphaNum $ head s
|
isPath s = C.isAlphaNum $ head s
|
||||||
|
@ -4,10 +4,10 @@ module Unused.GitContext
|
|||||||
( gitContextForResults
|
( gitContextForResults
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import System.Process
|
import qualified Data.Text as T
|
||||||
import Unused.Types (TermResults(trGitContext), GitContext(..), GitCommit(..), RemovalLikelihood(High), removalLikelihood, resultAliases)
|
import qualified System.Process as P
|
||||||
|
import Unused.Types (TermResults(trGitContext), GitContext(..), GitCommit(..), RemovalLikelihood(High), removalLikelihood, resultAliases)
|
||||||
|
|
||||||
newtype GitOutput = GitOutput { unOutput :: String }
|
newtype GitOutput = GitOutput { unOutput :: String }
|
||||||
|
|
||||||
@ -31,5 +31,5 @@ logToGitContext =
|
|||||||
|
|
||||||
gitLogSearchFor :: Int -> [String] -> IO GitOutput
|
gitLogSearchFor :: Int -> [String] -> IO GitOutput
|
||||||
gitLogSearchFor commitCount ts = do
|
gitLogSearchFor commitCount ts = do
|
||||||
(_, results, _) <- readProcessWithExitCode "git" ["log", "-G", L.intercalate "|" ts, "--oneline", "-n", show commitCount] ""
|
(_, results, _) <- P.readProcessWithExitCode "git" ["log", "-G", L.intercalate "|" ts, "--oneline", "-n", show commitCount] ""
|
||||||
return $ GitOutput results
|
return $ GitOutput results
|
||||||
|
@ -5,12 +5,12 @@ module Unused.Grouping
|
|||||||
, groupedResponses
|
, groupedResponses
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import qualified Data.List as L
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Data.List (sort, nub)
|
import Unused.Grouping.Internal (groupFilter)
|
||||||
import Unused.Types
|
import Unused.Grouping.Types (Grouping(..), CurrentGrouping(..), GroupFilter, GroupedTerms)
|
||||||
import Unused.ResponseFilter (updateMatches)
|
import Unused.ResponseFilter (updateMatches)
|
||||||
import Unused.Grouping.Types
|
import Unused.Types (TermMatchSet, TermResults(trMatches))
|
||||||
import Unused.Grouping.Internal
|
|
||||||
|
|
||||||
groupedResponses :: CurrentGrouping -> TermMatchSet -> [GroupedTerms]
|
groupedResponses :: CurrentGrouping -> TermMatchSet -> [GroupedTerms]
|
||||||
groupedResponses g tms =
|
groupedResponses g tms =
|
||||||
@ -21,12 +21,10 @@ groupedResponses g tms =
|
|||||||
|
|
||||||
groupedMatchSetSubsets :: GroupFilter -> Grouping -> TermMatchSet -> TermMatchSet
|
groupedMatchSetSubsets :: GroupFilter -> Grouping -> TermMatchSet -> TermMatchSet
|
||||||
groupedMatchSetSubsets f tms =
|
groupedMatchSetSubsets f tms =
|
||||||
updateMatches newMatches
|
updateMatches $ filter ((== tms) . f)
|
||||||
where
|
|
||||||
newMatches = filter ((== tms) . f)
|
|
||||||
|
|
||||||
allGroupings :: GroupFilter -> TermMatchSet -> [Grouping]
|
allGroupings :: GroupFilter -> TermMatchSet -> [Grouping]
|
||||||
allGroupings f =
|
allGroupings f =
|
||||||
uniqueValues . Map.map (fmap f . trMatches)
|
uniqueValues . Map.map (fmap f . trMatches)
|
||||||
where
|
where
|
||||||
uniqueValues = sort . nub . concat . Map.elems
|
uniqueValues = L.sort . L.nub . concat . Map.elems
|
||||||
|
@ -2,26 +2,17 @@ module Unused.Grouping.Internal
|
|||||||
( groupFilter
|
( groupFilter
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Unused.Grouping.Types
|
import qualified Data.List as L
|
||||||
import System.FilePath (takeDirectory, splitDirectories)
|
import qualified System.FilePath as FP
|
||||||
import Unused.Types (tmPath, tmTerm)
|
import Unused.Grouping.Types (CurrentGrouping(..), Grouping(..), GroupFilter)
|
||||||
import Data.List (intercalate)
|
import qualified Unused.Types as T
|
||||||
|
|
||||||
groupFilter :: CurrentGrouping -> GroupFilter
|
groupFilter :: CurrentGrouping -> GroupFilter
|
||||||
groupFilter GroupByDirectory = fileNameGrouping
|
groupFilter GroupByDirectory = ByDirectory . shortenedDirectory . T.tmPath
|
||||||
groupFilter GroupByTerm = termGrouping
|
groupFilter GroupByTerm = ByTerm . T.tmTerm
|
||||||
groupFilter GroupByFile = fileGrouping
|
groupFilter GroupByFile = ByFile . T.tmPath
|
||||||
groupFilter NoGroup = const NoGrouping
|
groupFilter NoGroup = const NoGrouping
|
||||||
|
|
||||||
fileNameGrouping :: GroupFilter
|
|
||||||
fileNameGrouping = ByDirectory . shortenedDirectory . tmPath
|
|
||||||
|
|
||||||
termGrouping :: GroupFilter
|
|
||||||
termGrouping = ByTerm . tmTerm
|
|
||||||
|
|
||||||
fileGrouping :: GroupFilter
|
|
||||||
fileGrouping = ByFile . tmPath
|
|
||||||
|
|
||||||
shortenedDirectory :: String -> String
|
shortenedDirectory :: String -> String
|
||||||
shortenedDirectory =
|
shortenedDirectory =
|
||||||
intercalate "/" . take 2 . splitDirectories . takeDirectory
|
L.intercalate "/" . take 2 . FP.splitDirectories . FP.takeDirectory
|
||||||
|
@ -3,38 +3,34 @@ module Unused.LikelihoodCalculator
|
|||||||
, LanguageConfiguration
|
, LanguageConfiguration
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Maybe (isJust)
|
import qualified Data.List as L
|
||||||
import Data.List (find, intercalate)
|
import qualified Data.Maybe as M
|
||||||
import Unused.ResultsClassifier
|
import qualified Unused.ResponseFilter as RF
|
||||||
import Unused.Types
|
import Unused.ResultsClassifier (LanguageConfiguration(..), LowLikelihoodMatch(..))
|
||||||
import Unused.ResponseFilter (autoLowLikelihood)
|
import Unused.Types (TermResults(..), Occurrences(..), RemovalLikelihood(..), Removal(..), totalOccurrenceCount)
|
||||||
|
|
||||||
calculateLikelihood :: [LanguageConfiguration] -> TermResults -> TermResults
|
calculateLikelihood :: [LanguageConfiguration] -> TermResults -> TermResults
|
||||||
calculateLikelihood lcs r =
|
calculateLikelihood lcs r =
|
||||||
r { trRemoval = uncurry Removal newLikelihood }
|
r { trRemoval = uncurry Removal newLikelihood }
|
||||||
where
|
where
|
||||||
baseScore = totalOccurrenceCount r
|
|
||||||
totalScore = baseScore
|
|
||||||
newLikelihood
|
newLikelihood
|
||||||
| isJust firstAutoLowLikelihood = (Low, autoLowLikelihoodMessage)
|
| M.isJust firstAutoLowLikelihood = (Low, autoLowLikelihoodMessage)
|
||||||
| singleNonTestUsage r && testsExist r = (High, "only the definition and corresponding tests exist")
|
| singleNonTestUsage r && testsExist r = (High, "only the definition and corresponding tests exist")
|
||||||
| doubleNonTestUsage r && testsExist r = (Medium, "only the definition and one other use, along with tests, exists")
|
| doubleNonTestUsage r && testsExist r = (Medium, "only the definition and one other use, along with tests, exists")
|
||||||
| totalScore < 2 = (High, "used once")
|
| totalScore < 2 = (High, "used once")
|
||||||
| totalScore < 6 = (Medium, "used semi-frequently")
|
| totalScore < 6 = (Medium, "used semi-frequently")
|
||||||
| totalScore >= 6 = (Low, "used frequently")
|
| totalScore >= 6 = (Low, "used frequently")
|
||||||
| otherwise = (Unknown, "could not determine likelihood")
|
| otherwise = (Unknown, "could not determine likelihood")
|
||||||
firstAutoLowLikelihood = find (`autoLowLikelihood` r) lcs
|
totalScore = totalOccurrenceCount r
|
||||||
autoLowLikelihoodMessage =
|
firstAutoLowLikelihood = L.find (`RF.autoLowLikelihood` r) lcs
|
||||||
case firstAutoLowLikelihood of
|
autoLowLikelihoodMessage = maybe "" languageConfirmationMessage firstAutoLowLikelihood
|
||||||
Nothing -> ""
|
|
||||||
Just lang -> languageConfirmationMessage lang
|
|
||||||
|
|
||||||
languageConfirmationMessage :: LanguageConfiguration -> String
|
languageConfirmationMessage :: LanguageConfiguration -> String
|
||||||
languageConfirmationMessage lc =
|
languageConfirmationMessage lc =
|
||||||
langFramework ++ ": allowed term or " ++ lowLikelihoodNames
|
langFramework ++ ": allowed term or " ++ lowLikelihoodNames
|
||||||
where
|
where
|
||||||
langFramework = lcName lc
|
langFramework = lcName lc
|
||||||
lowLikelihoodNames = intercalate ", " $ map smName $ lcAutoLowLikelihood lc
|
lowLikelihoodNames = L.intercalate ", " $ map smName $ lcAutoLowLikelihood lc
|
||||||
|
|
||||||
singleNonTestUsage :: TermResults -> Bool
|
singleNonTestUsage :: TermResults -> Bool
|
||||||
singleNonTestUsage = (1 ==) . oOccurrences . trAppOccurrences
|
singleNonTestUsage = (1 ==) . oOccurrences . trAppOccurrences
|
||||||
|
@ -2,19 +2,19 @@ module Unused.Parser
|
|||||||
( parseResults
|
( parseResults
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Bifunctor (second)
|
import Control.Arrow ((&&&))
|
||||||
import Control.Arrow ((&&&))
|
import qualified Data.Bifunctor as BF
|
||||||
|
import qualified Data.List as L
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Data.List (intercalate, sort, nub)
|
import Unused.Aliases (groupedTermsAndAliases)
|
||||||
import Unused.TermSearch (SearchResults, fromResults)
|
import Unused.LikelihoodCalculator (calculateLikelihood)
|
||||||
import Unused.Types (TermMatchSet, TermMatch, resultsFromMatches, tmTerm)
|
import Unused.ResultsClassifier.Types (LanguageConfiguration(..), TermAlias)
|
||||||
import Unused.LikelihoodCalculator
|
import Unused.TermSearch (SearchResults, fromResults)
|
||||||
import Unused.ResultsClassifier.Types
|
import Unused.Types (TermMatchSet, TermMatch, resultsFromMatches, tmTerm)
|
||||||
import Unused.Aliases
|
|
||||||
|
|
||||||
parseResults :: [LanguageConfiguration] -> SearchResults -> TermMatchSet
|
parseResults :: [LanguageConfiguration] -> SearchResults -> TermMatchSet
|
||||||
parseResults lcs =
|
parseResults lcs =
|
||||||
Map.fromList . map (second $ calculateLikelihood lcs . resultsFromMatches) . groupResults aliases . fromResults
|
Map.fromList . map (BF.second $ calculateLikelihood lcs . resultsFromMatches) . groupResults aliases . fromResults
|
||||||
where
|
where
|
||||||
aliases = concatMap lcTermAliases lcs
|
aliases = concatMap lcTermAliases lcs
|
||||||
|
|
||||||
@ -22,5 +22,5 @@ groupResults :: [TermAlias] -> [TermMatch] -> [(String, [TermMatch])]
|
|||||||
groupResults aliases ms =
|
groupResults aliases ms =
|
||||||
map (toKey &&& id) groupedMatches
|
map (toKey &&& id) groupedMatches
|
||||||
where
|
where
|
||||||
toKey = intercalate "|" . nub . sort . map tmTerm
|
toKey = L.intercalate "|" . L.nub . L.sort . map tmTerm
|
||||||
groupedMatches = groupedTermsAndAliases aliases ms
|
groupedMatches = groupedTermsAndAliases aliases ms
|
||||||
|
@ -8,11 +8,11 @@ module Unused.ResponseFilter
|
|||||||
, updateMatches
|
, updateMatches
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Map.Strict as Map
|
|
||||||
import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
|
|
||||||
import qualified Data.Char as C
|
import qualified Data.Char as C
|
||||||
import Unused.Types
|
import qualified Data.List as L
|
||||||
import Unused.ResultsClassifier
|
import qualified Data.Map.Strict as Map
|
||||||
|
import Unused.ResultsClassifier (Position(..), Matcher(..), LanguageConfiguration(..), LowLikelihoodMatch(..))
|
||||||
|
import Unused.Types (TermResults(..), TermMatchSet, TermMatch(..), RemovalLikelihood, Removal(..), totalOccurrenceCount, appOccurrenceCount)
|
||||||
|
|
||||||
withOneOccurrence :: TermMatchSet -> TermMatchSet
|
withOneOccurrence :: TermMatchSet -> TermMatchSet
|
||||||
withOneOccurrence = Map.filterWithKey (const oneOccurence)
|
withOneOccurrence = Map.filterWithKey (const oneOccurence)
|
||||||
@ -29,7 +29,7 @@ ignoringPaths xs =
|
|||||||
updateMatches newMatches
|
updateMatches newMatches
|
||||||
where
|
where
|
||||||
newMatches = filter (not . matchesPath . tmPath)
|
newMatches = filter (not . matchesPath . tmPath)
|
||||||
matchesPath p = any (`isInfixOf` p) xs
|
matchesPath p = any (`L.isInfixOf` p) xs
|
||||||
|
|
||||||
includesLikelihood :: [RemovalLikelihood] -> TermResults -> Bool
|
includesLikelihood :: [RemovalLikelihood] -> TermResults -> Bool
|
||||||
includesLikelihood l = (`elem` l) . rLikelihood . trRemoval
|
includesLikelihood l = (`elem` l) . rLikelihood . trRemoval
|
||||||
@ -65,12 +65,12 @@ matcherToBool (AppOccurrences i) = (== i) . appOccurrenceCount
|
|||||||
matcherToBool (AllowedTerms ts) = (`isAllowedTerm` ts)
|
matcherToBool (AllowedTerms ts) = (`isAllowedTerm` ts)
|
||||||
|
|
||||||
positionToTest :: Position -> (String -> String -> Bool)
|
positionToTest :: Position -> (String -> String -> Bool)
|
||||||
positionToTest StartsWith = isPrefixOf
|
positionToTest StartsWith = L.isPrefixOf
|
||||||
positionToTest EndsWith = isSuffixOf
|
positionToTest EndsWith = L.isSuffixOf
|
||||||
positionToTest Equals = (==)
|
positionToTest Equals = (==)
|
||||||
|
|
||||||
paths :: TermResults -> [String]
|
paths :: TermResults -> [String]
|
||||||
paths r = tmPath <$> trMatches r
|
paths = fmap tmPath . trMatches
|
||||||
|
|
||||||
updateMatches :: ([TermMatch] -> [TermMatch]) -> TermMatchSet -> TermMatchSet
|
updateMatches :: ([TermMatch] -> [TermMatch]) -> TermMatchSet -> TermMatchSet
|
||||||
updateMatches fm =
|
updateMatches fm =
|
||||||
|
@ -2,5 +2,5 @@ module Unused.ResultsClassifier
|
|||||||
( module X
|
( module X
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Unused.ResultsClassifier.Types as X
|
|
||||||
import Unused.ResultsClassifier.Config as X
|
import Unused.ResultsClassifier.Config as X
|
||||||
|
import Unused.ResultsClassifier.Types as X
|
||||||
|
@ -3,18 +3,18 @@ module Unused.ResultsClassifier.Config
|
|||||||
, loadAllConfigurations
|
, loadAllConfigurations
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Yaml as Y
|
import qualified Data.Bifunctor as BF
|
||||||
import qualified Data.Either as E
|
import qualified Data.Either as E
|
||||||
import qualified Data.Bifunctor as B
|
import qualified Data.Yaml as Y
|
||||||
import System.FilePath ((</>))
|
import qualified Paths_unused as Paths
|
||||||
import System.Directory (getHomeDirectory)
|
import qualified System.Directory as D
|
||||||
import Paths_unused (getDataFileName)
|
import System.FilePath ((</>))
|
||||||
import Unused.ResultsClassifier.Types (LanguageConfiguration, ParseConfigError(..))
|
import Unused.ResultsClassifier.Types (LanguageConfiguration, ParseConfigError(..))
|
||||||
import Unused.Util (safeReadFile)
|
import Unused.Util (safeReadFile)
|
||||||
|
|
||||||
loadConfig :: IO (Either String [LanguageConfiguration])
|
loadConfig :: IO (Either String [LanguageConfiguration])
|
||||||
loadConfig = do
|
loadConfig = do
|
||||||
configFileName <- getDataFileName ("data" </> "config.yml")
|
configFileName <- Paths.getDataFileName ("data" </> "config.yml")
|
||||||
|
|
||||||
either
|
either
|
||||||
(const $ Left "default config not found")
|
(const $ Left "default config not found")
|
||||||
@ -23,7 +23,7 @@ loadConfig = do
|
|||||||
|
|
||||||
loadAllConfigurations :: IO (Either [ParseConfigError] [LanguageConfiguration])
|
loadAllConfigurations :: IO (Either [ParseConfigError] [LanguageConfiguration])
|
||||||
loadAllConfigurations = do
|
loadAllConfigurations = do
|
||||||
homeDir <- getHomeDirectory
|
homeDir <- D.getHomeDirectory
|
||||||
|
|
||||||
defaultConfig <- addSourceToLeft "default config" <$> loadConfig
|
defaultConfig <- addSourceToLeft "default config" <$> loadConfig
|
||||||
localConfig <- loadConfigFromFile ".unused.yml"
|
localConfig <- loadConfigFromFile ".unused.yml"
|
||||||
@ -31,16 +31,16 @@ loadAllConfigurations = do
|
|||||||
|
|
||||||
let (lefts, rights) = E.partitionEithers [defaultConfig, localConfig, userConfig]
|
let (lefts, rights) = E.partitionEithers [defaultConfig, localConfig, userConfig]
|
||||||
|
|
||||||
if not (null lefts)
|
return $ if not (null lefts)
|
||||||
then return $ Left lefts
|
then Left lefts
|
||||||
else return $ Right $ concat rights
|
else Right $ concat rights
|
||||||
|
|
||||||
loadConfigFromFile :: String -> IO (Either ParseConfigError [LanguageConfiguration])
|
loadConfigFromFile :: String -> IO (Either ParseConfigError [LanguageConfiguration])
|
||||||
loadConfigFromFile path = do
|
loadConfigFromFile path =
|
||||||
file <- safeReadFile path
|
either
|
||||||
return $ case file of
|
(const $ Right [])
|
||||||
Left _ -> Right []
|
(addSourceToLeft path . Y.decodeEither)
|
||||||
Right body -> addSourceToLeft path $ Y.decodeEither body
|
<$> safeReadFile path
|
||||||
|
|
||||||
addSourceToLeft :: String -> Either String c -> Either ParseConfigError c
|
addSourceToLeft :: String -> Either String c -> Either ParseConfigError c
|
||||||
addSourceToLeft source = B.first (ParseConfigError source)
|
addSourceToLeft = BF.first . ParseConfigError
|
||||||
|
@ -10,13 +10,13 @@ module Unused.ResultsClassifier.Types
|
|||||||
, ParseConfigError(..)
|
, ParseConfigError(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (mzero)
|
import qualified Control.Applicative as A
|
||||||
import qualified Data.Text as T
|
import qualified Control.Monad as M
|
||||||
import qualified Data.Yaml as Y
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import Data.HashMap.Strict (keys)
|
import qualified Data.Text as T
|
||||||
import Control.Applicative (Alternative, empty)
|
import Data.Yaml (FromJSON(..), (.:), (.:?), (.!=))
|
||||||
import Data.Yaml (FromJSON(..), (.:), (.:?), (.!=))
|
import qualified Data.Yaml as Y
|
||||||
|
|
||||||
data LanguageConfiguration = LanguageConfiguration
|
data LanguageConfiguration = LanguageConfiguration
|
||||||
{ lcName :: String
|
{ lcName :: String
|
||||||
@ -50,20 +50,20 @@ instance FromJSON LanguageConfiguration where
|
|||||||
<*> o .:? "allowedTerms" .!= []
|
<*> o .:? "allowedTerms" .!= []
|
||||||
<*> o .:? "autoLowLikelihood" .!= []
|
<*> o .:? "autoLowLikelihood" .!= []
|
||||||
<*> o .:? "aliases" .!= []
|
<*> o .:? "aliases" .!= []
|
||||||
parseJSON _ = mzero
|
parseJSON _ = M.mzero
|
||||||
|
|
||||||
instance FromJSON LowLikelihoodMatch where
|
instance FromJSON LowLikelihoodMatch where
|
||||||
parseJSON (Y.Object o) = LowLikelihoodMatch
|
parseJSON (Y.Object o) = LowLikelihoodMatch
|
||||||
<$> o .: "name"
|
<$> o .: "name"
|
||||||
<*> parseMatchers o
|
<*> parseMatchers o
|
||||||
<*> o .:? "classOrModule" .!= False
|
<*> o .:? "classOrModule" .!= False
|
||||||
parseJSON _ = mzero
|
parseJSON _ = M.mzero
|
||||||
|
|
||||||
instance FromJSON TermAlias where
|
instance FromJSON TermAlias where
|
||||||
parseJSON (Y.Object o) = TermAlias
|
parseJSON (Y.Object o) = TermAlias
|
||||||
<$> o .: "from"
|
<$> o .: "from"
|
||||||
<*> o .: "to"
|
<*> o .: "to"
|
||||||
parseJSON _ = mzero
|
parseJSON _ = M.mzero
|
||||||
|
|
||||||
data MatchHandler a = MatchHandler
|
data MatchHandler a = MatchHandler
|
||||||
{ mhKeys :: [String]
|
{ mhKeys :: [String]
|
||||||
@ -112,7 +112,7 @@ validateLowLikelihoodKeys o ms =
|
|||||||
else fail $ "The following keys are unsupported: " ++ L.intercalate ", " (T.unpack <$> unsupportedKeys)
|
else fail $ "The following keys are unsupported: " ++ L.intercalate ", " (T.unpack <$> unsupportedKeys)
|
||||||
where
|
where
|
||||||
fullOverlap = null unsupportedKeys
|
fullOverlap = null unsupportedKeys
|
||||||
unsupportedKeys = keys o L.\\ lowLikelihoodMatchKeys
|
unsupportedKeys = HM.keys o L.\\ lowLikelihoodMatchKeys
|
||||||
|
|
||||||
parseMatchers :: Y.Object -> Y.Parser [Matcher]
|
parseMatchers :: Y.Object -> Y.Parser [Matcher]
|
||||||
parseMatchers o =
|
parseMatchers o =
|
||||||
@ -130,13 +130,13 @@ buildMatcherList o mh =
|
|||||||
mKey = (.:?) o
|
mKey = (.:?) o
|
||||||
|
|
||||||
positionKeysforMatcher :: Y.Object -> [String] -> [T.Text]
|
positionKeysforMatcher :: Y.Object -> [String] -> [T.Text]
|
||||||
positionKeysforMatcher o ls = L.intersect (T.pack <$> ls) $ keys o
|
positionKeysforMatcher o ls = L.intersect (T.pack <$> ls) $ HM.keys o
|
||||||
|
|
||||||
extractMatcher :: Either T.Text (a -> Matcher) -> Y.Parser (Maybe a) -> Y.Parser Matcher
|
extractMatcher :: Either T.Text (a -> Matcher) -> Y.Parser (Maybe a) -> Y.Parser Matcher
|
||||||
extractMatcher e p = either displayFailure (convertFoundObjectToMatcher p) e
|
extractMatcher e p = either displayFailure (convertFoundObjectToMatcher p) e
|
||||||
|
|
||||||
convertFoundObjectToMatcher :: (Monad m, Alternative m) => m (Maybe a) -> (a -> b) -> m b
|
convertFoundObjectToMatcher :: (Monad m, A.Alternative m) => m (Maybe a) -> (a -> b) -> m b
|
||||||
convertFoundObjectToMatcher p f = maybe empty (pure . f) =<< p
|
convertFoundObjectToMatcher p f = maybe A.empty (pure . f) =<< p
|
||||||
|
|
||||||
displayFailure :: T.Text -> Y.Parser a
|
displayFailure :: T.Text -> Y.Parser a
|
||||||
displayFailure t = fail $ "Parse error: '" ++ T.unpack t ++ "' is not a valid key in a singleOnly matcher"
|
displayFailure t = fail $ "Parse error: '" ++ T.unpack t ++ "' is not a valid key in a singleOnly matcher"
|
||||||
|
@ -6,12 +6,16 @@ module Unused.TagsSource
|
|||||||
, loadTagsFromPipe
|
, loadTagsFromPipe
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.List (isPrefixOf, nub)
|
import qualified Control.Exception as E
|
||||||
import System.Directory (findFile)
|
import qualified Data.Bifunctor as BF
|
||||||
|
import qualified Data.List as L
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified System.Directory as D
|
||||||
|
import Unused.Util (safeReadFile)
|
||||||
|
|
||||||
data TagSearchOutcome
|
data TagSearchOutcome
|
||||||
= TagsFileNotFound [String]
|
= TagsFileNotFound [String]
|
||||||
|
| IOError E.IOException
|
||||||
|
|
||||||
loadTagsFromPipe :: IO (Either TagSearchOutcome [String])
|
loadTagsFromPipe :: IO (Either TagSearchOutcome [String])
|
||||||
loadTagsFromPipe = fmap (Right . tokensFromTags) getContents
|
loadTagsFromPipe = fmap (Right . tokensFromTags) getContents
|
||||||
@ -21,20 +25,20 @@ loadTagsFromFile = fmap (fmap tokensFromTags) tagsContent
|
|||||||
|
|
||||||
tokensFromTags :: String -> [String]
|
tokensFromTags :: String -> [String]
|
||||||
tokensFromTags =
|
tokensFromTags =
|
||||||
filter validTokens . nub . tokenLocations
|
filter validTokens . L.nub . tokenLocations
|
||||||
where
|
where
|
||||||
tokenLocations = map (token . T.splitOn "\t" . T.pack) . lines
|
tokenLocations = map (token . T.splitOn "\t" . T.pack) . lines
|
||||||
token = T.unpack . head
|
token = T.unpack . head
|
||||||
|
|
||||||
validTokens :: String -> Bool
|
validTokens :: String -> Bool
|
||||||
validTokens = not . isPrefixOf "!_TAG"
|
validTokens = not . L.isPrefixOf "!_TAG"
|
||||||
|
|
||||||
tagsContent :: IO (Either TagSearchOutcome String)
|
tagsContent :: IO (Either TagSearchOutcome String)
|
||||||
tagsContent = findFile possibleTagsFileDirectories "tags" >>= eitherReadFile
|
tagsContent = D.findFile possibleTagsFileDirectories "tags" >>= eitherReadFile
|
||||||
|
|
||||||
eitherReadFile :: Maybe String -> IO (Either TagSearchOutcome String)
|
eitherReadFile :: Maybe String -> IO (Either TagSearchOutcome String)
|
||||||
eitherReadFile Nothing = return $ Left $ TagsFileNotFound possibleTagsFileDirectories
|
eitherReadFile Nothing = return $ Left $ TagsFileNotFound possibleTagsFileDirectories
|
||||||
eitherReadFile (Just path) = Right <$> readFile path
|
eitherReadFile (Just path) = BF.first IOError <$> safeReadFile path
|
||||||
|
|
||||||
possibleTagsFileDirectories :: [String]
|
possibleTagsFileDirectories :: [String]
|
||||||
possibleTagsFileDirectories = [".git", "tmp", "."]
|
possibleTagsFileDirectories = [".git", "tmp", "."]
|
||||||
|
@ -1,20 +1,18 @@
|
|||||||
module Unused.TermSearch
|
module Unused.TermSearch
|
||||||
( SearchResults(..)
|
( SearchResults(..)
|
||||||
, fromResults
|
|
||||||
, search
|
, search
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Process
|
import qualified Data.Maybe as M
|
||||||
import Data.Maybe (mapMaybe)
|
import qualified System.Process as P
|
||||||
import Unused.TermSearch.Types
|
import Unused.TermSearch.Internal (commandLineOptions, parseSearchResult)
|
||||||
import Unused.TermSearch.Internal
|
import Unused.TermSearch.Types (SearchResults(..))
|
||||||
|
|
||||||
search :: String -> IO SearchResults
|
search :: String -> IO SearchResults
|
||||||
search t = do
|
search t =
|
||||||
results <- lines <$> ag t
|
SearchResults . M.mapMaybe (parseSearchResult t) <$> (lines <$> ag t)
|
||||||
return $ SearchResults $ mapMaybe (parseSearchResult t) results
|
|
||||||
|
|
||||||
ag :: String -> IO String
|
ag :: String -> IO String
|
||||||
ag t = do
|
ag t = do
|
||||||
(_, results, _) <- readProcessWithExitCode "ag" (commandLineOptions t) ""
|
(_, results, _) <- P.readProcessWithExitCode "ag" (commandLineOptions t) ""
|
||||||
return results
|
return results
|
||||||
|
@ -5,11 +5,11 @@ module Unused.TermSearch.Internal
|
|||||||
, parseSearchResult
|
, parseSearchResult
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import qualified Data.Char as C
|
import qualified Data.Char as C
|
||||||
import Unused.Types (TermMatch(..))
|
import qualified Data.Maybe as M
|
||||||
import Unused.Util (stringToInt)
|
import qualified Data.Text as T
|
||||||
|
import Unused.Types (TermMatch(..))
|
||||||
|
import Unused.Util (stringToInt)
|
||||||
|
|
||||||
commandLineOptions :: String -> [String]
|
commandLineOptions :: String -> [String]
|
||||||
commandLineOptions t =
|
commandLineOptions t =
|
||||||
@ -20,15 +20,12 @@ commandLineOptions t =
|
|||||||
baseFlags = ["-c", "--ackmate", "--ignore-dir", "tmp/unused"]
|
baseFlags = ["-c", "--ackmate", "--ignore-dir", "tmp/unused"]
|
||||||
|
|
||||||
parseSearchResult :: String -> String -> Maybe TermMatch
|
parseSearchResult :: String -> String -> Maybe TermMatch
|
||||||
parseSearchResult term s =
|
parseSearchResult term =
|
||||||
toTermMatch $ map T.unpack $ T.splitOn ":" $ T.pack s
|
toTermMatch . map T.unpack . T.splitOn ":" . T.pack
|
||||||
where
|
where
|
||||||
toTermMatch [_, path, count] = Just $ TermMatch term path (countInt count)
|
toTermMatch [_, path, count] = Just $ TermMatch term path (countInt count)
|
||||||
toTermMatch _ = Nothing
|
toTermMatch _ = Nothing
|
||||||
countInt = fromMaybe 0 . stringToInt
|
countInt = M.fromMaybe 0 . stringToInt
|
||||||
|
|
||||||
regexSafeTerm :: String -> Bool
|
regexSafeTerm :: String -> Bool
|
||||||
regexSafeTerm =
|
regexSafeTerm = all (\c -> C.isAlphaNum c || c == '_' || c == '-')
|
||||||
all regexSafeChar
|
|
||||||
where
|
|
||||||
regexSafeChar c = C.isAlphaNum c || c == '_' || c == '-'
|
|
||||||
|
@ -2,12 +2,8 @@
|
|||||||
|
|
||||||
module Unused.TermSearch.Types
|
module Unused.TermSearch.Types
|
||||||
( SearchResults(..)
|
( SearchResults(..)
|
||||||
, fromResults
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Unused.Types (TermMatch)
|
import Unused.Types (TermMatch)
|
||||||
|
|
||||||
newtype SearchResults = SearchResults [TermMatch] deriving (Monoid)
|
newtype SearchResults = SearchResults { fromResults :: [TermMatch] } deriving (Monoid)
|
||||||
|
|
||||||
fromResults :: SearchResults -> [TermMatch]
|
|
||||||
fromResults (SearchResults a) = a
|
|
||||||
|
@ -17,17 +17,17 @@ module Unused.Types
|
|||||||
, resultAliases
|
, resultAliases
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Map.Strict as Map
|
import Data.Csv (FromRecord, ToRecord)
|
||||||
import Data.Csv
|
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import GHC.Generics
|
import qualified Data.Map.Strict as Map
|
||||||
import Unused.Regex
|
import qualified GHC.Generics as G
|
||||||
|
import qualified Unused.Regex as R
|
||||||
|
|
||||||
data TermMatch = TermMatch
|
data TermMatch = TermMatch
|
||||||
{ tmTerm :: String
|
{ tmTerm :: String
|
||||||
, tmPath :: String
|
, tmPath :: String
|
||||||
, tmOccurrences :: Int
|
, tmOccurrences :: Int
|
||||||
} deriving (Eq, Show, Generic)
|
} deriving (Eq, Show, G.Generic)
|
||||||
|
|
||||||
instance FromRecord TermMatch
|
instance FromRecord TermMatch
|
||||||
instance ToRecord TermMatch
|
instance ToRecord TermMatch
|
||||||
@ -118,13 +118,13 @@ testOccurrences ms =
|
|||||||
totalOccurrences = sum $ map tmOccurrences testMatches
|
totalOccurrences = sum $ map tmOccurrences testMatches
|
||||||
|
|
||||||
testDir :: String -> Bool
|
testDir :: String -> Bool
|
||||||
testDir = matchRegex "(spec|tests?|features)\\/"
|
testDir = R.matchRegex "(spec|tests?|features)\\/"
|
||||||
|
|
||||||
testSnakeCaseFilename :: String -> Bool
|
testSnakeCaseFilename :: String -> Bool
|
||||||
testSnakeCaseFilename = matchRegex ".*(_spec|_test)\\."
|
testSnakeCaseFilename = R.matchRegex ".*(_spec|_test)\\."
|
||||||
|
|
||||||
testCamelCaseFilename :: String -> Bool
|
testCamelCaseFilename :: String -> Bool
|
||||||
testCamelCaseFilename = matchRegex ".*(Spec|Test)\\."
|
testCamelCaseFilename = R.matchRegex ".*(Spec|Test)\\."
|
||||||
|
|
||||||
termMatchIsTest :: TermMatch -> Bool
|
termMatchIsTest :: TermMatch -> Bool
|
||||||
termMatchIsTest m =
|
termMatchIsTest m =
|
||||||
|
@ -8,13 +8,13 @@ module Unused.Util
|
|||||||
, safeReadFile
|
, safeReadFile
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Arrow ((&&&))
|
import Control.Arrow ((&&&))
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
|
import qualified Data.ByteString.Char8 as C8
|
||||||
|
import qualified Data.ByteString.Lazy.Char8 as Cl8
|
||||||
|
import qualified Data.Char as C
|
||||||
|
import Data.Function (on)
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import Data.Function
|
|
||||||
import Data.Char (digitToInt, isDigit)
|
|
||||||
import qualified Data.ByteString.Lazy.Char8 as Cl
|
|
||||||
import qualified Data.ByteString.Char8 as C
|
|
||||||
|
|
||||||
groupBy :: (Ord b) => (a -> b) -> [a] -> [(b, [a])]
|
groupBy :: (Ord b) => (a -> b) -> [a] -> [(b, [a])]
|
||||||
groupBy f = map (f . head &&& id)
|
groupBy f = map (f . head &&& id)
|
||||||
@ -27,10 +27,10 @@ safeHead _ = Nothing
|
|||||||
|
|
||||||
stringToInt :: String -> Maybe Int
|
stringToInt :: String -> Maybe Int
|
||||||
stringToInt xs
|
stringToInt xs
|
||||||
| all isDigit xs = Just $ loop 0 xs
|
| all C.isDigit xs = Just $ loop 0 xs
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
where
|
where
|
||||||
loop = foldl (\acc x -> acc * 10 + digitToInt x)
|
loop = foldl (\acc x -> acc * 10 + C.digitToInt x)
|
||||||
|
|
||||||
class Readable a where
|
class Readable a where
|
||||||
readFile' :: FilePath -> IO a
|
readFile' :: FilePath -> IO a
|
||||||
@ -38,11 +38,11 @@ class Readable a where
|
|||||||
instance Readable String where
|
instance Readable String where
|
||||||
readFile' = readFile
|
readFile' = readFile
|
||||||
|
|
||||||
instance Readable C.ByteString where
|
instance Readable C8.ByteString where
|
||||||
readFile' = C.readFile
|
readFile' = C8.readFile
|
||||||
|
|
||||||
instance Readable Cl.ByteString where
|
instance Readable Cl8.ByteString where
|
||||||
readFile' = Cl.readFile
|
readFile' = Cl8.readFile
|
||||||
|
|
||||||
safeReadFile :: Readable s => FilePath -> IO (Either E.IOException s)
|
safeReadFile :: Readable s => FilePath -> IO (Either E.IOException s)
|
||||||
safeReadFile = E.try . readFile'
|
safeReadFile = E.try . readFile'
|
||||||
|
@ -4,9 +4,9 @@ module Unused.Grouping.InternalSpec
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Unused.Types
|
|
||||||
import Unused.Grouping.Internal
|
import Unused.Grouping.Internal
|
||||||
import Unused.Grouping.Types
|
import Unused.Grouping.Types
|
||||||
|
import Unused.Types
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec spec
|
main = hspec spec
|
||||||
|
@ -4,9 +4,9 @@ module Unused.LikelihoodCalculatorSpec
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Unused.Types
|
|
||||||
import Unused.LikelihoodCalculator
|
import Unused.LikelihoodCalculator
|
||||||
import Unused.ResultsClassifier
|
import Unused.ResultsClassifier
|
||||||
|
import Unused.Types
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec spec
|
main = hspec spec
|
||||||
|
@ -1,11 +1,11 @@
|
|||||||
module Unused.ParserSpec where
|
module Unused.ParserSpec where
|
||||||
|
|
||||||
import Test.Hspec
|
|
||||||
import Unused.Types
|
|
||||||
import Unused.Parser
|
|
||||||
import Unused.TermSearch
|
|
||||||
import Unused.ResultsClassifier
|
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
|
import Test.Hspec
|
||||||
|
import Unused.Parser
|
||||||
|
import Unused.ResultsClassifier
|
||||||
|
import Unused.TermSearch
|
||||||
|
import Unused.Types
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec spec
|
main = hspec spec
|
||||||
|
@ -3,11 +3,11 @@ module Unused.ResponseFilterSpec
|
|||||||
, spec
|
, spec
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Test.Hspec
|
|
||||||
import Data.List (find)
|
import Data.List (find)
|
||||||
import Unused.Types (TermMatch(..), TermResults, resultsFromMatches)
|
import Test.Hspec
|
||||||
import Unused.ResponseFilter
|
import Unused.ResponseFilter
|
||||||
import Unused.ResultsClassifier
|
import Unused.ResultsClassifier
|
||||||
|
import Unused.Types (TermMatch(..), TermResults, resultsFromMatches)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec spec
|
main = hspec spec
|
||||||
|
@ -4,8 +4,8 @@ module Unused.TermSearch.InternalSpec
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Unused.Types
|
|
||||||
import Unused.TermSearch.Internal
|
import Unused.TermSearch.Internal
|
||||||
|
import Unused.Types
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec spec
|
main = hspec spec
|
||||||
|
Loading…
Reference in New Issue
Block a user