mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-08-15 07:40:46 +03:00
Roll up App into a monad transformer stack
This introduces a monad transformer stack to cover our reader (options from the CLI) and except (for handling failure cases, initially missing tags or invalid config). This ensures errors are bubbled up appropriately (and halt program execution) and the Options are available in the correct locations within the app. This also separates options parsing (which remains in app/Main.) from translating those options into the correctly executed runner and generated output.
This commit is contained in:
Joshua Clayton
parent
9ddbd0949c
commit
cfa194b936
133
app/App.hs
Normal file
133
app/App.hs
Normal file
@ -0,0 +1,133 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
||||
module App
|
||||
( Options(..)
|
||||
, runProgram
|
||||
) where
|
||||
|
||||
import qualified Data.Bifunctor as B
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Except
|
||||
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(..), renderHeader, executeSearch, withRuntime)
|
||||
import qualified Unused.CLI.Views as V
|
||||
|
||||
type AppConfig = MonadReader Options
|
||||
|
||||
data AppError
|
||||
= TagError TagSearchOutcome
|
||||
| InvalidConfigError [ParseConfigError]
|
||||
|
||||
newtype App a = App {
|
||||
runApp :: ReaderT Options (ExceptT AppError IO) a
|
||||
} deriving (Monad, Functor, Applicative, AppConfig, MonadError AppError, MonadIO)
|
||||
|
||||
data Options = Options
|
||||
{ oSearchRunner :: SearchRunner
|
||||
, oSingleOccurrenceMatches :: Bool
|
||||
, oLikelihoods :: [RemovalLikelihood]
|
||||
, oAllLikelihoods :: Bool
|
||||
, oIgnoredPaths :: [String]
|
||||
, oGrouping :: CurrentGrouping
|
||||
, oWithoutCache :: Bool
|
||||
, oFromStdIn :: Bool
|
||||
}
|
||||
|
||||
runProgram :: Options -> IO ()
|
||||
runProgram options = withRuntime $
|
||||
runExceptT (runReaderT (runApp run) options) >>= either renderError return
|
||||
|
||||
run :: App ()
|
||||
run = do
|
||||
terms <- termsWithAlternatesFromConfig
|
||||
|
||||
liftIO $ renderHeader terms
|
||||
results <- withCache . (`executeSearch` terms) =<< searchRunner
|
||||
|
||||
printResults . (`parseResults` results) =<< loadAllConfigs
|
||||
|
||||
termsWithAlternatesFromConfig :: App [String]
|
||||
termsWithAlternatesFromConfig = do
|
||||
aliases <- concatMap lcTermAliases <$> loadAllConfigs
|
||||
terms <- calculateTagInput
|
||||
|
||||
return $ termsAndAliases aliases terms
|
||||
|
||||
renderError :: AppError -> IO ()
|
||||
renderError (TagError e) = V.missingTagsFileError e
|
||||
renderError (InvalidConfigError e) = V.invalidConfigError e
|
||||
|
||||
printResults :: TermMatchSet -> App ()
|
||||
printResults ts = do
|
||||
filters <- optionFilters ts
|
||||
grouping <- groupingOptions
|
||||
liftIO $ V.searchResults $ groupedResponses grouping filters
|
||||
|
||||
loadAllConfigs :: App [LanguageConfiguration]
|
||||
loadAllConfigs = do
|
||||
configs <- liftIO (B.first InvalidConfigError <$> loadAllConfigurations)
|
||||
either throwError return configs
|
||||
|
||||
calculateTagInput :: App [String]
|
||||
calculateTagInput = do
|
||||
tags <- liftIO . fmap (B.first TagError) . loadTags =<< readFromStdIn
|
||||
either throwError return tags
|
||||
where
|
||||
loadTags b = if b then loadTagsFromPipe else loadTagsFromFile
|
||||
|
||||
withCache :: IO SearchResults -> App SearchResults
|
||||
withCache f =
|
||||
liftIO . operateCache =<< runWithCache
|
||||
where
|
||||
operateCache b = if b then withCache' f else f
|
||||
withCache' = fmap SearchResults . cached "term-matches" . fmap fromResults
|
||||
|
||||
optionFilters :: AppConfig m => TermMatchSet -> m TermMatchSet
|
||||
optionFilters tms = foldl (>>=) (pure tms) matchSetFilters
|
||||
where
|
||||
matchSetFilters =
|
||||
[ singleOccurrenceFilter
|
||||
, likelihoodsFilter
|
||||
, ignoredPathsFilter
|
||||
]
|
||||
|
||||
singleOccurrenceFilter :: AppConfig m => TermMatchSet -> m TermMatchSet
|
||||
singleOccurrenceFilter tms = do
|
||||
allowsSingleOccurrence <- oSingleOccurrenceMatches <$> ask
|
||||
return $ if allowsSingleOccurrence
|
||||
then withOneOccurrence tms
|
||||
else tms
|
||||
|
||||
likelihoodsFilter :: AppConfig m => TermMatchSet -> m TermMatchSet
|
||||
likelihoodsFilter tms =
|
||||
withLikelihoods . likelihoods <$> ask <*> pure tms
|
||||
where
|
||||
likelihoods options
|
||||
| oAllLikelihoods options = [High, Medium, Low]
|
||||
| null $ oLikelihoods options = [High]
|
||||
| otherwise = oLikelihoods options
|
||||
|
||||
ignoredPathsFilter :: AppConfig m => TermMatchSet -> m TermMatchSet
|
||||
ignoredPathsFilter tms = ignoringPaths . oIgnoredPaths <$> ask <*> pure tms
|
||||
|
||||
readFromStdIn :: AppConfig m => m Bool
|
||||
readFromStdIn = oFromStdIn <$> ask
|
||||
|
||||
groupingOptions :: AppConfig m => m CurrentGrouping
|
||||
groupingOptions = oGrouping <$> ask
|
||||
|
||||
searchRunner :: AppConfig m => m SearchRunner
|
||||
searchRunner = oSearchRunner <$> ask
|
||||
|
||||
runWithCache :: AppConfig m => m Bool
|
||||
runWithCache = not . oWithoutCache <$> ask
|
||||
85
app/Main.hs
85
app/Main.hs
@ -1,42 +1,14 @@
|
||||
module Main where
|
||||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.Bifunctor as B
|
||||
import Control.Monad.Except (ExceptT(..), runExceptT)
|
||||
import App
|
||||
import Options.Applicative
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Unused.Parser (parseResults)
|
||||
import Unused.Types (TermMatchSet, RemovalLikelihood(..))
|
||||
import Unused.TermSearch (SearchResults(..), fromResults)
|
||||
import Unused.ResultsClassifier
|
||||
import Unused.ResponseFilter (withOneOccurrence, withLikelihoods, ignoringPaths)
|
||||
import Unused.Grouping (CurrentGrouping(..), groupedResponses)
|
||||
import Unused.CLI (SearchRunner(..), withRuntime, renderHeader, executeSearch)
|
||||
import qualified Unused.CLI.Views as V
|
||||
import Unused.Cache
|
||||
import Unused.Aliases (termsAndAliases)
|
||||
import Unused.TagsSource
|
||||
|
||||
data Options = Options
|
||||
{ oSearchRunner :: SearchRunner
|
||||
, oSingleOccurrenceMatches :: Bool
|
||||
, oLikelihoods :: [RemovalLikelihood]
|
||||
, oAllLikelihoods :: Bool
|
||||
, oIgnoredPaths :: [String]
|
||||
, oGrouping :: CurrentGrouping
|
||||
, oWithoutCache :: Bool
|
||||
, oFromStdIn :: Bool
|
||||
}
|
||||
|
||||
data AppError
|
||||
= TagError TagSearchOutcome
|
||||
| InvalidConfigError [ParseConfigError]
|
||||
import Unused.Grouping (CurrentGrouping(..))
|
||||
import Unused.Types (RemovalLikelihood(..))
|
||||
import Unused.CLI (SearchRunner(..))
|
||||
|
||||
main :: IO ()
|
||||
main = runProgram =<< parseCLI
|
||||
where
|
||||
runProgram options = withRuntime $
|
||||
runExceptT (run options) >>= either renderError return
|
||||
|
||||
parseCLI :: IO Options
|
||||
parseCLI =
|
||||
@ -48,55 +20,6 @@ parseCLI =
|
||||
\ in a codebase that are unused."
|
||||
pFooter = "CLI USAGE: $ unused"
|
||||
|
||||
renderError :: AppError -> IO ()
|
||||
renderError (TagError e) = V.missingTagsFileError e
|
||||
renderError (InvalidConfigError e) = V.invalidConfigError e
|
||||
|
||||
run :: Options -> ExceptT AppError IO ()
|
||||
run options = do
|
||||
terms' <- withException TagError $ calculateTagInput options
|
||||
languageConfig <- withException InvalidConfigError loadAllConfigurations
|
||||
|
||||
let terms = termsWithAlternatesFromConfig languageConfig terms'
|
||||
|
||||
liftIO $ renderHeader terms
|
||||
results <- liftIO $ withCache options $ executeSearch (oSearchRunner options) terms
|
||||
|
||||
liftIO $ printResults options $ parseResults languageConfig results
|
||||
where
|
||||
withException e = ExceptT . fmap (B.first e)
|
||||
|
||||
termsWithAlternatesFromConfig :: [LanguageConfiguration] -> [String] -> [String]
|
||||
termsWithAlternatesFromConfig lcs =
|
||||
termsAndAliases aliases
|
||||
where
|
||||
aliases = concatMap lcTermAliases lcs
|
||||
|
||||
printResults :: Options -> TermMatchSet -> IO ()
|
||||
printResults options = V.searchResults . groupedResponses (oGrouping options) . optionFilters options
|
||||
|
||||
calculateTagInput :: Options -> IO (Either TagSearchOutcome [String])
|
||||
calculateTagInput Options{ oFromStdIn = True } = loadTagsFromPipe
|
||||
calculateTagInput Options{ oFromStdIn = False } = loadTagsFromFile
|
||||
|
||||
withCache :: Options -> IO SearchResults -> IO SearchResults
|
||||
withCache Options{ oWithoutCache = True } = id
|
||||
withCache Options{ oWithoutCache = False } = fmap SearchResults . cached "term-matches" . fmap fromResults
|
||||
|
||||
optionFilters :: Options -> (TermMatchSet -> TermMatchSet)
|
||||
optionFilters o =
|
||||
foldl1 (.) filters
|
||||
where
|
||||
filters =
|
||||
[ if oSingleOccurrenceMatches o then withOneOccurrence else id
|
||||
, withLikelihoods likelihoods
|
||||
, ignoringPaths $ oIgnoredPaths o
|
||||
]
|
||||
likelihoods
|
||||
| oAllLikelihoods o = [High, Medium, Low]
|
||||
| null (oLikelihoods o) = [High]
|
||||
| otherwise = oLikelihoods o
|
||||
|
||||
withInfo :: Parser a -> String -> String -> String -> ParserInfo a
|
||||
withInfo opts h d f =
|
||||
info (helper <*> opts) $ header h <> progDesc d <> footer f
|
||||
|
||||
@ -80,6 +80,7 @@ executable unused
|
||||
, optparse-applicative
|
||||
, mtl
|
||||
, transformers
|
||||
other-modules: App
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite unused-test
|
||||
|
||||
Loading…
Reference in New Issue
Block a user