Take action based on a type parameter's typeclass? - haskell

Question

I suspect I have a fundamental misunderstanding to be corrected, so will start with the general concept and then zoom in on the particular instance that lead me to think this way.
Generally speaking, is it possible to write a function whose type signature has a parameterised type, and take different action depending on whether the type parameter belongs to a typeclass?
So for example if you had
data MyTree a = Node { val :: a, left :: Maybe (MyTree a), right :: Maybe (MyTree a) }
prettyPrint :: MyTree a -> String
prettyPrint (Show a => ...) t = show (val t)
prettyPrint t = show "?"
where prettyPrint $ Node 'x' Nothing Nothing would print x while prettyPrint $ Node id Nothing Nothing would print ?.
What lead me here is a few instances where I'm working on a complex, parameterised data type (eg. MyTree), which is progressing fine until I need to do some debugging. When I insert trace statements I find myself wishing my data type parameter derived Show when I use test (Showable) data. But I understand one should never add typeclass constraints in data declarations as the wonderfully enlightening LYAH puts it. That makes sense, I shouldn't have to artificially restrict my data type simply because I want to debug it.
So I end up adding the typeclass constraints to the code I'm debugging instead, but quickly discover they spread like a virus. Every function that calls the low level function I'm debugging also needs the constraint added, until I've basically just temporarily added the constraint to every function so I can get enough test coverage. Now my test code is polluting the code I'm trying to develop and steering it off course.
I thought it would be nice to pattern match instead and leave the constraint out of the signature, or use polymorphism and define debug versions of my function, or otherwise somehow wrap my debug traces in a conditional that only fires if the type parameter is an instance of Show. But in my meandering I couldn't find a way to do this or a sensible alternative.

Answer 1

