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
) where
import qualified Data.Bifunctor as B
import Control.Monad.Reader
import Control.Monad.Except
import Data.Maybe (isJust)
import Data.Bool (bool)
import Unused.Grouping (CurrentGrouping(..), groupedResponses)
import Unused.Types (TermMatchSet, RemovalLikelihood(..))
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 Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)
import Control.Monad.Reader (ReaderT, MonadReader, MonadIO, runReaderT, asks, liftIO)
import qualified Data.Bifunctor as BF
import qualified Data.Bool as B
import qualified Data.Maybe as M
import Unused.Aliases (termsAndAliases)
import Unused.CLI (SearchRunner(..), loadGitContext, renderHeader, executeSearch, withRuntime)
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
@ -88,18 +88,18 @@ printResults tms = do
loadAllConfigs :: App [LanguageConfiguration]
loadAllConfigs =
either throwError return
=<< B.first InvalidConfigError <$> liftIO loadAllConfigurations
=<< BF.first InvalidConfigError <$> liftIO loadAllConfigurations
calculateTagInput :: App [String]
calculateTagInput =
either throwError return
=<< liftIO .
fmap (B.first TagError) .
bool loadTagsFromFile loadTagsFromPipe =<< readFromStdIn
fmap (BF.first TagError) .
B.bool loadTagsFromFile loadTagsFromPipe =<< readFromStdIn
withCache :: IO SearchResults -> App SearchResults
withCache f =
bool (liftIO f) (withCache' f) =<< runWithCache
B.bool (liftIO f) (withCache' f) =<< runWithCache
where
withCache' :: IO SearchResults -> App SearchResults
withCache' r =
@ -118,7 +118,7 @@ optionFilters tms = foldl (>>=) (pure tms) matchSetFilters
singleOccurrenceFilter :: AppConfig m => TermMatchSet -> m TermMatchSet
singleOccurrenceFilter tms =
bool tms (withOneOccurrence tms) <$> asks oSingleOccurrenceMatches
B.bool tms (withOneOccurrence tms) <$> asks oSingleOccurrenceMatches
likelihoodsFilter :: AppConfig m => TermMatchSet -> m TermMatchSet
likelihoodsFilter tms =
@ -148,4 +148,4 @@ numberOfCommits :: AppConfig m => m (Maybe Int)
numberOfCommits = asks oCommitCount
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
import App
import Options.Applicative
import Data.Maybe (fromMaybe)
import Unused.Grouping (CurrentGrouping(..))
import Unused.Types (RemovalLikelihood(..))
import Unused.CLI (SearchRunner(..))
import Unused.Util (stringToInt)
import App (runProgram, Options(Options))
import qualified Data.Maybe as M
import Options.Applicative
import Unused.CLI (SearchRunner(..))
import Unused.Grouping (CurrentGrouping(..))
import Unused.Types (RemovalLikelihood(..))
import Unused.Util (stringToInt)
main :: IO ()
main = runProgram =<< parseCLI
@ -80,7 +80,7 @@ parseIgnorePaths = many $ strOption $
parseGroupings :: Parser CurrentGrouping
parseGroupings =
fromMaybe GroupByDirectory <$> maybeGroup
M.fromMaybe GroupByDirectory <$> maybeGroup
where
maybeGroup = optional $ parseGrouping <$> parseGroupingOption

View File

@ -5,13 +5,14 @@ module Unused.Aliases
, termsAndAliases
) where
import Data.Tuple (swap)
import Data.List (nub, sort, find, (\\))
import Data.Text (Text)
import Data.List ((\\))
import qualified Data.List as L
import Data.Text (Text)
import qualified Data.Text as T
import Unused.ResultsClassifier.Types
import Unused.Types (TermMatch, tmTerm)
import Unused.Util (groupBy)
import qualified Data.Tuple as Tu
import Unused.ResultsClassifier.Types
import Unused.Types (TermMatch, tmTerm)
import Unused.Util (groupBy)
type Alias = (Text, Text)
type GroupedResult = (String, [TermMatch])
@ -26,7 +27,7 @@ groupedTermsAndAliases as ms =
termsAndAliases :: [TermAlias] -> [String] -> [String]
termsAndAliases [] = id
termsAndAliases as =
nub . map T.unpack . concatMap (allAliases aliases . T.pack)
L.nub . map T.unpack . concatMap (allAliases aliases . T.pack)
where
aliases = map toAlias as
allAliases :: [Alias] -> Text -> [Text]
@ -42,8 +43,8 @@ processResultsWithAliases as acc result@(term, matches) =
where
packedTerm = T.pack term
noAliasesExist = null listOfAliases
listOfAliases = nub (concatMap (`aliasesForTerm` packedTerm) as) \\ [packedTerm]
closestAlias = find ((`elem` listOfAliases) . T.pack . fst) acc
listOfAliases = L.nub (concatMap (`aliasesForTerm` packedTerm) as) \\ [packedTerm]
closestAlias = L.find ((`elem` listOfAliases) . T.pack . fst) acc
toAlias :: TermAlias -> Alias
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
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 = "%s"

View File

@ -2,6 +2,6 @@ module Unused.CLI
( module X
) where
import Unused.CLI.Search as X
import Unused.CLI.GitContext as X
import Unused.CLI.Search as X
import Unused.CLI.Util as X

View File

@ -2,16 +2,16 @@ module Unused.CLI.GitContext
( loadGitContext
) where
import Data.Map.Strict as Map (toList, fromList)
import Unused.Types (TermMatchSet)
import Unused.CLI.Util
import qualified Data.Map.Strict as Map
import Unused.CLI.ProgressIndicator (createProgressBar, progressWithIndicator)
import qualified Unused.CLI.Util as U
import qualified Unused.CLI.Views as V
import Unused.CLI.ProgressIndicator
import Unused.GitContext
import Unused.GitContext (gitContextForResults)
import Unused.Types (TermMatchSet)
loadGitContext :: Int -> TermMatchSet -> IO TermMatchSet
loadGitContext i tms = do
resetScreen
U.resetScreen
V.loadingSHAsHeader i
Map.fromList <$> progressWithIndicator (gitContextForResults i) createProgressBar listTerms
where

View File

@ -1,30 +1,30 @@
module Unused.CLI.ProgressIndicator
( ProgressIndicator
( I.ProgressIndicator
, createProgressBar
, createSpinner
, progressWithIndicator
) where
import Control.Concurrent.ParallelIO
import Unused.CLI.Util
import Unused.CLI.ProgressIndicator.Types
import Unused.CLI.ProgressIndicator.Internal
import qualified Control.Concurrent.ParallelIO as PIO
import qualified Unused.CLI.ProgressIndicator.Internal as I
import qualified Unused.CLI.ProgressIndicator.Types as I
import Unused.CLI.Util (Color(..), installChildInterruptHandler)
createProgressBar :: ProgressIndicator
createProgressBar = ProgressBar Nothing Nothing
createProgressBar :: I.ProgressIndicator
createProgressBar = I.ProgressBar Nothing Nothing
createSpinner :: ProgressIndicator
createSpinner :: I.ProgressIndicator
createSpinner =
Spinner snapshots (length snapshots) 75000 colors Nothing
I.Spinner snapshots (length snapshots) 75000 colors Nothing
where
snapshots = ["", "", "", "", "", "", "", ""]
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
printPrefix i
(tid, indicator) <- start i $ length terms
I.printPrefix i
(tid, indicator) <- I.start i $ length terms
installChildInterruptHandler tid
mconcat <$> parallel (ioOps indicator) <* stop indicator
mconcat <$> PIO.parallel (ioOps indicator) <* I.stop indicator
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
) where
import Control.Monad (forever)
import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay)
import System.ProgressBar (ProgressRef, startProgress, incProgress, msg, percentage)
import Unused.CLI.ProgressIndicator.Types
import Unused.CLI.Util
import qualified Control.Concurrent as CC
import qualified Control.Monad as M
import qualified System.ProgressBar as PB
import Unused.CLI.ProgressIndicator.Types (ProgressIndicator(..))
import Unused.CLI.Util
start :: ProgressIndicator -> Int -> IO (ThreadId, ProgressIndicator)
start :: ProgressIndicator -> Int -> IO (CC.ThreadId, ProgressIndicator)
start s@Spinner{} _ = do
tid <- forkIO $ runSpinner 0 s
tid <- CC.forkIO $ runSpinner 0 s
return (tid, s { sThreadId = Just tid })
start ProgressBar{} i = do
(ref, tid) <- buildProgressBar $ toInteger i
return (tid, ProgressBar (Just ref) (Just tid))
stop :: ProgressIndicator -> IO ()
stop ProgressBar{ pbThreadId = Just tid } = killThread tid
stop Spinner{ sThreadId = Just tid } = killThread tid
stop ProgressBar{ pbThreadId = Just tid } = CC.killThread tid
stop Spinner{ sThreadId = Just tid } = CC.killThread tid
stop _ = return ()
increment :: ProgressIndicator -> IO ()
increment ProgressBar{ pbProgressRef = Just ref } = incProgress ref 1
increment ProgressBar{ pbProgressRef = Just ref } = PB.incProgress ref 1
increment _ = return ()
printPrefix :: ProgressIndicator -> IO ()
@ -33,11 +33,11 @@ printPrefix ProgressBar{} = putStr "\n\n"
printPrefix Spinner{} = putStr " "
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]
putStr currentSnapshot
cursorBackward 1
threadDelay delay
CC.threadDelay delay
runSpinner (i + 1) s
where
currentSnapshot = snapshots !! (i `mod` snapshotLength)
@ -45,9 +45,9 @@ runSpinner i s@Spinner{ sDelay = delay, sSnapshots = snapshots, sColors = colors
snapshotLength = length'
runSpinner _ _ = return ()
buildProgressBar :: Integer -> IO (ProgressRef, ThreadId)
buildProgressBar :: Integer -> IO (PB.ProgressRef, CC.ThreadId)
buildProgressBar =
startProgress (msg message) percentage progressBarWidth
PB.startProgress (PB.msg message) PB.percentage progressBarWidth
where
message = "Working"
progressBarWidth = 60

View File

@ -2,19 +2,19 @@ module Unused.CLI.ProgressIndicator.Types
( ProgressIndicator(..)
) where
import Control.Concurrent (ThreadId)
import System.ProgressBar (ProgressRef)
import System.Console.ANSI (Color)
import qualified Control.Concurrent as CC
import qualified System.Console.ANSI as ANSI
import qualified System.ProgressBar as PB
data ProgressIndicator
= Spinner
{ sSnapshots :: [String]
, sLength :: Int
, sDelay :: Int
, sColors :: [Color]
, sThreadId :: Maybe ThreadId
, sColors :: [ANSI.Color]
, sThreadId :: Maybe CC.ThreadId
}
| ProgressBar
{ pbProgressRef :: Maybe ProgressRef
, pbThreadId :: Maybe ThreadId
{ pbProgressRef :: Maybe PB.ProgressRef
, pbThreadId :: Maybe CC.ThreadId
}

View File

@ -4,23 +4,23 @@ module Unused.CLI.Search
, executeSearch
) where
import Unused.TermSearch (SearchResults, search)
import Unused.CLI.Util
import qualified Unused.CLI.ProgressIndicator as I
import qualified Unused.CLI.Util as U
import qualified Unused.CLI.Views as V
import Unused.CLI.ProgressIndicator
import qualified Unused.TermSearch as TS
data SearchRunner = SearchWithProgress | SearchWithoutProgress
renderHeader :: [String] -> IO ()
renderHeader terms = do
resetScreen
U.resetScreen
V.analysisHeader terms
executeSearch :: SearchRunner -> [String] -> IO SearchResults
executeSearch :: SearchRunner -> [String] -> IO TS.SearchResults
executeSearch runner terms = do
renderHeader terms
runSearch runner terms <* resetScreen
runSearch runner terms <* U.resetScreen
runSearch :: SearchRunner -> [String] -> IO SearchResults
runSearch SearchWithProgress = progressWithIndicator search createProgressBar
runSearch SearchWithoutProgress = progressWithIndicator search createSpinner
runSearch :: SearchRunner -> [String] -> IO TS.SearchResults
runSearch SearchWithProgress = I.progressWithIndicator TS.search I.createProgressBar
runSearch SearchWithoutProgress = I.progressWithIndicator TS.search I.createSpinner

View File

@ -5,19 +5,19 @@ module Unused.CLI.Util
, module System.Console.ANSI
) where
import Control.Concurrent.ParallelIO
import Control.Monad (void)
import System.Console.ANSI
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
import Control.Exception (throwTo)
import System.Posix.Signals (Handler(Catch), installHandler, keyboardSignal)
import Control.Concurrent (ThreadId, myThreadId, killThread)
import System.Exit (ExitCode(ExitFailure))
import qualified Control.Concurrent as CC
import qualified Control.Concurrent.ParallelIO as PIO
import qualified Control.Exception as E
import qualified Control.Monad as M
import System.Console.ANSI
import qualified System.Exit as Ex
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
import qualified System.Posix.Signals as S
withRuntime :: IO a -> IO a
withRuntime a = do
hSetBuffering stdout NoBuffering
withInterruptHandler $ withoutCursor a <* stopGlobalPool
withInterruptHandler $ withoutCursor a <* PIO.stopGlobalPool
resetScreen :: IO ()
resetScreen = do
@ -31,30 +31,30 @@ withoutCursor body = do
withInterruptHandler :: IO a -> IO a
withInterruptHandler body = do
tid <- myThreadId
void $ installHandler keyboardSignal (Catch (handleInterrupt tid)) Nothing
tid <- CC.myThreadId
M.void $ S.installHandler S.keyboardSignal (S.Catch (handleInterrupt tid)) Nothing
body
installChildInterruptHandler :: ThreadId -> IO ()
installChildInterruptHandler :: CC.ThreadId -> IO ()
installChildInterruptHandler tid = do
currentThread <- myThreadId
void $ installHandler keyboardSignal (Catch (handleChildInterrupt currentThread tid)) Nothing
currentThread <- CC.myThreadId
M.void $ S.installHandler S.keyboardSignal (S.Catch (handleChildInterrupt currentThread tid)) Nothing
handleInterrupt :: ThreadId -> IO ()
handleInterrupt :: CC.ThreadId -> IO ()
handleInterrupt tid = do
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
killThread childTid
CC.killThread childTid
resetScreenState
throwTo parentTid $ ExitFailure interruptExitCode
E.throwTo parentTid $ Ex.ExitFailure interruptExitCode
handleInterrupt parentTid
interruptExitCode :: Int
interruptExitCode =
signalToInt $ 128 + keyboardSignal
signalToInt $ 128 + S.keyboardSignal
where
signalToInt s = read $ show s :: Int

