module MatchSigs.Output ( sigDuplicateOutput ) where import Data.Map.Append.Strict (AppendMap(..)) import qualified Data.Map.Strict as M import GHC.Api hiding (count) import GHC.Output import MatchSigs.ProcessHie (SigMap, MatchedSigs(..)) sigDuplicateOutput :: SigMap -> SDoc sigDuplicateOutput :: SigMap -> SDoc sigDuplicateOutput (AppendMap Map [Sig ()] MatchedSigs sigMap) = if [SDoc] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [SDoc] outputLines then String -> SDoc text String "(No duplicated signatures)" else [SDoc] -> SDoc vcat [SDoc] outputLines where outputLines :: [SDoc] outputLines = (([Sig FreeVarIdx], String, [Name]) -> SDoc) -> [([Sig FreeVarIdx], String, [Name])] -> [SDoc] forall a b. (a -> b) -> [a] -> [b] map ([Sig FreeVarIdx], String, [Name]) -> SDoc forall a. (a, String, [Name]) -> SDoc sigLine ([([Sig FreeVarIdx], String, [Name])] -> [SDoc]) -> ([MatchedSigs] -> [([Sig FreeVarIdx], String, [Name])]) -> [MatchedSigs] -> [SDoc] forall b c a. (b -> c) -> (a -> b) -> a -> c . (([Sig FreeVarIdx], String, [Name]) -> Bool) -> [([Sig FreeVarIdx], String, [Name])] -> [([Sig FreeVarIdx], String, [Name])] forall a. (a -> Bool) -> [a] -> [a] filter ([Sig FreeVarIdx], String, [Name]) -> Bool forall (t :: * -> *) a b a. Foldable t => (a, b, t a) -> Bool multipleNames ([([Sig FreeVarIdx], String, [Name])] -> [([Sig FreeVarIdx], String, [Name])]) -> ([MatchedSigs] -> [([Sig FreeVarIdx], String, [Name])]) -> [MatchedSigs] -> [([Sig FreeVarIdx], String, [Name])] forall b c a. (b -> c) -> (a -> b) -> a -> c . (MatchedSigs -> [([Sig FreeVarIdx], String, [Name])]) -> [MatchedSigs] -> [([Sig FreeVarIdx], String, [Name])] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap MatchedSigs -> [([Sig FreeVarIdx], String, [Name])] getMatchedSigs ([MatchedSigs] -> [SDoc]) -> [MatchedSigs] -> [SDoc] forall a b. (a -> b) -> a -> b $ Map [Sig ()] MatchedSigs -> [MatchedSigs] forall k a. Map k a -> [a] M.elems Map [Sig ()] MatchedSigs sigMap multipleNames :: (a, b, t a) -> Bool multipleNames (a _, b _, t a names) = t a -> FreeVarIdx forall (t :: * -> *) a. Foldable t => t a -> FreeVarIdx length t a names FreeVarIdx -> FreeVarIdx -> Bool forall a. Ord a => a -> a -> Bool > FreeVarIdx 1 sigLine :: (a, String, [Name]) -> SDoc sigLine (a _, String renderedSig, [Name] names) = [SDoc] -> SDoc vcat [ PprColour -> SDoc -> SDoc coloured PprColour colCyanFg (SDoc -> SDoc) -> SDoc -> SDoc forall a b. (a -> b) -> a -> b $ SDoc dcolon SDoc -> SDoc -> SDoc <+> String -> SDoc text String renderedSig , FreeVarIdx -> SDoc -> SDoc nest FreeVarIdx 2 (SDoc -> SDoc) -> SDoc -> SDoc forall a b. (a -> b) -> a -> b $ FreeVarIdx -> SDoc count ([Name] -> FreeVarIdx forall (t :: * -> *) a. Foldable t => t a -> FreeVarIdx length [Name] names) , [SDoc] -> SDoc vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc forall a b. (a -> b) -> a -> b $ Name -> SDoc printName (Name -> SDoc) -> [Name] -> [SDoc] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Name] names , String -> SDoc text String "" ] printName :: Name -> SDoc printName Name name = let 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 in Char -> SDoc char Char '•' SDoc -> SDoc -> SDoc <+> SDoc nameDoc SDoc -> SDoc -> SDoc <+> SDoc locDoc count :: FreeVarIdx -> SDoc count FreeVarIdx x = PprColour -> SDoc -> SDoc coloured PprColour colCyanFg (FreeVarIdx -> SDoc int FreeVarIdx x) SDoc -> SDoc -> SDoc <+> String -> SDoc text String "matches:"