Extract app types

This commit is contained in:
Joshua Clayton 2017-05-02 10:25:59 -07:00
parent 0d9a89ae4b
commit 5c08c145a5
No known key found for this signature in database
GPG Key ID: 5B6558F77E9A8118
4 changed files with 57 additions and 39 deletions

View File

@ -1,53 +1,27 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module App
( Options(..)
, runProgram
( runProgram
) where
import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)
import Control.Monad.Reader (ReaderT, MonadReader, MonadIO, runReaderT, asks, liftIO)
import Control.Monad.Except (runExceptT, throwError)
import Control.Monad.Reader (runReaderT, asks, liftIO)
import qualified Data.Bifunctor as BF
import qualified Data.Bool as B
import qualified Data.Maybe as M
import Types
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.Cache (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.ResultsClassifier (LanguageConfiguration(..), loadAllConfigurations)
import Unused.TagsSource (loadTagsFromFile, loadTagsFromPipe)
import Unused.TermSearch (SearchResults(..), SearchBackend(..), SearchTerm, fromResults)
import Unused.Types (TermMatchSet, RemovalLikelihood(..))
type AppConfig = MonadReader Options
data AppError
= TagError TagSearchOutcome
| InvalidConfigError [ParseConfigError]
| CacheError FingerprintOutcome
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
, oCommitCount :: Maybe Int
, oSearchBackend :: SearchBackend
}
runProgram :: Options -> IO ()
runProgram options = withRuntime $
either renderError return
@ -67,11 +41,10 @@ searchBackend :: AppConfig m => m SearchBackend
searchBackend = asks oSearchBackend
termsWithAlternatesFromConfig :: App [SearchTerm]
termsWithAlternatesFromConfig = do
aliases <- concatMap lcTermAliases <$> loadAllConfigs
terms <- calculateTagInput
return $ termsAndAliases aliases terms
termsWithAlternatesFromConfig =
termsAndAliases
<$> (concatMap lcTermAliases <$> loadAllConfigs)
<*> calculateTagInput
renderError :: AppError -> IO ()
renderError (TagError e) = V.missingTagsFileError e

View File

@ -1,9 +1,10 @@
module Main where
import App (runProgram, Options(Options))
import App (runProgram)
import Common
import qualified Data.Maybe as M
import Options.Applicative
import Types (Options(Options))
import Unused.CLI (SearchRunner(..))
import Unused.Grouping (CurrentGrouping(..))
import Unused.TermSearch (SearchBackend(..))

43
app/Types.hs Normal file
View File

@ -0,0 +1,43 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ConstraintKinds #-}
module Types
( Options(..)
, AppConfig
, AppError(..)
, App(..)
) where
import Control.Monad.Except (ExceptT, MonadError)
import Control.Monad.Reader (MonadReader, ReaderT, MonadIO)
import Unused.CLI (SearchRunner)
import Unused.Cache (FingerprintOutcome)
import Unused.Grouping (CurrentGrouping)
import Unused.ResultsClassifier (ParseConfigError)
import Unused.TagsSource (TagSearchOutcome)
import Unused.TermSearch (SearchBackend)
import Unused.Types (RemovalLikelihood)
data Options = Options
{ oSearchRunner :: SearchRunner
, oSingleOccurrenceMatches :: Bool
, oLikelihoods :: [RemovalLikelihood]
, oAllLikelihoods :: Bool
, oIgnoredPaths :: [String]
, oGrouping :: CurrentGrouping
, oWithoutCache :: Bool
, oFromStdIn :: Bool
, oCommitCount :: Maybe Int
, oSearchBackend :: SearchBackend
}
type AppConfig = MonadReader Options
data AppError
= TagError TagSearchOutcome
| InvalidConfigError [ParseConfigError]
| CacheError FingerprintOutcome
newtype App a = App {
runApp :: ReaderT Options (ExceptT AppError IO) a
} deriving (Monad, Functor, Applicative, AppConfig, MonadError AppError, MonadIO)

View File

@ -96,6 +96,7 @@ executable unused
, mtl
, transformers
other-modules: App
, Types
default-language: Haskell2010
test-suite unused-test