View File

@ -2,10 +2,10 @@ module Unused.CLI.Views
( module X
) where
import Unused.CLI.Views.NoResultsFound 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.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

View File

@ -2,13 +2,13 @@ module Unused.CLI.Views.FingerprintError
( fingerprintError
) where
import Data.List (intercalate)
import Unused.Cache.DirectoryFingerprint
import Unused.CLI.Views.Error
import qualified Data.List as L
import qualified Unused.CLI.Views.Error as V
import Unused.Cache.DirectoryFingerprint (FingerprintOutcome(..))
fingerprintError :: FingerprintOutcome -> IO ()
fingerprintError e = do
errorHeader "There was a problem generating a cache fingerprint:"
V.errorHeader "There was a problem generating a cache fingerprint:"
printOutcomeMessage e
@ -16,4 +16,4 @@ printOutcomeMessage :: FingerprintOutcome -> IO ()
printOutcomeMessage (MD5ExecutableNotFound execs) =
putStrLn $
"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
) where
import Unused.CLI.Util
import Unused.CLI.Views.Error
import Unused.ResultsClassifier (ParseConfigError(..))
import Unused.CLI.Util
import qualified Unused.CLI.Views.Error as V
import Unused.ResultsClassifier (ParseConfigError(..))
invalidConfigError :: [ParseConfigError] -> IO ()
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

