Use ReaderT for ColumnFormatter

Why?
====

When printing results, the column formatter has to be configured at the
topmost level (where it has all result data) to calculate widths
appropriately; however, it's only used layers deep, when rendering the
columns themselves.

This moves the formatter into a ReaderT so the configuration can be
passed around appropriately.
This commit is contained in:
Joshua Clayton 2016-05-27 06:49:27 -04:00
parent 4dfd788318
commit 6eb2e38882

View File

@ -3,33 +3,37 @@ module Unused.CLI.Views.SearchResult
) where ) where
import Control.Monad (forM_) import Control.Monad (forM_)
import Control.Arrow ((&&&))
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader
import Unused.Types import Unused.Types
import Unused.Grouping (Grouping(..), GroupedTerms) import Unused.Grouping (Grouping(..), GroupedTerms)
import Unused.CLI.Views.SearchResult.ColumnFormatter import Unused.CLI.Views.SearchResult.ColumnFormatter
import Unused.CLI.Util import Unused.CLI.Util
import qualified Unused.CLI.Views.NoResultsFound as V import qualified Unused.CLI.Views.NoResultsFound as V
type ResultsPrinter = ReaderT ColumnFormat IO
searchResults :: [GroupedTerms] -> IO () searchResults :: [GroupedTerms] -> IO ()
searchResults terms = searchResults terms =
printFormattedTerms columnFormat terms runReaderT (printFormattedTerms terms) columnFormat
where where
allSets = listFromMatchSet =<< map snd terms columnFormat = buildColumnFormatter $ termsToResults terms
allResults = map snd allSets termsToResults = concatMap Map.elems . map snd
columnFormat = buildColumnFormatter allResults
printFormattedTerms :: ColumnFormat -> [GroupedTerms] -> IO () printFormattedTerms :: [GroupedTerms] -> ResultsPrinter ()
printFormattedTerms _ [] = V.noResultsFound printFormattedTerms [] = liftIO V.noResultsFound
printFormattedTerms cf ts = mapM_ (printGroupingSection cf) ts printFormattedTerms ts = mapM_ printGroupingSection ts
listFromMatchSet :: TermMatchSet -> [(String, TermResults)] listFromMatchSet :: TermMatchSet -> [(String, TermResults)]
listFromMatchSet = listFromMatchSet =
Map.toList Map.toList
printGroupingSection :: ColumnFormat -> GroupedTerms -> IO () printGroupingSection :: GroupedTerms -> ResultsPrinter ()
printGroupingSection cf (g, tms) = do printGroupingSection (g, tms) = do
printGrouping g liftIO $ printGrouping g
mapM_ (printTermResults cf) $ listFromMatchSet tms mapM_ printTermResults $ listFromMatchSet tms
printGrouping :: Grouping -> IO () printGrouping :: Grouping -> IO ()
printGrouping NoGrouping = return () printGrouping NoGrouping = return ()
@ -40,9 +44,9 @@ printGrouping g = do
print g print g
setSGR [Reset] setSGR [Reset]
printTermResults :: ColumnFormat -> (String, TermResults) -> IO () printTermResults :: (String, TermResults) -> ResultsPrinter ()
printTermResults cf (_, results) = printTermResults =
printMatches cf results $ trMatches results uncurry printMatches . (id &&& trMatches) . snd
likelihoodColor :: RemovalLikelihood -> Color likelihoodColor :: RemovalLikelihood -> Color
likelihoodColor High = Red likelihoodColor High = Red
@ -51,9 +55,14 @@ likelihoodColor Low = Green
likelihoodColor Unknown = Black likelihoodColor Unknown = Black
likelihoodColor NotCalculated = Magenta likelihoodColor NotCalculated = Magenta
printMatches :: ColumnFormat -> TermResults -> [TermMatch] -> IO () printMatches :: TermResults -> [TermMatch] -> ResultsPrinter ()
printMatches cf r ms = printMatches r ms = do
forM_ ms $ \m -> do cf <- ask
let printTerm = cfPrintTerm cf
let printPath = cfPrintPath cf
let printNumber = cfPrintNumber cf
liftIO $ forM_ ms $ \m -> do
setSGR [SetColor Foreground Dull (termColor r)] setSGR [SetColor Foreground Dull (termColor r)]
setSGR [SetConsoleIntensity NormalIntensity] setSGR [SetConsoleIntensity NormalIntensity]
putStr $ " " ++ printTerm (tmTerm m) putStr $ " " ++ printTerm (tmTerm m)
@ -72,8 +81,5 @@ printMatches cf r ms =
putStr $ " " ++ removalReason r putStr $ " " ++ removalReason r
putStr "\n" putStr "\n"
where where
printTerm = cfPrintTerm cf
printPath = cfPrintPath cf
printNumber = cfPrintNumber cf
termColor = likelihoodColor . rLikelihood . trRemoval termColor = likelihoodColor . rLikelihood . trRemoval
removalReason = rReason . trRemoval removalReason = rReason . trRemoval