Continue to update Haskell style

This commit:

* Qualifies a number of imports across the codebase
* Aligns imports
This commit is contained in:
Joshua Clayton 2016-07-03 07:48:13 -04:00
parent 7618e6cb23
commit c23f123ea6
No known key found for this signature in database
GPG Key ID: 5B6558F77E9A8118
42 changed files with 338 additions and 354 deletions

View File

@ -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

View File

@ -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

View File

@ -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"

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
} }

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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"

View File

@ -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

View File

@ -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"

View File

@ -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")

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 =

View File

@ -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

View File

@ -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

View File

@ -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"

View File

@ -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", "."]

View File

@ -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

View File

@ -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 == '-'

View File

@ -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

View File

@ -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 =

View File

@ -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'

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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