FiniteCategories-0.1.0.0: src/IO/PrettyPrint.hs

{-| Module  : FiniteCategories
Description : A simple typeclass for things to be pretty printed.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

A simple typeclass for things to be pretty printed. Things should be pretty printable to be exported with graphviz.
-}
module IO.PrettyPrint
(
    PrettyPrintable(..),
    pprintFunction
)
where
    import Data.List  (intercalate)
    import Data.Set   (Set, toList)
    import Data.Map   (Map, keys, (!))
    import Data.Maybe
    import Data.Either
    import Data.Text  (Text, unpack)
    
    -- | The typeclass of things that can be pretty printed.
    class PrettyPrintable a where
        pprint :: a -> String
        
    instance (PrettyPrintable a) => PrettyPrintable [a] where
        pprint xs = "[" ++ intercalate "," (pprint <$> xs) ++ "]"
        
    
    instance (PrettyPrintable a, PrettyPrintable b) => PrettyPrintable (a,b) where
        pprint (a,b) = "(" ++ pprint a ++ "," ++ pprint b ++ ")"
    
    instance (PrettyPrintable a, PrettyPrintable b, PrettyPrintable c) => PrettyPrintable (a,b,c) where
        pprint (a,b,c) = "(" ++ pprint a ++ "," ++ pprint b ++ "," ++ pprint c ++ ")"
        
    instance (PrettyPrintable a) => PrettyPrintable (Set a) where
        pprint xs = "{" ++ intercalate "," (pprint <$> (toList xs)) ++ "}"
        
    instance PrettyPrintable Int where
        pprint = show
        
    instance PrettyPrintable Double where
        pprint = show
        
    instance PrettyPrintable Char where
        pprint = show
        
    instance (Ord k, PrettyPrintable k, PrettyPrintable a) => PrettyPrintable (Map k a) where
        pprint m = intercalate "\n" [pprint k ++ "->" ++pprint (m!k)| k <- keys m]
        
    instance (PrettyPrintable a) => PrettyPrintable (Maybe a) where
        pprint Nothing = "Nothing"
        pprint (Just a) = pprint a
        
    instance (PrettyPrintable a, PrettyPrintable b) => PrettyPrintable (Either a b) where
        pprint (Left x) = pprint x
        pprint (Right x) = pprint x
        
    instance PrettyPrintable Text where
        pprint = unpack
    
    -- | Pretty print a function on a specific domain.
    pprintFunction :: (PrettyPrintable a, PrettyPrintable b) =>
                   (a -> b) -> [a] -> String
    pprintFunction f xs = intercalate "\n" [pprint x ++" -> " ++ pprint (f x) | x <- xs]