Search code examples
haskelltypeclassintrospectiongadt

How to 'show' unshowable types?

I am using data-reify and graphviz to transform an eDSL into a nice graphical representation, for introspection purposes.

As simple, contrived example, consider:

{-# LANGUAGE GADTs #-}

data Expr a where
  Constant :: a -> Expr a
  Map :: (other -> a) -> Expr a -> Expr a
  Apply :: Expr (other -> a) -> Expr a -> Expr a

instance Functor Expr where
  fmap fun val = Map fun val

instance Applicative Expr where
  fun_expr <*> data_expr = Apply fun_expr data_expr
  pure val = Constant val

-- And then some functions to optimize an Expr AST, evaluate Exprs, etc.

To make introspection nicer, I would like to print the values which are stored inside certain AST nodes of the DSL datatype. However, in general any a might be stored in Constant, even those that do not implement Show. This is not necessarily a problem since we can constrain the instance of Expr like so:

instance Show a => Show (Expr a) where
  ...

This is not what I want however: I would still like to be able to print Expr even if a is not Show-able, by printing some placeholder value (such as just its type and a message that it is unprintable) instead.

So we want to do one thing if we have an a implementing Show, and another if a particular a does not.

Furthermore, the DSL also has the constructors Map and Apply which are even more problematic. The constructor is existential in other, and thus we cannot assume anything about other, a or (other -> a). Adding constraints to the type of other to the Map resp. Apply constructors would break the implementation of Functor resp. Applicative which forwards to them.

But here also I'd like to print for the functions:

  • a unique reference. This is always possible (even though it is not pretty as it requires unsafePerformIO) using System.Mem.StableName.
  • Its type, if possible (one technique is to use show (typeOf fun), but it requires that fun is Typeable).

Again we reach the issue where we want to do one thing if we have an f implementing Typeable and another if f does not.

How to do this?

Extra disclaimer: The goal here is not to create 'correct' Show instances for types that do not support it. There is no aspiration to be able to Read them later, or that print a != print b implies a != b.

The goal is to print any datastructure in a 'nice for human introspection' way.

The part I am stuck at, is that I want to use one implementation if extra constraints are holding for a resp. (other -> a), but a 'default' one if these do not exist. Maybe type classes with FlexibleInstances, or maybe type families are needed here? I have not been able to figure it out (and maybe I am on the wrong track all together).

Solution

  • It turns out that this is a problem which has been recognized by multiple people in the past, known as the 'Constrained Monad Problem'. There is an elegant solution, explained in detail in the paper The Constrained-Monad Problem by Neil Sculthorpe and Jan Bracker and George Giorgidze and Andy Gill.

    A brief summary of the technique: Monads (and other typeclasses) have a 'normal form'. We can 'lift' primitives (which are constrained any way we wish) into this 'normal form' construction, itself an existential datatype, and then use any of the operations available for the typeclass we have lifted into. These operations themselves are not constrained, and thus we can use all of Haskell's normal typeclass functions. Finally, to turn this back into the concrete type (which again has all the constraints we are interested in) we 'lower' it, which is an operation that takes for each of the typeclass' operations a function which it will apply at the appropriate time. This way, constraints from the outside (which are part of the functions supplied to the lowering) and constraints from the inside (which are part of the primitives we lifted) are able to be matched, and finally we end up with one big happy constrained datatype for which we have been able to use any of the normal Functor/Monoid/Monad/etc. operations.

    Interestingly, while the intermediate operations are not constrained, to my knowledge it is impossible to write something which 'breaks' them as this would break the categorical laws that the typeclass under consideration should adhere to.

    This is available in the constrained-normal Hackage package to use in your own code.

    The example I struggled with, could be implemented as follows:

    {-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE UndecidableInstances #-}

module Example where

import Data.Dynamic
import Data.Kind
import Data.Typeable

import Control.Monad.ConstrainedNormal


-- | Required to have a simple constraint which we can use as argument to `Expr` / `Expr'`.
-- | This is definitely the part of the example with the roughest edges: I have yet to figure out
-- | how to make Haskell happy with constraints 
class (Show a, Typeable a) => Introspectable a where {}
instance (Show a, Typeable a) => Introspectable a where {}

data Expr' (c :: * -> Constraint) a where
  C :: a -> Expr' c a
  -- M :: (a -> b) -> Expr' a -> Expr' b --^ NOTE: This one is actually never used as ConstrainedNormal will use the 'free' implementation based on A + C.
  A :: c a => Expr' c (a -> b) -> Expr' c a -> Expr' c b


instance Introspectable a => Show (Expr' Introspectable a) where
  show e = case e of
    C x -> "(C " ++ show x ++ ")"
    -- M f x = "(M " ++ show val ++ ")"
    A fx x -> "(A " ++ show (typeOf fx) ++ " " ++ show x ++ ")"

-- | In user-facing code you'd not want to expose the guts of this construction
--   So let's introduce a 'wrapper type' which is what a user would normally interact with.
type Expr c a = NAF c (Expr' c) a

liftExpr :: c a => Expr' c a -> Expr c a
liftExpr expr = liftNAF expr

lowerExpr :: c a => Expr c a -> Expr' c a
lowerExpr lifted_expr = lowerNAF C A lifted_expr

constant :: Introspectable a => a -> Expr c a
constant val = pure val -- liftExpr (C val)

    You could now for instance write

    ghci> val = constant 10 :: Expr Introspectable Int
(C 10)
ghci> (+2) <$> val
(C 12)
ghci> (+) <$> constant 10 <*> constant 32  :: Expr Introspectable Int

    And by using Data.Constraint.Trivial (part of the trivial-constrained library, although it is also possible to write your own 'empty constrained') one could instead write e.g.

    ghci> val = constant 10 :: Expr Unconstrained Int

    which will work just as before, but now val cannot be printed.

    The one thing I have not yet figured out, is how to properly work with subsets of constraints (i.e. if I have a function that only requires Show, make it work with something that is Introspectable). Currently everything has to work with the 'big' set of constraints. Another minor drawback is of course that you'll have to annotate the constraint type (e.g. if you do not want constraints, write Unconstrained manually), as GHC will otherwise complain that c0 is not known.

    We've reached the goal of having a type which can be optionally be constrained to be printable, with all machinery that does not need printing to work also on all instances of the family of types including those that are not printable, and the types can be used as Monoids, Functors, Applicatives, etc just as you like.

    I think it is a beautiful approach, and want to commend Neil Sculthorpe et al. for their work on the paper and the constrained-normal library that makes this possible. It's very cool!