How to "reuse" instance definitions from another typeclass while introduding minor differences? - haskell

I want to output my application's logs in JSON, but there are some ubiquitous data-types for which ToJSON instances are not defined - most notably SomeException and the entire Exception hierarchy of types.
I have two choices:
Define instances of ToJSON for such data-types in my application
Write my own type-class, say ToJsonLogs, and make it reuse ToJSON instances as much as possible.
The first is the path of "least resistance" but it has other implications. Since type-class instances are global in nature, I might end-up defining ToJSON instances that break something. Also, for the same data-structure, I might want the JSON in APIs to be different from the JSON in logs (for example, scrubbing keys, auth-tokens, and other sensitive data OR truncating very long text fields).
This questions is about exploring the second option. How do I go about doing something like the following:
class ToJsonLogs a where
toJsonLogs :: a -> Aeson.Value
default toJsonLogs :: (ToJSON a) => a -> Aeson.Value
toJsonLogs = toJSON
instance ToJsonLogs SomeException where
toJsonLogs = toJSON . displayException
I tried the above idea, but it failed at the very first step itself. Here's an example data-structure:
data SyncResult = SyncResult
{ resAborted :: !Bool
, resSuccessful :: !Int
, resFailed :: ![(Int, SomeException)]
} deriving (Show)
I can't derive ToJsonLogs without first deriving ToJSON for the entire data-structure. Derivation of ToJSON fails because of SomeException. Hence the title of this question.
I even tried fooling around with Generics, but as usual, got stuck again.

You are very close to a possible extension-free solution. The thing you should consider is to create a wrapper for the original ToJson class members:
class ToJsonLogs a where
toJsonLogs :: a -> Aeson.Value
newtype WrapToJson a = WrapToJson a -- actually an Identity
instance ToJson a => ToJsonLogs (WrapToJson a) where
toJsonLogs (WrapToJson x) = toJson x
-- example
logInt :: Int -> Aeson.value
logInt x = toJsonLogs (WrapJson x)
If you want to restrict the wrapper only for ToJson instances, you will need to enable few extensions:
{-# LANGUAGE GADTSyntax, ExistentialQuantifiaction #-}
data WrapToJson a where WrapToJson :: ToJson a => a -> WrapToJson a
If you don't enjoy this wrapper, you may hide it under another definition of toJsonLogs:
toJsonLogs' :: ToJson a => a -> Aeson.value
toJsonLogs' = toJsonLogs . WrapToJson

Related

Take action based on a type parameter's typeclass?

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.
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)
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}
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.
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.

Would it be possible to derive Data.Vector.Unbox via GHC's generic deriving?

It's possible to derive Storable via GHC's generic deriving mechanism: http://hackage.haskell.org/package/derive-storable (and https://hackage.haskell.org/package/derive-storable-plugin for performance). The only library I can find for deriving Data.Vector.Unbox, however, uses template Haskell: http://hackage.haskell.org/package/vector-th-unbox. It also requires the user to write a little code; it's not entirely automatic.
My question is, could a library like deriving-storable also exist for Unbox, or is this not possible due to some fundamental way in which Unbox differs from Storable? If the latter, does that mean it's also not possible to create a library that allows automatically deriving Unbox for any Storable type, as I could not find such a library.
I ask because ideally I'd like to avoid template Haskell and the manual annotations necessary for using vector-th-unbox.
Say we had some Generic_ class to convert between our own types and some uniform representation which happens to have an Unbox instance (which amounts to both MVector and Vector instances for the Unboxed variants):
class Generic_ a where
type Rep_ (a :: Type) :: Type
to_ :: a -> Rep_ a
from_ :: Rep_ a -> a
Then we can use that to obtain generic implementations of the methods of MVector/Vector:
-- (auxiliary definitions of CMV and uncoercemv at the end of this block)
-- vector imports (see gist at the end for a compilable sample)
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import Data.Vector.Generic.Mutable.Base (MVector(..))
-- MVector
gbasicLength :: forall a s. CMV s a => UM.MVector s a -> Int
gbasicLength = basicLength #UM.MVector #(Rep_ a) #s . coerce
gbasicUnsafeSlice :: forall a s. CMV s a => Int -> Int -> UM.MVector s a -> UM.MVector s a
gbasicUnsafeSlice i j = uncoercemv . basicUnsafeSlice #UM.MVector #(Rep_ a) #s i j . coerce
-- etc.
-- idem Vector
-- This constraints holds when the UM.MVector data instance of a is
-- representationally equivalent to the data instance of its generic
-- representation (Rep_ a).
type CMV s a = (Coercible (UM.MVector s a) (UM.MVector s (Rep_ a)), MVector UM.MVector (Rep_ a))
-- Sadly coerce doesn't seem to want to solve this correctly so we use
-- unsafeCoerce as a workaround.
uncoercemv :: CMV s a => UM.MVector s (Rep_ a) -> UM.MVector s a
uncoercemv = unsafeCoerce
Now if we have some generic type
data MyType = MyCons Int Bool ()
We can define a generic instance with its isomorphism to a tuple
instance Generic_ MyType where
type Rep_ MyType = (Int, Bool, ())
to_ (MyCons a b c) = (a, b, c)
from_ (a, b, c) = MyCons a b c
And from there, there is a totally generic recipe to get its Unbox instance, if you have YourType instead with its own Generic_ instance, you can take this and literally replace MyType with YourType.
newtype instance UM.MVector s MyType
= MVMyType { unMVMyType :: UM.MVector s (Rep_ MyType) }
instance MVector UM.MVector MyType where
basicLength = gbasicLength
basicUnsafeSlice = gbasicUnsafeSlice
-- etc.
-- idem (Vector U.Vector MyType)
-- MVector U.Vector & Vector UM.MVector = Unbox
instance Unbox MyType
In theory all this boilerplate could be automated with internal language features (as opposed to TemplateHaskell or CPP). But there are various issues that get in the way in the current state of things.
First, Generic_ is essentially Generic from GHC.Generics. However, the uniform representation that gets derived by GHC is not in terms of tuples (,) but in terms of somewhat ad-hoc type constructors (:+:, :*:, M1, etc.), which lack Unbox instances.
Such Unbox instances could be added to use Generic directly
the generics-eot has a variant of Generic relying on tuples that could be a direct replacement to Generic_ here.
And second, MVector and Vector have quite a few methods. To avoid having to list them all, one might expect to leverage DerivingVia (or GeneralizedNewtypeDeriving), however they are not applicable because there are a couple of polymorphic monadic methods that prevent coercions (e.g., basicUnsafeNew). For now, the easiest way I can think of to abstract this is a CPP macro. In fact the vector package uses that technique internally, and it might be reusable somehow. I believe properly addressing those issues requires a deep redesign of the Vector/MVector architecture.
Gist (not complete, but compilable): https://gist.github.com/Lysxia/c7bdcbba548ee019bf6b3f1e388bd660