View File

@ -2,13 +2,13 @@ module Unused.CLI.Views.MissingTagsFileError
( missingTagsFileError
) where
import Unused.TagsSource
import Unused.CLI.Util
import Unused.CLI.Views.Error
import Unused.CLI.Util
import qualified Unused.CLI.Views.Error as V
import Unused.TagsSource (TagSearchOutcome(..))
missingTagsFileError :: TagSearchOutcome -> IO ()
missingTagsFileError e = do
errorHeader "There was a problem finding a tags file."
V.errorHeader "There was a problem finding a tags file."
printOutcomeMessage e
putStr "\n"
@ -40,3 +40,6 @@ printOutcomeMessage :: TagSearchOutcome -> IO ()
printOutcomeMessage (TagsFileNotFound directoriesSearched) = do
putStrLn "Looked for a 'tags' file in the following directories:\n"
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
) where
import Control.Arrow ((&&&))
import Control.Arrow ((&&&))
import qualified Data.Map.Strict as Map
import Unused.Types
import Unused.Grouping (Grouping(..), GroupedTerms)
import Unused.CLI.Views.SearchResult.ColumnFormatter
import Unused.CLI.Util
import Unused.CLI.Views.SearchResult.Types
import Unused.CLI.Util
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.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 format terms = do

View File

@ -3,7 +3,7 @@ module Unused.CLI.Views.SearchResult.ColumnFormatter
, buildColumnFormatter
) where
import Text.Printf
import Text.Printf (printf)
import Unused.Types (TermResults(..), TermMatch(..), totalFileCount, totalOccurrenceCount)
data ColumnFormat = ColumnFormat

View File

