Summary.hs

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