Can you "partially" derive a Typeclass? - haskell

In the following toy example we create a new type D for which we want to implement the typeclass Show. Now let's say for all constructors the derived show function would be just fine, except for one special case A for which we want to override that default.
Is it possible to do that, or can you just have all or none of them derived?
data D = A | B | C
deriving (Show)
-- goal:
-- show A = "A is special"
-- show B = "B"
-- show C = "C"
main = print $ show A
Try it online!

This can be done using generics. generic-data provides a default implementation of showsPrec, gshowsPrec, and you can use pattern-matching to handle non-default cases before it:
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
import Generic.Data (gshowsPrec)
data D = A | B | C
deriving (Generic)
instance Show D where
showsPrec _ A = ("A is special" ++)
showsPrec n x = gshowsPrec n x

Related

Haskell instance: how could this be some valid code?

While I was writing a small example of the Show instance, I had made an indentation error:
module Main where
data B= B0|B1
instance Show B where
show B0="0"
show B1="1"
main=print B0
Where, clearly, the working code is:
module Main where
data B= B0|B1
instance Show B where
show B0="0"
show B1="1"
main=print B0
I was expecting to get a compile error on the first one, but instead I could run it and it ended up in:
example.hs: stack overflow
Why does this code even compile?
Also, why is this a runtime error only (which, if stack is unconstrained, fills up your RAM) and not a compilation error?
The body of an instance can be empty. You can leave out the where clause:
instance Show B
but you can also include it:
instance Show B where
-- nothing here
This can be useful for type classes that provide default implementations for the methods, perhaps based on generic programming facilities. For example, with the aeson package, the usual way of defining instances to convert to and from JSON is to use generics and empty instances:
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
data Person = Person {
name :: Text
, age :: Int
} deriving (Generic, Show)
-- these empty instances use Generics to provide a default implementation
instance ToJSON Person
instance FromJSON Person
In your program, by leaving out the indentation, you've defined an instance Show B with no method definitions (and -Wall would generate a "missing method" warning telling you that it did not meet the minimal requirements for the instance). The unindented show is providing a new top-level definition for show, unrelated to the show in the Show type class.
You haven't used show explicitly. Instead, you've used it implicitly via print, which always calls the show from the type class, ignoring your top-level definition, so your crashing program is equivalent to:
data B = B0 | B1
instance Show B
main = print B0
This generates a stack overflow because there are default definitions of show and showsPrec that are used when no specific instances are given:
show x = shows x ""
showsPrec _ x s = show x ++ s
which operate together with the top-level function shows (not part of the type class):
shows = showsPrec 0
This works great when at least one of show or showsPrec is defined in the instance, and then the other gets a sensible definition, but if neither is defined, this creates an infinite recursive loop between these three functions.
Also, note that the following program would tell you show was ambiguous which would make it clearer what was going on.
module Main where
data B= B0|B1
instance Show B where
show B0="0"
show B1="1"
main=putStrLn (show B0) -- instead of print
Since you did not indent show, it means this does not belong to the instance for Show, you program is thus equivalent to:
instance Show B where -- ← no implementations
show B0 = "0"
show B1 = "1"
You here thus construct another function show, that has nothing to do with the Show typeclass, but simply has the same name.
Show defines three functions showsPrec :: Show a => Int -> a -> String -> String, show :: a -> String -> String, and showList :: [a] -> String -> String. showsPrec is often used since it has a precedence system to use parenthesis.
As a result show is impelemented in terms of showsPrec and showsPrec is implemented in terms of show:
class Show a where
{-# MINIMAL showsPrec | show #-}
-- …
showsPrec :: Int
-> a
-> ShowS
-- …
show :: a -> String
-- …
showList :: [a] -> ShowS
showsPrec _ x s = show x ++ s
show x = shows x ""
showList ls s = showList__ shows ls s
-- …
shows :: (Show a) => a -> ShowS
shows = showsPrec 0
It is thus sufficient to implement showsPrec or show, that is why there is a {-# MINIMUM showsPrec | show #-} pragma at the top of the type class.
If you do not implement any of the two, then the compiler will raise a warning, and use thus the basic implementations, but that will lead to nothing, since show will call showPrec, which will then call show, until eventually the stack is exhausted.

How to convert arbitrary type to string, without adding extra quotes to strings?

I want to define a function which converts to strings, like the following 'toString':
toString 1 = "1"
toString True = "True"
toString "1" = "1"
Note that 'show' does not do this. By contrast it does the following:
show 1 = "1"
show True = "True"
show "1" = "\"1\""
That is, it adds extra quotes around strings. In this case I don't want to add extra quotes if I already have a string.
I'm considering using something like:
import Data.Typeable
toString a :: (Show a) => a -> String
toString a
| typeOf a == typeOf "" = a
| otherwise = show a
Are there any pitfalls in doing such a weird type-based conditional? Is there some built-in Haskell function that would be better to use instead?
This sort of ad-hoc polymorphism is permitted through type-classes. However, they will have to be overlapping since you want a catch all case:
{-# LANGUAGE FlexibleInstances, UndecideableInstances #-}
class Print a where
makeString :: a -> String
instance {-# OVERLAPPING #-} Print String where
makeString s = s
instance Show a => Print a where
makeString x = show x
Then, your function is makeString :: Print a => a -> String and it has an instance for everything that has a Show instance. To have the second instance, you need FlexibleInstances (the instance head is not of the usual form) and UndecideableInstances (since the constraint is as general as the instance head, GHC can't be sure that it won't fall into an infinite loop trying to solve these constraints).
If you want something like Alec's approach without overlapping instances, you can get it with a type family.
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, FlexibleInstances, DataKinds, ... whatever else GHC tells you it needs #-}
import Data.Text (Text, unpack)
import Data.Proxy
class Print a where
makeString :: a -> String
data Name = NString | NText | NShow
type family Choose a where
Choose [Char] = 'NString
Choose Text = 'NText
Choose _ = 'NShow
class Print' (n :: Name) a where
makeString' :: proxy n -> a -> String
instance (Choose a ~ n, Print' n a) => Print a where
makeString = makeString' (Proxy :: Proxy n)
instance a ~ String => Print' 'NString a where
makeString' _ = id
instance a ~ Text => Print' 'NText a where
makeString' _ = unpack
instance Show a => Print' 'NShow a where
makeString' _ = show
Expanding the OP solution attempt into a working one:
import Data.Typeable
toString :: (Show a, Typeable a) => a -> String
toString x = case cast x of
Just y -> y
Nothing -> show x

Test if a value matches a constructor

Say I have a data type like so:
data NumCol = Empty |
Single Int |
Pair Int Int |
Lots [Int]
Now I wish to filter out the elements matching a given constructor from a [NumCol]. I can write it for, say, Pair:
get_pairs :: [NumCol] -> [NumCol]
get_pairs = filter is_pair
where is_pair (Pair _ _) = True
is_pair _ = False
This works, but it's not generic. I have to write a separate function for is_single, is_lots, etc.
I wish instead I could write:
get_pairs = filter (== Pair)
But this only works for type constructors that take no arguments (i.e. Empty).
So the question is, how can I write a function that takes a value and a constructor, and returns whether the value matches the constructor?
At least get_pairs itself can be defined relatively simply by using a list comprehension to filter instead:
get_pairs xs = [x | x#Pair {} <- xs]
For a more general solution of matching constructors, you can use prisms from the lens package:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
import Control.Lens.Extras (is)
data NumCol = Empty |
Single Int |
Pair Int Int |
Lots [Int]
-- Uses Template Haskell to create the Prisms _Empty, _Single, _Pair and _Lots
-- corresponding to your constructors
makePrisms ''NumCol
get_pairs :: [NumCol] -> [NumCol]
get_pairs = filter (is _Pair)
Tags of tagged unions ought to be first-class values, and with a wee bit of effort, they are.
Jiggery-pokery alert:
{-# LANGUAGE GADTs, DataKinds, KindSignatures,
TypeFamilies, PolyKinds, FlexibleInstances,
PatternSynonyms
#-}
Step one: define type-level versions of the tags.
data TagType = EmptyTag | SingleTag | PairTag | LotsTag
Step two: define value-level witnesses for the representability of the type-level tags. Richard Eisenberg's Singletons library will do this for you. I mean something like this:
data Tag :: TagType -> * where
EmptyT :: Tag EmptyTag
SingleT :: Tag SingleTag
PairT :: Tag PairTag
LotsT :: Tag LotsTag
And now we can say what stuff we expect to find associated with a given tag.
type family Stuff (t :: TagType) :: * where
Stuff EmptyTag = ()
Stuff SingleTag = Int
Stuff PairTag = (Int, Int)
Stuff LotsTag = [Int]
So we can refactor the type you first thought of
data NumCol :: * where
(:&) :: Tag t -> Stuff t -> NumCol
and use PatternSynonyms to recover the behaviour you had in mind:
pattern Empty = EmptyT :& ()
pattern Single i = SingleT :& i
pattern Pair i j = PairT :& (i, j)
pattern Lots is = LotsT :& is
So what's happened is that each constructor for NumCol has turned into a tag indexed by the kind of tag it's for. That is, constructor tags now live separately from the rest of the data, synchronized by a common index which ensures that the stuff associated with a tag matches the tag itself.
But we can talk about tags alone.
data Ex :: (k -> *) -> * where -- wish I could say newtype here
Witness :: p x -> Ex p
Now, Ex Tag, is the type of "runtime tags with a type level counterpart". It has an Eq instance
instance Eq (Ex Tag) where
Witness EmptyT == Witness EmptyT = True
Witness SingleT == Witness SingleT = True
Witness PairT == Witness PairT = True
Witness LotsT == Witness LotsT = True
_ == _ = False
Moreover, we can easily extract the tag of a NumCol.
numColTag :: NumCol -> Ex Tag
numColTag (n :& _) = Witness n
And that allows us to match your specification.
filter ((Witness PairT ==) . numColTag) :: [NumCol] -> [NumCol]
Which raises the question of whether your specification is actually what you need. The point is that detecting a tag entitles you an expectation of that tag's stuff. The output type [NumCol] doesn't do justice to the fact that you know you have just the pairs.
How might you tighten the type of your function and still deliver it?
One approach is to use DataTypeable and the Data.Data module. This approach relies on two autogenerated typeclass instances that carry metadata about the type for you: Typeable and Data. You can derive them with {-# LANGUAGE DeriveDataTypeable #-}:
data NumCol = Empty |
Single Int |
Pair Int Int |
Lots [Int] deriving (Typeable, Data)
Now we have a toConstr function which, given a value, gives us a representation of its constructor:
toConstr :: Data a => a -> Constr
This makes it easy to compare two terms just by their constructors. The only remaining problem is that we need a value to compare against when we define our predicate! We can always just create a dummy value with undefined, but that's a bit ugly:
is_pair x = toConstr x == toConstr (Pair undefined undefined)
So the final thing we'll do is define a handy little class that automates this. The basic idea is to call toConstr on non-function values and recurse on any functions by first passing in undefined.
class Constrable a where
constr :: a -> Constr
instance Data a => Constrable a where
constr = toConstr
instance Constrable a => Constrable (b -> a) where
constr f = constr (f undefined)
This relies on FlexibleInstance, OverlappingInstances and UndecidableInstances, so it might be a bit evil, but, using the (in)famous eyeball theorem, it should be fine. Unless you add more instances or try to use it with something that isn't a constructor. Then it might blow up. Violently. No promises.
Finally, with the evil neatly contained, we can write an "equal by constructor" operator:
(=|=) :: (Data a, Constrable b) => a -> b -> Bool
e =|= c = toConstr e == constr c
(The =|= operator is a bit of a mnemonic, because constructors are syntactically defined with a |.)
Now you can write almost exactly what you wanted!
filter (=|= Pair)
Also, maybe you'd want to turn off the monomorphism restriction. In fact, here's the list of extensions I enabled that you can just use:
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, NoMonomorphismRestriction, OverlappingInstances, UndecidableInstances #-}
Yeah, it's a lot. But that's what I'm willing to sacrifice for the cause. Of not writing extra undefineds.
Honestly, if you don't mind relying on lens (but boy is that dependency a doozy), you should just go with the prism approach. The only thing to recommend mine is that you get to use the amusingly named Data.Data.Data class.

Case between two unrelated types in Haskell

Is it possible to use case expression between two unrelated types in Haskell, like in this example (not working) code:
data A = A
data B = B
f x = case x of
A -> 1
B -> 2
main = do
print $ test A
return ()
I know I can use Either here, but this code is not meant to be used - I want to deeply learn the Haskell type system and see what could be done.
A and B are distinct types. If you want a function that can take values of multiple types, you need a typeclass.
data A = A
data B = B
class F a where
f :: a -> Int
instance F A where
f _ = 1
instance F B where
f _ = 2
main = do
print $ f A
No, this is not possible with a normal case statement, but you can hack this sort of thing using type classes:
data A = A
data B = B
class Test a where
test :: a -> Int
instance Test A where test = const 1
instance Test B where test = const 2
main = print $ test A
But you should only use this if it's really required, as it gets messy very soon and you end up with needing a lots of extensions to the type system (UndecidableInstances, OverlappingInstances, ...)
Rather than writing your own type class for f, you could use the Typeable
class which has some support by ghc. You don't need to use Dynamic here, but in
some cases it is needed.
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Dynamic
data A = A deriving (Typeable)
data B = B deriving (Typeable)
f x | Just A <- fromDynamic x = 1
| Just B <- fromDynamic x = 2
f2 x | Just A <- cast x = 1
| Just B <- cast x = 2
main = do
print $ f (toDyn A)
print $ f2 A

General conversion type class

I'd like to see if it is feasible to have a type class for converting one thing into another and back again from a mapping of [(a,b)].
This example should illustrate what I'd like to do:
data XX = One | Two | Three deriving (Show, Eq)
data YY = Eno | Owt | Eerht deriving (Show, Eq)
instance Convert XX YY where
mapping = [(One, Eno), (Two, Owt), (Three, Eerht)]
-- // How can I make this work?:
main = do print $ (convert One :: YY) -- Want to output: Eno
print $ (convert Owt :: XX) -- Want to output: Two
Here's my stab at making this work:
{-# LANGUAGE MultiParamTypeClasses #-}
import Data.Maybe(fromJust)
lk = flip lookup
flipPair = uncurry $ flip (,)
class (Eq a, Eq b) => Convert a b where
mapping :: [(a, b)]
mapping = error "No mapping defined"
convert :: a -> b
convert = fromJust . lk mapping
-- // This won't work:
instance (Convert a b) => Convert b a where
convert = fromJust . lk (map flipPair mapping)
It is easy to do this with defining two instances for the conversion going either way but I'd like to only have to declare one as in the first example. Any idea how I might do this?
Edit: By feasible I mean, can this be done without overlapping instances any other nasty extensions?
I, er... I almost hate to suggest this, because doing this is kinda horrible, but... doesn't your code work as is?
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverlappingInstances #-}
import Data.Maybe(fromJust)
lk x = flip lookup x
flipPair = uncurry $ flip (,)
class (Eq a, Eq b) => Convert a b where
mapping :: [(a, b)]
mapping = error "No mapping defined"
convert :: a -> b
convert = fromJust . lk mapping
instance (Convert a b) => Convert b a where
convert = fromJust . lk (map flipPair mapping)
data XX = One | Two | Three deriving (Show, Eq)
data YY = Eno | Owt | Eerht deriving (Show, Eq)
instance Convert XX YY where
mapping = [(One, Eno), (Two, Owt), (Three, Eerht)]
main = do print $ (convert One :: YY)
print $ (convert Owt :: XX)
And:
[1 of 1] Compiling Main ( GeneralConversion.hs, interpreted )
Ok, modules loaded: Main.
*Main> main
Eno
Two
*Main>
I'm not sure how useful such a type class is, and all the standard disclaimers about dubious extensions apply, but that much seems to work. Now, if you want to do anything fancier... like Convert a a or (Convert a b, Convert b c) => Convert a c... things might get awkward.
I suppose I might as well leave a few thoughts about why I doubt the utility of this:
In order to use the conversion, both types must be unambiguously known; likewise, the existence of a conversion depends on both types. This limits how useful the class can be for writing very generic code, compared to things such as fromIntegral.
The use of error to handle missing conversions, combined with the above, means that any allegedly generic function using convert will be a seething pit of runtime errors just waiting to happen.
To top it all off, the generic instance being used for the reversed mapping is in fact a universal instance, only being hidden by overlapped, more specific instances. That (Convert a b) in the context? That lets the reversed mapping work, but doesn't restrict it to only reversing instances that are specifically defined.

Resources