{-# LANGUAGE CPP #-}
module Output
  ( printResults
  ) where

import           System.IO (stdout)

import           DefCounts.Output
import           GHC.Api (DynFlags)
import           GHC.Output
import           HieFile (Counters)
import           MatchSigs.Output
import           UseCounts.Output

printResults :: DynFlags
             -> Counters
             -> IO ()
printResults :: DynFlags -> Counters -> IO ()
printResults DynFlags
dynFlags (DefCounter
defCounter, UsageCounter
usageCounter, SigMap
sigDupeMap, Sum Int
totalLines) = do
  let output :: SDoc
output = [SDoc] -> SDoc
vcat
        [ SDoc
separator
        , String -> SDoc
text String
""
        , SDoc -> SDoc
keyword (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Duplicate Type Signatures"
        , String -> SDoc
text String
""
        , SigMap -> SDoc
sigDuplicateOutput SigMap
sigDupeMap
        , String -> SDoc
text String
""
        , SDoc
separator
        , String -> SDoc
text String
""
        , SDoc -> SDoc
keyword (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Usage Totals"
        , String -> SDoc
text String
""
        , UsageCounter -> SDoc
usageOutput UsageCounter
usageCounter
        , String -> SDoc
text String
""
        , SDoc
separator
        , String -> SDoc
text String
""
        , SDoc -> SDoc
keyword (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Definition Counts"
        , String -> SDoc
text String
""
        , DefCounter -> Sum Int -> SDoc
defCountOutput DefCounter
defCounter Sum Int
totalLines
        , String -> SDoc
text String
""
        , SDoc
separator
        ]
      separator :: SDoc
separator = PprColour -> SDoc -> SDoc
coloured PprColour
colGreenFg (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"********************************************************************************"

  DynFlags -> SDoc -> IO ()
outputSDoc DynFlags
dynFlags SDoc
output

outputSDoc :: DynFlags -> SDoc -> IO ()
outputSDoc :: DynFlags -> SDoc -> IO ()
outputSDoc DynFlags
dynFlags SDoc
sDoc = do
#if __GLASGOW_HASKELL__ >= 900
  let pprStyle = setStyleColoured True defaultUserStyle
      sDocCtx = initSDocContext dynFlags pprStyle
  printSDocLn sDocCtx PageMode stdout sDoc
#else
  let pprStyle :: PprStyle
pprStyle = Bool -> PprStyle -> PprStyle
setStyleColoured Bool
True (PprStyle -> PprStyle) -> PprStyle -> PprStyle
forall a b. (a -> b) -> a -> b
$ DynFlags -> PprStyle
defaultUserStyle DynFlags
dynFlags
  Mode -> DynFlags -> Handle -> PprStyle -> SDoc -> IO ()
printSDocLn Mode
PageMode DynFlags
dynFlags Handle
stdout PprStyle
pprStyle SDoc
sDoc
#endif