{-# 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           Outputable
import           PprColour

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 ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (DefType -> (Sum Int, Sum Int) -> SDoc)
-> (DefType, (Sum Int, Sum Int)) -> SDoc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DefType -> (Sum Int, Sum Int) -> SDoc
forall a a.
(Integral a, Integral a) =>
DefType -> (Sum a, Sum a) -> SDoc
defOutput ((DefType, (Sum Int, Sum Int)) -> SDoc)
-> [(DefType, (Sum Int, Sum Int))] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map DefType (Sum Int, Sum Int) -> [(DefType, (Sum Int, Sum Int))]
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 (Int -> SDoc
forall a. Integral a => a -> SDoc
intWithCommas Int
totalLines)
       ]
  where
    defLineTotal :: Int
defLineTotal = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int)
-> ((Sum Int, Sum Int) -> Sum Int) -> (Sum Int, Sum Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sum Int, Sum Int) -> Sum Int
forall a b. (a, b) -> a
fst ((Sum Int, Sum Int) -> Int) -> (Sum Int, Sum Int) -> Int
forall a b. (a -> b) -> a -> b
$ Map DefType (Sum Int, Sum Int) -> (Sum Int, Sum Int)
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map DefType (Sum Int, Sum Int)
defCount
    otherLines :: Int
otherLines = Int
totalLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
defLineTotal :: Int

    header :: SDoc
header = SDoc -> SDoc
keyword (SDoc -> SDoc) -> (SDoc -> SDoc) -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PprColour -> SDoc -> SDoc
coloured PprColour
colMagentaFg
           (SDoc -> SDoc) -> SDoc -> SDoc
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 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ a -> SDoc
forall a. Integral a => a -> SDoc
intWithCommas a
numLines)
     SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
45 (PprColour -> SDoc -> SDoc
coloured PprColour
colCyanFg (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ a -> SDoc
forall a. Integral a => a -> SDoc
intWithCommas a
numOccs)
     SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
60 (Float -> SDoc
pprPerc (Float -> SDoc) -> Float -> SDoc
forall a b. (a -> b) -> a -> b
$ (a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
numLines :: Float) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalLines Float -> Float -> Float
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 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Int -> SDoc
forall a. Integral a => a -> SDoc
intWithCommas Int
otherLines)
     SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
60 (Float -> SDoc
pprPerc (Float -> SDoc) -> Float -> SDoc
forall a b. (a -> b) -> a -> b
$ (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
otherLines :: Float) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalLines Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
100)

    pprPerc :: Float -> SDoc
pprPerc = PprColour -> SDoc -> SDoc
coloured PprColour
colCyanFg (SDoc -> SDoc) -> (Float -> SDoc) -> Float -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
text (String -> SDoc) -> (Float -> String) -> Float -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Float -> String
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
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"