Return `show a` if (Show a) exists, otherwise its type representation if (Typeable a)

I would like to write
class Described a where
describe :: a -> String
instance {-# OVERLAPPING #-} (Show a) => Described a where
describe = show
instance {-# OVERLAPPABLE #-} (Typeable a) => Described a where
describe = show . typeOf
This won't work because the right hand side of each instance is the same. I thought would be solved by having a look at https://wiki.haskell.org/GHC/AdvancedOverlap but it seems that I need to define instances for many existing types to make any of these solutions work. What would be the best solution here?
The standard trick for guiding instance selection is to make a new type. So:
newtype DescribeViaTypeable a = DVT a
newtype DescribeViaShow a = DVS a
instance Show a => Described (DescribeViaShow a) where describe (DVS x) = show x
instance Typeable a => Described (DescribeViaTypeable a) where describe (DVT x) = show (typeOf x)
Now callers may choose which kind of description they like if both are available, and data types can be explicit about which kind of description they expect to be available for their fields, eliminating any magic.

How to derive instances of Data.Messagepack 1.0.0

The previous version of Data.Messagepack, 0.7.2.5 supports deriving instances via Template Haskell. The current version (1.0.0), however, doesn't.
I was hence wondering if there is an alternative way to automatically derive MessagePack 1.0.0 instances, possibly using XDeriveGeneric?
As a stop-gap measure, have a look at the msgpack-aeson directory of the message-pack github repo:
https://github.com/msgpack/msgpack-haskell/tree/master/msgpack-aeson
You could go from your data values <-> aeson <-> message-pack. Not necessarily efficient, but convenient since you can auto derive ToJSON and FromJSON with DeriveGeneric.
Example code:
{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
import Data.MessagePack.Aeson
import qualified Data.MessagePack as MP
import GHC.Generics
import Data.Aeson
data Foo = Foo { _a :: Int, _b :: String }
deriving (Generic)
instance ToJSON Foo
instance FromJSON Foo
toMsgPack :: Foo -> Maybe MP.Object
toMsgPack = decode . encode
test = toMsgPack (Foo 3 "asd")
You could write your own GMessagePack class and get instances by deriving Generic. I tried doing so to answer this question, but I can't recommend it. msgpack has no support for sums, and the one sum type supported by the Haskell msgpack library, Maybe, has a very poor encoding.
instance MessagePack a => MessagePack (Maybe a) where
toObject = \case
Just a -> toObject a
Nothing -> ObjectNil
fromObject = \case
ObjectNil -> Just Nothing
obj -> fromObject obj
The encoding for Maybes can't tell the difference between Nothing :: Maybe (Maybe a) and Just Nothing :: Maybe (Maybe a), both will be encoded as ObjectNil and decoded as Nothing. If we were to impose on MessagePack instances the obvious law fromObject . toObject == pure, this instance for MessagePack would violate it.

Ignoring/Overriding an Instance generated using TemplateHaskell

I'm using Aeson for some client-server stuff that I'm doing, encoding ADTs as Json. I'm using Data.Aeson.TH to generate the toJSON instances I need, but the instances generated for Map types are really ugly and awful to deal with.
I've defined my own, simpler encoding which just treats them as lists:
instance (ToJSON a, ToJSON b) => ToJSON (Map a b) where
toJSON m = toJSON $ toList m
Naturally, when I use this in my code, I get a Duplicate instance declarations error.
Is there a way to resolve this? I need to either tell Template Haskell NOT to generate the ToJson instance for Map, or I need to tell GHC to ignore that instance and use the one I supply. Can either of these be done?
Note that this isn't an "overlapping-instances" problem. I want to completely throw out the one instance, not mix it with the other one.
To tell GHC to ignore library-provided instance and use your own instead, you can wrap Map in a newtype:
newtype PrettyMap key val = PrettyMap (Map key val)
instance (ToJSON a, ToJSON b) => ToJSON (PrettyMap a b) where
toJSON (PrettyMap m) = toJSON $ toList m
Another solution is to really use OverlappingInstances:
data MyData = ...
$(deriveToJSON ... ''MyData)
instance ToJSON (Map Text MyData) where
toJSON = toJSON . toList

Resources