@ -2,16 +2,17 @@ module Unused.CLI.Views.SearchResult.ListResult
( printList
) where
import Control.Monad (forM_, void, when)
import Data.List (intercalate, (\\))
import Unused.CLI.Util
import Unused.Types
import Unused.CLI.Views.SearchResult.Internal
import Unused.CLI.Views.SearchResult.Types
import qualified Control.Monad as M
import Data.List ((\\))
import qualified Data.List as L
import Unused.CLI.Util
import qualified Unused.CLI.Views.SearchResult.Internal as SR
import qualified Unused.CLI.Views.SearchResult.Types as SR
import Unused.Types (TermResults(..), GitContext(..), GitCommit(..), TermMatch(..), totalFileCount, totalOccurrenceCount)
printList :: TermResults -> [TermMatch] -> ResultsPrinter ()
printList r ms = liftIO $
forM_ ms $ \m -> do
printList :: TermResults -> [TermMatch] -> SR.ResultsPrinter ()
printList r ms = SR.liftIO $
M.forM_ ms $ \m -> do
printTermAndOccurrences r
printAliases r
printFilePath m
@ -21,7 +22,7 @@ printList r ms = liftIO $
printTermAndOccurrences :: TermResults -> IO ()
printTermAndOccurrences r = do
setSGR [SetColor Foreground Dull (termColor r)]
setSGR [SetColor Foreground Dull (SR.termColor r)]
setSGR [SetConsoleIntensity BoldIntensity]
putStr " "
setSGR [SetUnderlining SingleUnderline]
@ -39,9 +40,9 @@ printTermAndOccurrences r = do
putStr "\n"
printAliases :: TermResults -> IO ()
printAliases r = when anyAliases $ do
printAliases r = M.when anyAliases $ do
printHeader " Aliases: "
putStrLn $ intercalate ", " remainingAliases
putStrLn $ L.intercalate ", " remainingAliases
where
anyAliases = not $ null remainingAliases
remainingAliases = trTerms r \\ [trTerm r]
@ -56,17 +57,17 @@ printFilePath m = do
printSHAs :: TermResults -> IO ()
printSHAs r =
case mshas of
Nothing -> void $ putStr ""
Nothing -> M.void $ putStr ""
Just shas' -> do
printHeader " Recent SHAs: "
putStrLn $ intercalate ", " shas'
putStrLn $ L.intercalate ", " shas'
where
mshas = (map gcSha . gcCommits) <$> trGitContext r
printRemovalReason :: TermResults -> IO ()
printRemovalReason r = do
printHeader " Reason: "
putStrLn $ removalReason r
putStrLn $ SR.removalReason r
printHeader :: String -> IO ()
printHeader v = do

View File

@ -2,21 +2,21 @@ module Unused.CLI.Views.SearchResult.TableResult
( printTable
) where
import Control.Monad (forM_)
import Unused.Types
import Unused.CLI.Util
import Unused.CLI.Views.SearchResult.Internal
import Unused.CLI.Views.SearchResult.Types
import qualified Control.Monad as M
import Unused.CLI.Util
import qualified Unused.CLI.Views.SearchResult.Internal as SR
import qualified Unused.CLI.Views.SearchResult.Types as SR
import Unused.Types (TermResults, TermMatch(..), totalFileCount, totalOccurrenceCount)
printTable :: TermResults -> [TermMatch] -> ResultsPrinter ()
printTable :: TermResults -> [TermMatch] -> SR.ResultsPrinter ()
printTable r ms = do
cf <- columnFormat
let printTerm = cfPrintTerm cf
let printPath = cfPrintPath cf
let printNumber = cfPrintNumber cf
cf <- SR.columnFormat
let printTerm = SR.cfPrintTerm cf
let printPath = SR.cfPrintPath cf
let printNumber = SR.cfPrintNumber cf
liftIO $ forM_ ms $ \m -> do
setSGR [SetColor Foreground Dull (termColor r)]
SR.liftIO $ M.forM_ ms $ \m -> do
setSGR [SetColor Foreground Dull (SR.termColor r)]
setSGR [SetConsoleIntensity NormalIntensity]
putStr $ " " ++ printTerm (tmTerm m)
setSGR [Reset]
@ -31,5 +31,5 @@ printTable r ms = do
putStr $ " " ++ printPath (tmPath m)
setSGR [Reset]
putStr $ " " ++ removalReason r
putStr $ " " ++ SR.removalReason r
putStr "\n"

View File

@ -6,12 +6,11 @@ module Unused.CLI.Views.SearchResult.Types
, columnFormat
, outputFormat
, R.runReaderT
, M.liftIO
, R.liftIO
) where
import qualified Control.Monad.Trans.Reader as R
import qualified Control.Monad.IO.Class as M
import Unused.CLI.Views.SearchResult.ColumnFormatter
import qualified Control.Monad.Reader as R
import Unused.CLI.Views.SearchResult.ColumnFormatter
data ResultsOptions = ResultsOptions
{ roColumnFormat :: ColumnFormat

View File

@ -3,14 +3,13 @@ module Unused.Cache
, cached
) where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader
import Data.Csv (FromRecord, ToRecord, HasHeader(..), encode, decode)
import Data.Vector (toList)
import System.Directory (createDirectoryIfMissing)
import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
import qualified Data.ByteString.Lazy as BS
import Unused.Cache.DirectoryFingerprint
import Unused.Util (safeReadFile)
import Data.Csv (FromRecord, ToRecord, HasHeader(..), encode, decode)
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
type Cache = ReaderT CacheFileName IO
@ -24,7 +23,7 @@ cached cachePrefix f =
writeCache :: ToRecord a => [a] -> Cache [a]
writeCache [] = return []
writeCache contents = do
liftIO $ createDirectoryIfMissing True cacheDirectory
liftIO $ D.createDirectoryIfMissing True cacheDirectory
(CacheFileName fileName) <- ask
liftIO $ BS.writeFile fileName $ encode contents
return contents
@ -36,16 +35,16 @@ readCache = do
either
(const Nothing)
(processCsv . decode NoHeader)
<$> (liftIO $ safeReadFile fileName)
<$> liftIO (safeReadFile fileName)
where
processCsv = either (const Nothing) (Just . toList)
processCsv = either (const Nothing) (Just . V.toList)
cacheFileName :: String -> IO (Either FingerprintOutcome CacheFileName)
cacheFileName context = do
putStrLn "\n\nCalculating cache fingerprint... "
fmap toFileName <$> sha
fmap (CacheFileName . toFileName) <$> sha
where
toFileName s = CacheFileName $ cacheDirectory ++ "/" ++ context ++ "-" ++ s ++ ".csv"
toFileName s = cacheDirectory ++ "/" ++ context ++ "-" ++ s ++ ".csv"
cacheDirectory :: String
cacheDirectory = "tmp/unused"

View File