A good mindset is that from the compiler's point of view, every type is potentially an instance of every class. When a type is not an instance of Show, it just means the instance has not been found yet, possibly not been written yet, but not that it doesn't exist.
Approach 1
...Therefore, trying to make a decision based on whether or not a type is an instance of a class is indeed quite fundamentally flawed. However, what you can do is to write a class that explicitly makes this distinction. For Show this could simply be
class MaybeShow a where
showIfPossible :: a -> Maybe a
A generalizable version is to wrap the following around the Show class:
{-# LANGUAGE GADTs #-}
data ShowDict a where
ShowDict :: Show a => ShowDict a
class MaybeShow a where
maybeShowDict :: Maybe (ShowDict a)
and then
{-# LANGUAGE TypeApplications, ScopedTypeVariables, UnicodeSyntax #-}
showIfPossible :: ∀ a . MaybeShow a => Maybe (a -> String)
showIfPossible = fmap (\ShowDict -> show) (maybeShowDict #a)
Either way, this would still mean you have the MaybeShow constraint polluting your codebase – which is in a sense better than Show as it doesn't preclude unshowable types, but in a sense also worse because it requires adding instance for all the types you need to use (even if they already have a Show instance).
Approach 2
You already seem to have considered adding the constraint to the data type instead. And although the old syntax data Show a => MyTree a = ... should indeed never be used, it is possible to encapsulate instances in data. In fact I already did it above with ShowDict. Rather than obtaining that implicitly via a MaybeShow constraint, you can also just add it optionally to your data type:
data MyTree a = Node { val :: a
, showable :: Maybe (ShowDict a)
, left :: Maybe (MyTree a)
, right :: Maybe (MyTree a) }
Of course, if all you're using the Show instance for is for showing the val of this specific node, then you could instead also just put the result right there:
data MyTree a = Node { val :: a
, valDescription :: Maybe (String)
, left :: Maybe (MyTree a)
, right :: Maybe (MyTree a) }
Now of course you're polluting your codebase in a different way: every function that generates a MyTree value needs to procure a Show instance, or decide it can't. This likely has less of an impact though, and especially not if MyTree is only an example and you have many more functions that just work on abstract containers instead.
Approach 3
At least for the specific case of debugging, but also some other use cases, it might be best use a separate means of turning the Show requirement on and off. The most brute-force way is a good old preprocessor flag:
{-# LANGUAGE CPP #-}
#define DEBUGMODE
-- (This could be controlled from your Cabal file)
prettyPrint ::
#ifdef DEBUGMODE
Show a =>
#endif
MyTree a -> String
#ifdef DEBUGMODE
prettyPrint (Show a => ...) t = show (val t)
#else
prettyPrint t = show "?"
#endif
A bit more refined is a constraint synonym and fitting debug function, that can be swapped out in just a single place:
{-# LANGUAGE ConstraintKinds #-}
#ifdef DEBUGMODE
type DebugShow a = Show a
debugShow :: DebugShow a => a -> String
debugShow = show
#else
type DebugShow a = ()
debugShow :: DebugShow a => a -> String
debugShow _ = "?"
#else
PrettyPrint :: DebugShow a => MyTree a -> String
PrettyPrint t = debugShow (val t)
The latter again pollutes the codebase with constraints, but you never need to write any new instances for these.
CPP is quite a blunt tool, in that it requires selecting globally during compilation whether or not you want to require Show. But it can also be done more confined, with a dedicated type-level flag:
{-# LANGUAGE TypeFamilies, DataKinds #-}
data DebugMode = NoDebug | DebugShowRequired
type family DebugShow mode a where
DebugShow 'NoDebug a = ()
DebugShow 'DebugShowRequired a = Show a
class KnownDebugMode (m :: DebugMode) where
debugShow :: DebugShow m a => a -> String
instance KnownDebugMode 'NoDebug where
debugShow _ = "?"
instance KnownDebugMode 'DebugShowRequired where
debugShow = show
{-# LANGUAGE AllowAmbiguousTypes #-}
prettyPrint :: ∀ m a . DebugShow m a => MyTree a -> String
prettyPrint t = debugShow (val t)
This looks a lot like approach 1, but the nice thing is that you don't need any new instances for individual a types.
The way to use prettyPrint now is to specify the debug mode with a type application. For example you could extract debug- and production-specific versions thus:
prettyPrintDebug :: Show a => MyTree a -> String
prettyPrintDebug = prettyPrint #('DebugShowRequired)
prettyPrintProduction :: MyTree a -> String
prettyPrintProduction = prettyPrint #('NoDebug)

Answer 2

I think the simplest approach is to explicitly define overlapping instances for the unshowable types you want. As #leftaroundabout pointed out this solution forces you to define instances for potencially many many types, for example a -> b, IO a, State s a, Maybe (a -> b), etc...
I am assuming that you mostly want to show a tree of type MyTree (a -> b). If that's the case this might do the trick
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
data MyTree a =
Node { val :: a
, left :: Maybe (MyTree a)
, right :: Maybe (MyTree a)
} deriving (Show, Functor) -- The functor instance is just a easy way to map every val to "?", but is not strictly necessary for this problem
-- Create a class for pretty printing. The is a package which already provides it
class Pretty a where
prettyprint :: a -> String
-- Define an instance when the inner type is showable. (here is simply show, but that's up to you)
instance Show a => Pretty (MyTree a) where
prettyprint = show
-- Define an instance for the function type.
-- Notice that this isn't an instance for "non-showable" types,
-- but only for the function type.
-- The overlapping is necessary to distinguish from the previous instance
instance {-# OVERLAPPING #-} Pretty (MyTree (a -> b)) where
prettyprint = show . fmap (const "?")
main = do
putStrLn
$ prettyprint
$ Node (1 :: Int)
(Just $ Node 2 Nothing Nothing)
Nothing
putStrLn
$ prettyprint
$ Node id
(Just $ Node (+ 1) Nothing Nothing)
Nothing
-- outputs
> Node {val = 1, left = Just (Node {val = 2, left = Nothing, right = Nothing}), right = Nothing}
> Node {val = "?", left = Just (Node {val = "?", left = Nothing, right = Nothing}), right = Nothing}

Answer 3

See the plugin if-instance: https://www.reddit.com/r/haskell/comments/x9k5fl/branching_on_constraints_ifinstance_applications/
{-# Options_GHC -fplugin=IfSat.Plugin #-}
import Data.Constraint.If (IfSat, ifSat)
prettyPrint :: IfSat (Show a) => a -> String
prettyPrint x = ifSat #(Show a) (show x) "?"
This is rarely what you want and if used incorrectly can be used to write unsafeCoerce, but this plugin is a recent development and it's good to keep in your back pocket. Previous solutions required a lot more boilerplate.

Answer 4

OP here. The other answers resoundingly answer the question I asked. After quite some time digesting them and experimenting, I've arrived at a particular solution to my particular fundamental goal, which satisfies me.
It certainly not general or sophisticated. But for me it's a great workaround, so I wanted to leave some breadcrumbs for others:
First I use the CPP trick to define two different trace wrappers, so I don't need to use show in the non-debug code:
{-# LANGUAGE CPP #-}
#define DEBUG
#ifdef DEBUG
import Debug.Trace ( trace )
type Traceable = Char
dTrace :: (Show a) => a -> b -> b
dTrace traceable expr = trace (show traceable) expr
#else
dTrace :: a -> b -> b
dTrace _ expr = expr
#endif
Similarly, I then define two different data types. Both are deriving (Show) but only the debug version actually results in something that will satisfy show.
data MyTree a = Node {
#ifdef DEBUG
val :: Traceable
#else
val :: a
#endif
, left :: Maybe (MyTree a)
, right :: Maybe (MyTree a)
} deriving (Show)
And that's it, the pollution stops there. Everything is controlled by the DEBUG define and the rest of the code remains unperturbed:
workOnTree :: MyTree a -> MyTree a
workOnTree t = dTrace t $ t{left=Just t}
go = workOnTree $ Node 'x' Nothing Nothing
main :: IO ()
main = putStrLn [val go]
If I combine the three code sections and compile with #define DEBUG, it outputs:
Node {val = 'x', left = Nothing, right = Nothing}
x
And with #define DEBUG commented out (and no other changes!), I get:
x
and Node will happily accept non-showable values for val.
Even without the CPP stuff (which, even as a long time fan of the C preprocessor, I can understand is not to all tastes), this is pretty manageable. At the least you could just manually swap a few lines to switch between testing and production.