{-# LANGUAGE Rank2Types #-} module Descript.Misc.Summary ( Summary (..) ) where import Data.Ratio import Data.List import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text) import Text.Megaparsec.Pos -- | Can generate a debug description. Summaries explicitly /don't/ need -- to provide all information about an object - this makes them -- different than 'Show'. class (Show a) => Summary a where {-# MINIMAL summary | summaryRec #-} -- | A debug description. Summaries explicitly /don't/ need to provide -- all information about an object - this makes them different than 'Show'. -- If the implementation calls the summary of sub-expressions, use -- 'summaryRec' instead. summary :: a -> String summary = summaryRec summary -- | A debug description. Summaries explicitly /don't/ need to provide -- all information about an object - this makes them different than 'Show'. -- Can modify the summaries of sub-expressions using the given function. summaryRec :: (forall b. (Summary b) => b -> String) -> a -> String summaryRec _ = summary -- | A summary of a list of these items, given a function which gets a -- summary of each item. Overridden by 'Char', like 'showsList', for strings. summaryList :: (a -> String) -> [a] -> String summaryList subSummary xs = "[" ++ intercalate ", " childSummaries ++ "]" where childSummaries = map subSummary xs instance Summary Char where summary = show summaryList _ = show instance Summary Int where summary = show instance Summary Integer where summary = show instance Summary Float where summary = show instance Summary Double where summary = show instance Summary Pos where summary = summary . unPos instance Summary Text where summary = show instance (Summary a) => Summary (Ratio a) where summaryRec subSummary x | denomSummary == "1" = numSummary | otherwise = numSummary ++ "/" ++ denomSummary where numSummary = subSummary $ numerator x denomSummary = subSummary $ denominator x instance (Summary a) => Summary (Maybe a) where summaryRec _ Nothing = "(nothing)" summaryRec sub (Just x) = sub x instance (Summary a) => Summary [a] where summaryRec = summaryList instance (Summary a) => Summary (NonEmpty a) where summaryRec subSummary = summaryRec subSummary . NonEmpty.toList instance (Summary a, Summary b) => Summary (a, b) where summaryRec subSummary (x, y) = "(" ++ subSummary x ++ ", " ++ subSummary y ++ ")"