@ -3,16 +3,17 @@ module Unused.Cache.DirectoryFingerprint
, sha
) where
import System.Process
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader
import qualified System.Directory as D
import Control.Monad.Reader (ReaderT, runReaderT, asks, liftIO)
import qualified Data.Char as C
import Data.Maybe (fromMaybe)
import Unused.Cache.FindArgsFromIgnoredPaths
import Unused.Util (safeHead, safeReadFile)
import qualified Data.Maybe as M
import qualified System.Directory as D
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
= MD5ExecutableNotFound [String]
@ -22,25 +23,25 @@ sha = do
md5Executable' <- md5Executable
case md5Executable' of
Just exec ->
Right . getSha <$> runReaderT (fileList >>= sortInput >>= md5Result) exec
Right . getSha <$> runReaderT (fileList >>= sortInput >>= md5Result) (MD5ExecutablePath exec)
Nothing -> return $ Left $ MD5ExecutableNotFound supportedMD5Executables
where
getSha = takeWhile C.isAlphaNum . fromMaybe "" . safeHead . lines
getSha = takeWhile C.isAlphaNum . M.fromMaybe "" . safeHead . lines
fileList :: MD5Config String
fileList = do
filterNamePathArgs <- liftIO $ findArgs <$> ignoredPaths
md5exec <- ask
md5exec <- asks toMD5String
let args = [".", "-type", "f", "-not", "-path", "*/.git/*"] ++ filterNamePathArgs ++ ["-exec", md5exec, "{}", "+"]
liftIO $ readProcess "find" args ""
liftIO $ P.readProcess "find" args ""
sortInput :: String -> MD5Config String
sortInput = liftIO . readProcess "sort" ["-k", "2"]
sortInput = liftIO . P.readProcess "sort" ["-k", "2"]
md5Result :: String -> MD5Config String
md5Result r = do
md5exec <- ask
liftIO $ readProcess md5exec [] r
md5exec <- asks toMD5String
liftIO $ P.readProcess md5exec [] r
ignoredPaths :: IO [String]
ignoredPaths = either (const []) id <$> (fmap lines <$> safeReadFile ".gitignore")

View File

@ -2,9 +2,9 @@ module Unused.Cache.FindArgsFromIgnoredPaths
( findArgs
) where
import Data.Char (isAlphaNum)
import Data.List (isSuffixOf)
import System.FilePath
import qualified Data.Char as C
import qualified Data.List as L
import qualified System.FilePath as FP
findArgs :: [String] -> [String]
findArgs = concatMap ignoreToFindArgs . validIgnoreOptions
@ -28,14 +28,14 @@ ignoreToFindArgs = toExclusions . wildcardPrefix
wildcardSuffix :: String -> String
wildcardSuffix s
| isWildcardFilename s = s
| "/" `isSuffixOf` s = s ++ "*"
| "/" `L.isSuffixOf` s = s ++ "*"
| otherwise = s ++ "/*"
isWildcardFilename :: String -> Bool
isWildcardFilename = elem '*' . takeFileName
isWildcardFilename = elem '*' . FP.takeFileName
isMissingFilename :: String -> Bool
isMissingFilename s = takeFileName s == ""
isMissingFilename = null . FP.takeFileName
validIgnoreOptions :: [String] -> [String]
validIgnoreOptions =
@ -44,4 +44,4 @@ validIgnoreOptions =
isPath "" = False
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
) where
import qualified Data.Text as T
import qualified Data.List as L
import System.Process
import Unused.Types (TermResults(trGitContext), GitContext(..), GitCommit(..), RemovalLikelihood(High), removalLikelihood, resultAliases)
import qualified Data.Text as T
import qualified System.Process as P
import Unused.Types (TermResults(trGitContext), GitContext(..), GitCommit(..), RemovalLikelihood(High), removalLikelihood, resultAliases)
newtype GitOutput = GitOutput { unOutput :: String }
@ -31,5 +31,5 @@ logToGitContext =
gitLogSearchFor :: Int -> [String] -> IO GitOutput
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

View File

@ -5,12 +5,12 @@ module Unused.Grouping
, groupedResponses
) where
import qualified Data.List as L
import qualified Data.Map.Strict as Map
import Data.List (sort, nub)
import Unused.Types
import Unused.ResponseFilter (updateMatches)
import Unused.Grouping.Types
import Unused.Grouping.Internal
import Unused.Grouping.Internal (groupFilter)
import Unused.Grouping.Types (Grouping(..), CurrentGrouping(..), GroupFilter, GroupedTerms)
import Unused.ResponseFilter (updateMatches)
import Unused.Types (TermMatchSet, TermResults(trMatches))
groupedResponses :: CurrentGrouping -> TermMatchSet -> [GroupedTerms]
groupedResponses g tms =
@ -21,12 +21,10 @@ groupedResponses g tms =
groupedMatchSetSubsets :: GroupFilter -> Grouping -> TermMatchSet -> TermMatchSet
groupedMatchSetSubsets f tms =
updateMatches newMatches
where
newMatches = filter ((== tms) . f)
updateMatches $ filter ((== tms) . f)
allGroupings :: GroupFilter -> TermMatchSet -> [Grouping]
allGroupings f =
uniqueValues . Map.map (fmap f . trMatches)
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
) where
import Unused.Grouping.Types
import System.FilePath (takeDirectory, splitDirectories)
import Unused.Types (tmPath, tmTerm)
import Data.List (intercalate)
import qualified Data.List as L
import qualified System.FilePath as FP
import Unused.Grouping.Types (CurrentGrouping(..), Grouping(..), GroupFilter)
import qualified Unused.Types as T
groupFilter :: CurrentGrouping -> GroupFilter
groupFilter GroupByDirectory = fileNameGrouping
groupFilter GroupByTerm = termGrouping
groupFilter GroupByFile = fileGrouping
groupFilter GroupByDirectory = ByDirectory . shortenedDirectory . T.tmPath
groupFilter GroupByTerm = ByTerm . T.tmTerm
groupFilter GroupByFile = ByFile . T.tmPath
groupFilter NoGroup = const NoGrouping
fileNameGrouping :: GroupFilter
fileNameGrouping = ByDirectory . shortenedDirectory . tmPath
termGrouping :: GroupFilter
termGrouping = ByTerm . tmTerm
fileGrouping :: GroupFilter
fileGrouping = ByFile . tmPath
shortenedDirectory :: String -> String
shortenedDirectory =
intercalate "/" . take 2 . splitDirectories . takeDirectory
L.intercalate "/" . take 2 . FP.splitDirectories . FP.takeDirectory

