module UseCounts.Output
  ( usageOutput
  ) where

import           Data.List
import           Data.Map.Append.Strict (AppendMap(..))
import qualified Data.Map.Strict as M
import           Data.Ord (Down(..))

import           Name
import           Outputable
import           PprColour

import           UseCounts.ProcessHie (UsageCounter, UsageCount(..))

limit :: Int
limit :: Int
limit = Int
15

usageOutput :: UsageCounter -> SDoc
usageOutput :: UsageCounter -> SDoc
usageOutput (AppendMap Map Name UsageCount
usageCounter) =
  if [SDoc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SDoc]
uses Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
limit
     then [SDoc] -> SDoc
vcat [SDoc]
uses
     else [SDoc] -> SDoc
vcat [ String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
limit String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Least used definitions:"
               , [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [SDoc] -> [SDoc]
forall a. Int -> [a] -> [a]
take Int
limit ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> [SDoc]
forall a. [a] -> [a]
reverse [SDoc]
uses
               , String -> SDoc
text String
""
               , String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
limit String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Most used definitions:"
               , [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ Int -> [SDoc] -> [SDoc]
forall a. Int -> [a] -> [a]
take Int
limit [SDoc]
uses
               ]
  where
    uses :: [SDoc]
uses = ((Name, UsageCount) -> SDoc) -> [(Name, UsageCount)] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> UsageCount -> SDoc) -> (Name, UsageCount) -> SDoc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> UsageCount -> SDoc
usageLine)
         ([(Name, UsageCount)] -> [SDoc])
-> (Map Name UsageCount -> [(Name, UsageCount)])
-> Map Name UsageCount
-> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, UsageCount) -> Down Int)
-> [(Name, UsageCount)] -> [(Name, UsageCount)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int)
-> ((Name, UsageCount) -> Int) -> (Name, UsageCount) -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UsageCount -> Int
usages (UsageCount -> Int)
-> ((Name, UsageCount) -> UsageCount) -> (Name, UsageCount) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, UsageCount) -> UsageCount
forall a b. (a, b) -> b
snd)
         ([(Name, UsageCount)] -> [(Name, UsageCount)])
-> (Map Name UsageCount -> [(Name, UsageCount)])
-> Map Name UsageCount
-> [(Name, UsageCount)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name UsageCount -> [(Name, UsageCount)]
forall k a. Map k a -> [(k, a)]
M.toList
         (Map Name UsageCount -> [SDoc]) -> Map Name UsageCount -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (UsageCount -> Bool) -> Map Name UsageCount -> Map Name UsageCount
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter UsageCount -> Bool
locallyDefined Map Name UsageCount
usageCounter

usageLine :: Name -> UsageCount -> SDoc
usageLine :: Name -> UsageCount -> SDoc
usageLine Name
name UsageCount
usage
  = let numUses :: Int
numUses = UsageCount -> Int
usages UsageCount
usage
        u :: SDoc
u | Int
numUses Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String -> SDoc
text String
"use"
          | Bool
otherwise = String -> SDoc
text String
"uses"
        in  Name -> SDoc
nameOutput Name
name
        SDoc -> SDoc -> SDoc
$+$ Int -> SDoc -> SDoc
nest Int
2 (PprColour -> SDoc -> SDoc
coloured PprColour
colCyanFg (Int -> SDoc
forall a. Integral a => a -> SDoc
intWithCommas Int
numUses) SDoc -> SDoc -> SDoc
<+> SDoc
u)

nameOutput :: Name -> SDoc
nameOutput :: Name -> SDoc
nameOutput Name
name = SDoc
nameDoc SDoc -> SDoc -> SDoc
<+> SDoc
locDoc where
  nameDoc :: SDoc
nameDoc = PprColour -> SDoc -> SDoc
coloured PprColour
colYellowFg (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
  locDoc :: SDoc
locDoc = PprColour -> SDoc -> SDoc
coloured PprColour
colMagentaFg (SDoc -> SDoc) -> (SDoc -> SDoc) -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Name -> SDoc
pprDefinedAt Name
name