{-# LANGUAGE LambdaCase #-}
module DefCounts.Output
  ( defCountOutput
  ) where

import           Data.Foldable
import           Data.Map.Append.Strict (AppendMap(..))
import qualified Data.Map.Strict as M
import           Data.Monoid
import           Text.Printf

import           GHC.Output
import           DefCounts.ProcessHie (DefCounter, DefType(..))

defCountOutput :: DefCounter -> Sum Int -> SDoc
defCountOutput :: DefCounter -> Sum Int -> SDoc
defCountOutput (AppendMap Map DefType (Sum Int, Sum Int)
defCount) (Sum Int
totalLines) =
  [SDoc] -> SDoc
vcat [ SDoc
header
       , [SDoc] -> SDoc
vcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {a} {a}.
(Integral a, Integral a) =>
DefType -> (Sum a, Sum a) -> SDoc
defOutput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
M.toList Map DefType (Sum Int, Sum Int)
defCount
       , SDoc
otherCount
       , String -> SDoc
text String
""
       , String -> SDoc
text String
"Total Lines:" SDoc -> SDoc -> SDoc
<+> PprColour -> SDoc -> SDoc
coloured PprColour
colCyanFg (forall a. Integral a => a -> SDoc
intWithCommas Int
totalLines)
       ]
  where
    defLineTotal :: Int
defLineTotal = forall a. Sum a -> a
getSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map DefType (Sum Int, Sum Int)
defCount
    otherLines :: Int
otherLines = Int
totalLines forall a. Num a => a -> a -> a
- Int
defLineTotal :: Int

    header :: SDoc
header = SDoc -> SDoc
keyword forall b c a. (b -> c) -> (a -> b) -> a -> c
. PprColour -> SDoc -> SDoc
coloured PprColour
colMagentaFg
           forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Type of Definition"
          SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
30 (String -> SDoc
text String
"Num Lines")
          SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
45 (String -> SDoc
text String
"Num Defs")
          SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
60 (String -> SDoc
text String
"% of Total Lines")

    defOutput :: DefType -> (Sum a, Sum a) -> SDoc
defOutput DefType
defType (Sum a
numLines, Sum a
numOccs)
      = DefType -> SDoc
pprDefType DefType
defType
     SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
30 (PprColour -> SDoc -> SDoc
coloured PprColour
colCyanFg forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> SDoc
intWithCommas a
numLines)
     SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
45 (PprColour -> SDoc -> SDoc
coloured PprColour
colCyanFg forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> SDoc
intWithCommas a
numOccs)
     SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
60 (Float -> SDoc
pprPerc forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
numLines :: Float) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalLines forall a. Num a => a -> a -> a
* Float
100)

    otherCount :: SDoc
otherCount
      = String -> SDoc
text String
"Miscellaneous"
     SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
30 (PprColour -> SDoc -> SDoc
coloured PprColour
colCyanFg forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> SDoc
intWithCommas Int
otherLines)
     SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
60 (Float -> SDoc
pprPerc forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
otherLines :: Float) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalLines forall a. Num a => a -> a -> a
* Float
100)

    pprPerc :: Float -> SDoc
pprPerc = PprColour -> SDoc -> SDoc
coloured PprColour
colCyanFg forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"%.1f%%"

pprDefType :: DefType -> SDoc
pprDefType :: DefType -> SDoc
pprDefType = \case
  DefType
Func        -> String -> SDoc
text String
"Function"
  DefType
Fam         -> String -> SDoc
text String
"Type/Data Family"
  DefType
Data        -> String -> SDoc
text String
"Data"
  DefType
Newtype     -> String -> SDoc
text String
"Newtype"
  DefType
Class       -> String -> SDoc
text String
"Type Class"
  DefType
TyFamInst   -> String -> SDoc
text String
"Type/Data Family Instance"
  DefType
ClassInst   -> String -> SDoc
text String
"Type Class Instance"
  DefType
Syn         -> String -> SDoc
text String
"Type Synonym"
  DefType
PatSyn      -> String -> SDoc
text String
"Pattern Synonym"
  DefType
ModImport   -> String -> SDoc
text String
"Import"
  DefType
ExportThing -> String -> SDoc
text String
"Export"