View File

@ -3,38 +3,34 @@ module Unused.LikelihoodCalculator
, LanguageConfiguration
) where
import Data.Maybe (isJust)
import Data.List (find, intercalate)
import Unused.ResultsClassifier
import Unused.Types
import Unused.ResponseFilter (autoLowLikelihood)
import qualified Data.List as L
import qualified Data.Maybe as M
import qualified Unused.ResponseFilter as RF
import Unused.ResultsClassifier (LanguageConfiguration(..), LowLikelihoodMatch(..))
import Unused.Types (TermResults(..), Occurrences(..), RemovalLikelihood(..), Removal(..), totalOccurrenceCount)
calculateLikelihood :: [LanguageConfiguration] -> TermResults -> TermResults
calculateLikelihood lcs r =
r { trRemoval = uncurry Removal newLikelihood }
where
baseScore = totalOccurrenceCount r
totalScore = baseScore
newLikelihood
| isJust firstAutoLowLikelihood = (Low, autoLowLikelihoodMessage)
| M.isJust firstAutoLowLikelihood = (Low, autoLowLikelihoodMessage)
| 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")
| totalScore < 2 = (High, "used once")
| totalScore < 6 = (Medium, "used semi-frequently")
| totalScore >= 6 = (Low, "used frequently")
| otherwise = (Unknown, "could not determine likelihood")
firstAutoLowLikelihood = find (`autoLowLikelihood` r) lcs
autoLowLikelihoodMessage =
case firstAutoLowLikelihood of
Nothing -> ""
Just lang -> languageConfirmationMessage lang
totalScore = totalOccurrenceCount r
firstAutoLowLikelihood = L.find (`RF.autoLowLikelihood` r) lcs
autoLowLikelihoodMessage = maybe "" languageConfirmationMessage firstAutoLowLikelihood
languageConfirmationMessage :: LanguageConfiguration -> String
languageConfirmationMessage lc =
langFramework ++ ": allowed term or " ++ lowLikelihoodNames
where
langFramework = lcName lc
lowLikelihoodNames = intercalate ", " $ map smName $ lcAutoLowLikelihood lc
lowLikelihoodNames = L.intercalate ", " $ map smName $ lcAutoLowLikelihood lc
singleNonTestUsage :: TermResults -> Bool
singleNonTestUsage = (1 ==) . oOccurrences . trAppOccurrences

View File

@ -2,19 +2,19 @@ module Unused.Parser
( parseResults
) 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 Data.List (intercalate, sort, nub)
import Unused.TermSearch (SearchResults, fromResults)
import Unused.Types (TermMatchSet, TermMatch, resultsFromMatches, tmTerm)
import Unused.LikelihoodCalculator
import Unused.ResultsClassifier.Types
import Unused.Aliases
import Unused.Aliases (groupedTermsAndAliases)
import Unused.LikelihoodCalculator (calculateLikelihood)
import Unused.ResultsClassifier.Types (LanguageConfiguration(..), TermAlias)
import Unused.TermSearch (SearchResults, fromResults)
import Unused.Types (TermMatchSet, TermMatch, resultsFromMatches, tmTerm)
parseResults :: [LanguageConfiguration] -> SearchResults -> TermMatchSet
parseResults lcs =
Map.fromList . map (second $ calculateLikelihood lcs . resultsFromMatches) . groupResults aliases . fromResults
Map.fromList . map (BF.second $ calculateLikelihood lcs . resultsFromMatches) . groupResults aliases . fromResults
where
aliases = concatMap lcTermAliases lcs
@ -22,5 +22,5 @@ groupResults :: [TermAlias] -> [TermMatch] -> [(String, [TermMatch])]
groupResults aliases ms =
map (toKey &&& id) groupedMatches
where
toKey = intercalate "|" . nub . sort . map tmTerm
toKey = L.intercalate "|" . L.nub . L.sort . map tmTerm
groupedMatches = groupedTermsAndAliases aliases ms

View File

@ -8,11 +8,11 @@ module Unused.ResponseFilter
, updateMatches
) where
import qualified Data.Map.Strict as Map
import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
import qualified Data.Char as C
import Unused.Types
import Unused.ResultsClassifier
import qualified Data.List as L
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 = Map.filterWithKey (const oneOccurence)
@ -29,7 +29,7 @@ ignoringPaths xs =
updateMatches newMatches
where
newMatches = filter (not . matchesPath . tmPath)
matchesPath p = any (`isInfixOf` p) xs
matchesPath p = any (`L.isInfixOf` p) xs
includesLikelihood :: [RemovalLikelihood] -> TermResults -> Bool
includesLikelihood l = (`elem` l) . rLikelihood . trRemoval
@ -65,12 +65,12 @@ matcherToBool (AppOccurrences i) = (== i) . appOccurrenceCount
matcherToBool (AllowedTerms ts) = (`isAllowedTerm` ts)
positionToTest :: Position -> (String -> String -> Bool)
positionToTest StartsWith = isPrefixOf
positionToTest EndsWith = isSuffixOf
positionToTest StartsWith = L.isPrefixOf
positionToTest EndsWith = L.isSuffixOf
positionToTest Equals = (==)
paths :: TermResults -> [String]
paths r = tmPath <$> trMatches r
paths = fmap tmPath . trMatches
updateMatches :: ([TermMatch] -> [TermMatch]) -> TermMatchSet -> TermMatchSet
updateMatches fm =

View File

