{-# 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"