@ -2,5 +2,5 @@ module Unused.ResultsClassifier
( module X
) where
import Unused.ResultsClassifier.Types 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
) where
import qualified Data.Yaml as Y
import qualified Data.Bifunctor as BF
import qualified Data.Either as E
import qualified Data.Bifunctor as B
import System.FilePath ((</>))
import System.Directory (getHomeDirectory)
import Paths_unused (getDataFileName)
import Unused.ResultsClassifier.Types (LanguageConfiguration, ParseConfigError(..))
import Unused.Util (safeReadFile)
import qualified Data.Yaml as Y
import qualified Paths_unused as Paths
import qualified System.Directory as D
import System.FilePath ((</>))
import Unused.ResultsClassifier.Types (LanguageConfiguration, ParseConfigError(..))
import Unused.Util (safeReadFile)
loadConfig :: IO (Either String [LanguageConfiguration])
loadConfig = do
configFileName <- getDataFileName ("data" </> "config.yml")
configFileName <- Paths.getDataFileName ("data" </> "config.yml")
either
(const $ Left "default config not found")
@ -23,7 +23,7 @@ loadConfig = do
loadAllConfigurations :: IO (Either [ParseConfigError] [LanguageConfiguration])
loadAllConfigurations = do
homeDir <- getHomeDirectory
homeDir <- D.getHomeDirectory
defaultConfig <- addSourceToLeft "default config" <$> loadConfig
localConfig <- loadConfigFromFile ".unused.yml"
@ -31,16 +31,16 @@ loadAllConfigurations = do
let (lefts, rights) = E.partitionEithers [defaultConfig, localConfig, userConfig]
if not (null lefts)
then return $ Left lefts
else return $ Right $ concat rights
return $ if not (null lefts)
then Left lefts
else Right $ concat rights
loadConfigFromFile :: String -> IO (Either ParseConfigError [LanguageConfiguration])
loadConfigFromFile path = do
file <- safeReadFile path
return $ case file of
Left _ -> Right []
Right body -> addSourceToLeft path $ Y.decodeEither body
loadConfigFromFile path =
either
(const $ Right [])
(addSourceToLeft path . Y.decodeEither)
<$> safeReadFile path
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(..)
) where
import Control.Monad (mzero)
import qualified Data.Text as T
import qualified Data.Yaml as Y
import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Data.HashMap.Strict as HM
import qualified Data.List as L
import Data.HashMap.Strict (keys)
import Control.Applicative (Alternative, empty)
import Data.Yaml (FromJSON(..), (.:), (.:?), (.!=))
import qualified Data.Text as T
import Data.Yaml (FromJSON(..), (.:), (.:?), (.!=))
import qualified Data.Yaml as Y
data LanguageConfiguration = LanguageConfiguration
{ lcName :: String
@ -50,20 +50,20 @@ instance FromJSON LanguageConfiguration where
<*> o .:? "allowedTerms" .!= []
<*> o .:? "autoLowLikelihood" .!= []
<*> o .:? "aliases" .!= []
parseJSON _ = mzero
parseJSON _ = M.mzero
instance FromJSON LowLikelihoodMatch where
parseJSON (Y.Object o) = LowLikelihoodMatch
<$> o .: "name"
<*> parseMatchers o
<*> o .:? "classOrModule" .!= False
parseJSON _ = mzero
parseJSON _ = M.mzero
instance FromJSON TermAlias where
parseJSON (Y.Object o) = TermAlias
<$> o .: "from"
<*> o .: "to"
parseJSON _ = mzero
parseJSON _ = M.mzero
data MatchHandler a = MatchHandler
{ mhKeys :: [String]
@ -112,7 +112,7 @@ validateLowLikelihoodKeys o ms =
else fail $ "The following keys are unsupported: " ++ L.intercalate ", " (T.unpack <$> unsupportedKeys)
where
fullOverlap = null unsupportedKeys
unsupportedKeys = keys o L.\\ lowLikelihoodMatchKeys
unsupportedKeys = HM.keys o L.\\ lowLikelihoodMatchKeys
parseMatchers :: Y.Object -> Y.Parser [Matcher]
parseMatchers o =
@ -130,13 +130,13 @@ buildMatcherList o mh =
mKey = (.:?) o
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 e p = either displayFailure (convertFoundObjectToMatcher p) e
convertFoundObjectToMatcher :: (Monad m, Alternative m) => m (Maybe a) -> (a -> b) -> m b
convertFoundObjectToMatcher p f = maybe empty (pure . f) =<< p
convertFoundObjectToMatcher :: (Monad m, A.Alternative m) => m (Maybe a) -> (a -> b) -> m b
convertFoundObjectToMatcher p f = maybe A.empty (pure . f) =<< p
displayFailure :: T.Text -> Y.Parser a
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
) where
import Data.List (isPrefixOf, nub)
import System.Directory (findFile)
import qualified Control.Exception as E
import qualified Data.Bifunctor as BF
import qualified Data.List as L
import qualified Data.Text as T
import qualified System.Directory as D
import Unused.Util (safeReadFile)
data TagSearchOutcome
= TagsFileNotFound [String]
| IOError E.IOException
loadTagsFromPipe :: IO (Either TagSearchOutcome [String])
loadTagsFromPipe = fmap (Right . tokensFromTags) getContents
@ -21,20 +25,20 @@ loadTagsFromFile = fmap (fmap tokensFromTags) tagsContent
tokensFromTags :: String -> [String]
tokensFromTags =
filter validTokens . nub . tokenLocations
filter validTokens . L.nub . tokenLocations
where
tokenLocations = map (token . T.splitOn "\t" . T.pack) . lines
token = T.unpack . head
validTokens :: String -> Bool
validTokens = not . isPrefixOf "!_TAG"
validTokens = not . L.isPrefixOf "!_TAG"
tagsContent :: IO (Either TagSearchOutcome String)
tagsContent = findFile possibleTagsFileDirectories "tags" >>= eitherReadFile
tagsContent = D.findFile possibleTagsFileDirectories "tags" >>= eitherReadFile
eitherReadFile :: Maybe String -> IO (Either TagSearchOutcome String)
eitherReadFile Nothing = return $ Left $ TagsFileNotFound possibleTagsFileDirectories
eitherReadFile (Just path) = Right <$> readFile path
eitherReadFile (Just path) = BF.first IOError <$> safeReadFile path
possibleTagsFileDirectories :: [String]
possibleTagsFileDirectories = [".git", "tmp", "."]

View File

@ -1,20 +1,18 @@
module Unused.TermSearch
( SearchResults(..)
, fromResults
, search
) where
import System.Process
import Data.Maybe (mapMaybe)
import Unused.TermSearch.Types
import Unused.TermSearch.Internal
import qualified Data.Maybe as M
import qualified System.Process as P
import Unused.TermSearch.Internal (commandLineOptions, parseSearchResult)
import Unused.TermSearch.Types (SearchResults(..))
search :: String -> IO SearchResults
search t = do
results <- lines <$> ag t
return $ SearchResults $ mapMaybe (parseSearchResult t) results
search t =
SearchResults . M.mapMaybe (parseSearchResult t) <$> (lines <$> ag t)
ag :: String -> IO String
ag t = do
(_, results, _) <- readProcessWithExitCode "ag" (commandLineOptions t) ""
(_, results, _) <- P.readProcessWithExitCode "ag" (commandLineOptions t) ""
return results

View File

@ -5,11 +5,11 @@ module Unused.TermSearch.Internal
, parseSearchResult
) where
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Char as C
import Unused.Types (TermMatch(..))
import Unused.Util (stringToInt)
import qualified Data.Maybe as M
import qualified Data.Text as T
import Unused.Types (TermMatch(..))
import Unused.Util (stringToInt)
commandLineOptions :: String -> [String]
commandLineOptions t =
@ -20,15 +20,12 @@ commandLineOptions t =
baseFlags = ["-c", "--ackmate", "--ignore-dir", "tmp/unused"]
parseSearchResult :: String -> String -> Maybe TermMatch
parseSearchResult term s =
toTermMatch $ map T.unpack $ T.splitOn ":" $ T.pack s
parseSearchResult term =
toTermMatch . map T.unpack . T.splitOn ":" . T.pack
where
toTermMatch [_, path, count] = Just $ TermMatch term path (countInt count)
toTermMatch _ = Nothing
countInt = fromMaybe 0 . stringToInt
countInt = M.fromMaybe 0 . stringToInt
regexSafeTerm :: String -> Bool
regexSafeTerm =
all regexSafeChar
where
regexSafeChar c = C.isAlphaNum c || c == '_' || c == '-'
regexSafeTerm = all (\c -> C.isAlphaNum c || c == '_' || c == '-')

View File

@ -2,12 +2,8 @@
module Unused.TermSearch.Types
( SearchResults(..)
, fromResults
) where
import Unused.Types (TermMatch)
newtype SearchResults = SearchResults [TermMatch] deriving (Monoid)
fromResults :: SearchResults -> [TermMatch]
fromResults (SearchResults a) = a
newtype SearchResults = SearchResults { fromResults :: [TermMatch] } deriving (Monoid)

View File

@ -17,17 +17,17 @@ module Unused.Types
, resultAliases
) where
import qualified Data.Map.Strict as Map
import Data.Csv
import Data.Csv (FromRecord, ToRecord)
import qualified Data.List as L
import GHC.Generics
import Unused.Regex
import qualified Data.Map.Strict as Map
import qualified GHC.Generics as G
import qualified Unused.Regex as R
data TermMatch = TermMatch
{ tmTerm :: String
, tmPath :: String
, tmOccurrences :: Int
} deriving (Eq, Show, Generic)
} deriving (Eq, Show, G.Generic)
instance FromRecord TermMatch
instance ToRecord TermMatch
@ -118,13 +118,13 @@ testOccurrences ms =
totalOccurrences = sum $ map tmOccurrences testMatches
testDir :: String -> Bool
testDir = matchRegex "(spec|tests?|features)\\/"
testDir = R.matchRegex "(spec|tests?|features)\\/"
testSnakeCaseFilename :: String -> Bool
testSnakeCaseFilename = matchRegex ".*(_spec|_test)\\."
testSnakeCaseFilename = R.matchRegex ".*(_spec|_test)\\."
testCamelCaseFilename :: String -> Bool
testCamelCaseFilename = matchRegex ".*(Spec|Test)\\."
testCamelCaseFilename = R.matchRegex ".*(Spec|Test)\\."
termMatchIsTest :: TermMatch -> Bool
termMatchIsTest m =

View File

@ -8,13 +8,13 @@ module Unused.Util
, safeReadFile
) where
import Control.Arrow ((&&&))
import Control.Arrow ((&&&))
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 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 f = map (f . head &&& id)
@ -27,10 +27,10 @@ safeHead _ = Nothing
stringToInt :: String -> Maybe Int
stringToInt xs
| all isDigit xs = Just $ loop 0 xs
| all C.isDigit xs = Just $ loop 0 xs
| otherwise = Nothing
where
loop = foldl (\acc x -> acc * 10 + digitToInt x)
loop = foldl (\acc x -> acc * 10 + C.digitToInt x)
class Readable a where
readFile' :: FilePath -> IO a
@ -38,11 +38,11 @@ class Readable a where
instance Readable String where
readFile' = readFile
instance Readable C.ByteString where
readFile' = C.readFile
instance Readable C8.ByteString where
readFile' = C8.readFile
instance Readable Cl.ByteString where
readFile' = Cl.readFile
instance Readable Cl8.ByteString where
readFile' = Cl8.readFile
safeReadFile :: Readable s => FilePath -> IO (Either E.IOException s)
safeReadFile = E.try . readFile'

View File

@ -4,9 +4,9 @@ module Unused.Grouping.InternalSpec
) where
import Test.Hspec
import Unused.Types
import Unused.Grouping.Internal
import Unused.Grouping.Types
import Unused.Types
main :: IO ()
main = hspec spec

View File

@ -4,9 +4,9 @@ module Unused.LikelihoodCalculatorSpec
) where
import Test.Hspec
import Unused.Types
import Unused.LikelihoodCalculator
import Unused.ResultsClassifier
import Unused.Types
main :: IO ()
main = hspec spec

View File

@ -1,11 +1,11 @@
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 Test.Hspec
import Unused.Parser
import Unused.ResultsClassifier
import Unused.TermSearch
import Unused.Types
main :: IO ()
main = hspec spec

View File

@ -3,11 +3,11 @@ module Unused.ResponseFilterSpec
, spec
) where
import Test.Hspec
import Data.List (find)
import Unused.Types (TermMatch(..), TermResults, resultsFromMatches)
import Test.Hspec
import Unused.ResponseFilter
import Unused.ResultsClassifier
import Unused.Types (TermMatch(..), TermResults, resultsFromMatches)
main :: IO ()
main = hspec spec

View File

@ -4,8 +4,8 @@ module Unused.TermSearch.InternalSpec
) where
import Test.Hspec
import Unused.Types
import Unused.TermSearch.Internal
import Unused.Types
main :: IO ()
main = hspec spec