I'd like to write a horribly non-parametric version of a function of type
pretty :: (Show a) => a -> Text
such that
pretty :: Text -> Text = id
pretty :: String -> Text = T.pack
pretty :: (Show a) => a -> Text = T.pack . show
So the idea is that anything that already has a Show instance can be turned into a "pretty" Text by just show-ing it, except for Text and String which we want to special-case.
The following code works:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE DataKinds, ConstraintKinds #-}
module Pretty (pretty) where
import Data.Text (Text)
import qualified Data.Text as T
type family StringLike a :: Bool where
StringLike String = True
StringLike Text = True
StringLike a = False
class (b ~ StringLike a) => Pretty' a b where
pretty' :: a -> Text
instance Pretty' String True where
pretty' = T.pack
instance Pretty' Text True where
pretty' = id
instance (Show a, StringLike a ~ False) => Pretty' a False where
pretty' = T.pack . show
type Pretty a = (Pretty' a (StringLike a))
pretty :: (Pretty a) => a -> Text
pretty = pretty'
and it can be used without exporting anything except the pretty function.
However, I am not too happy about the type signature for pretty:
pretty :: (Pretty a) => a -> Text
I feel that since StringLike is a closed type family, there should be a way for GHC to figure out that if only (Show a) holds, (Pretty a) is already satisfied, since:
The following hold trivially just by substituting the results of applying StringLike:
(StringLike String ~ True, Pretty' String True)
(StringLike Text ~ True, Pretty' Text True)
For everything else, we also know the result of applying StringLike:
(Show a, StringLike a ~ False) => (Pretty' a (StringLike a))
Is there a way to convince GHC of this?
I feel that since StringLike is a closed type family, there should be a way for GHC to figure out that if only (Show a) holds, (Pretty a) is already satisfied
To do that would require type inspection, and would break parameteric polymorphism. Consider defining a type family
type family IsInt a :: Bool where
IsInt Int = True
IsInt a = False
class (b ~ IsInt a) => TestInt a b where
isInt :: a -> Bool
instance TestInt Int True where
isInt _ = True
instance (IsInt a ~ False) => TestInt a False where
isInt _ = False
Now by your argument, GHC should be able to satisfy TestInt a from (). In other words, we should be able to test for any given type whether it is equal to Int. This is clearly impossible.
Similarly, a Show a dictionary is equivalent to a function a -> ShowS. How would you be able to decide, given just that, whether the argument is StringLike?
Maybe I misunderstood your goal but this seems like a lot of work to get the type you want.
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, UndecidableInstances, IncoherentInstances #-}
module Prettied where
import Data.Text (Text, pack)
class Pretty a where pretty :: a -> Text
instance Pretty Text where pretty = id
instance Pretty String where pretty = pack
instance Show a => Pretty a where pretty = pack . show
While it may seem that pretty should have type Pretty a => a -> Text, due to IncoherentInstances it will actually have type Show a => a -> Text. This should probably be in its own module because enabling IncoherentInstances is one of those things that can break valid code.
Related
I'm playing around with specialization of singletons:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
module Data.Test where
data SingBool (b :: Bool) where
STrue :: SingBool 'True
SFalse :: SingBool 'False
sing :: SingBool b -> Bool
sing SFalse = False
sing STrue = True
{-# SPECIALIZE sing :: SingBool 'False -> Bool #-}
This specializes to something like the following:
singSFalse :: SingBool 'False -> Bool
singSFalse SFalse = False
I'd expect it to generate an RHS of singSFalse _ = False instead.
Is that coercion unpacked only to satisfy the type-checker or is there actual runtime overhead involved in that pattern match? I imagine that GHC does not discard the pattern match on the argument to account for bottom, in order not to increase laziness. But I want to be sure before I begin to model this through Proxy + a SingI-style type class.
OK, to mostly answer my own question: Knowing that SingBool 'False only has one inhabitant is not enough for GHC to get rid of the pattern match, because we could call the function like singSFalse (error "matched"), e.g. bottom is always another inhabitant.
So, specialization (e.g. inlining based on concrete TypeApplications) does not really work well with singletons (turning those type applications into presumably constant value applications) in Haskell (lazy, non-total) w.r.t. zero cost abstractions.
However, by using a SingI-style type class with a proxy (e.g. singByProxy), we don't have the same problems:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
module Data.Test where
import GHC.Exts (Proxy#)
class SingIBool (b :: Bool) where
sing :: Proxy# b -> Bool
instance SingIBool 'False where
sing _ = False
instance SingIBool 'True where
sing _ = True
refurbulate :: SingIBool b => Proxy# b -> Int
refurbulate p
| sing p = 0
| otherwise = 1
The specialization refurbulate #(Proxy# 'False) will not only be implemented as const False, also there will not be passed any Proxy# argument at the value level, so it's rather coerce False :: Proxy# -> Bool. Neat! However, I don't get to use singletons in the real world :(
To recap why singletons fail (to get optimized) and type classes work:
By specializing the type class instance, we get to know the RHS of sing, from which we can deduce totality.
By specializing the singleton, we get to know what value the parameter evaluates to, if evaluation terminates.
Knowing the canonical RHS of a type class method x :: () is more informative than just knowing that a parameter x :: () can only evaluate to one value in a non-total, lazy (e.g. Haskell's) setting.
I'm trying to define a function that detects whether the type of an input satisfies a given constraint:
satisfies :: (c a => a -> b) -> a -> Maybe b
-- or the more general
claim :: (c => a) -> Maybe a
So the desired behaviour would be:
>>> :t satisfies #Show show
satisfies #Show show :: a -> Maybe String
>>> satisfies #Show show (0 :: Int)
Just "0"
>>> satisfies #Show show (id :: Int -> Int)
Nothing
The goal is to make it easy to define fully polymorphic functions that take
advantage of specializations when possible:
showAny :: a -> String
showAny (satisfies #Show show -> Just str) = str
showAny (satisfies #Typeable showType -> Just str) = "_ :: " ++ str
showAny _ = "_"
As the easiest thing I could try, my first attempt tried using -fdefer-to-runtime
{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
module Claim where
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Error (catchIOError)
satisfies :: (c a => a -> b) -> a -> Maybe b
satisfies f a = unsafePerformIO $
(return . Just $! f a) `catchIOError` \_ -> return Nothing
This failed because -fdefer-type-errors doesn't defer the checking to
runtime, or allow further checking to be done in the context which it is
actually used (as I had hoped), but instead at compile time replaces found
type errors with the equivalent of error "MESSAGE".
Now I'm out of ideas. Is implementing satisfies even possible?
You can't dispatch on instance availability at runtime. Remember, a constraint is translated by the compiler into a type class dictionary - a record of functions that is passed around explicitly and accessed explicitly at runtime. The "fat arrow" => is represented at runtime by a "thin arrow" ->, so the elaborator needs to know at compile time which dictionary to pass around.
That is, the following crude example:
class Show a where
show :: a -> String
instance Show String where
show = id
showTwice :: Show a => a -> String
showTwice x = show x ++ show x
main = putStrLn $ showTwice "foo"
generates Core code which looks approximately like:
data Show_ a = Show_ { show :: a -> String }
showString_ :: Show_ String
showString_ = Show_ { show = id }
showTwice :: Show_ a -> a -> String
showTwice show_ x = show show_ x ++ show show_ x
main = putStrLn $ showTwice showString_ "foo"
When generating code for main, the compiler needs to know where to find showString_.
You can imagine a system wherein you can look up a type class dictionary at runtime with some sort of introspection mechanism, but this would produce weird behaviour from a language design perspective. The problem is orphan instances. If I write a function which attempts to look up a given instance in module A, and define such an instance in an unrelated module B, then the behaviour of that function when called from some client module C depends on whether B was imported by some other part of the program. Pretty strange!
A more usual way of doing "fully polymorphic functions that take advantage of specializations when possible" would be to put the function in question into a type class itself and give it a default implementation (perhaps with a default signature if the default implementation depends on some superclass). Your showAny would then look like this:
{-# LANGUAGE DefaultSignatures #-}
import Data.Typeable
class ShowAny a where
showAny :: a -> String
default showAny :: Typeable a => a -> String
showAny x = "_ :: " ++ show (typeOf x)
You'd need to implement ShowAny for all of the types with which you want to use showAny, but that's usually a single line of code,
instance (Typeable a, Typeable b) => ShowAny (a -> b)
and you can specialise an implementation for a given type just by overriding showAny.
instance ShowAny String where
showAny = id
You see this approach quite frequently in libraries which do generic programming. aeson, for example, can use GHC.Generics to serialise a given type to and from JSON (all you have to do is derive Generic and write two lines instance ToJSON MyType; instance FromJSON MyType), but you can also write your own instances of ToJSON and FromJSON if the generic code isn't fast enough or you need to customise the output.
An alternate workaround to the accepted answer is to pass the dictionaries around manually.
That is, given:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
module Claim where
data Proof c where QED :: c => Proof c
type Claim c = Maybe (Proof c)
type c ? a = Maybe (Proof (c a))
One can write:
showAny :: (Show? a, Typeable? a) -> a -> String
showAny (Just QED, _) a = show a
showAny (_, Just QED) a = "_ :: " ++ showType a
showAny _ _ = "_"
Which works accepably well:
>>> showAny (Nothing, Just QED) (id :: Int -> Int)
"_ :: Int -> Int"
>>> showAny (Just QED, Just QED) (0 :: Int)
"0"
>>> showAny (Nothing, Nothing) undefined
"_"
Below is a perhaps silly example, but I think solving this will solve another problem I have, detailed in this question.
I want to write a function with this signature:
myread :: (Read a) => String -> a
such that, myread = read, except when a ~ Int, in which case myread _ = 0.
Obviously this function is silly itself, but the point is I want to optimise based on return type.
Rewrite rules, or anything is fine here. For my actual problem, if the solution is a rewrite rule, it doesn't matter if there's cases where it doesn't fire, but I'd like the answer to at least give an example where it does.
You can do this directly with rewrite rules, in (perhaps) the obvious way, if you recall that the left hand side of a rule is in an expression context, not in a pattern context. In particular, type applications in the left hand side are perfectly valid.
{-# LANGUAGE TypeApplications #-}
module A where
{-# INLINE [1] myread #-}
{-# RULES "myread" forall s . myread #Int s = 0 #-}
myread :: Read a => String -> a
myread = read
Even without type applications, the following is also perfectly valid (but may not be in general, e.g. if the output type was f a and you wanted to 'optimize' only f, you could not have .. = (result :: [ _ ])):
{-# RULES "myread" forall s . myread s = (0 :: Int) #-}
And as an example use
module B where
import A
fun :: String -> String -> (Int, Bool)
fun x y = (myread x, myread y)
The proof that the rule fires is always to look at core, of course (irrelevant bits omitted):
fun4 :: Int
fun4 = I# 0#
fun :: String -> String -> (Int, Bool)
fun =
\ _ (w1 :: String) ->
(fun4,
case readEither6 (run fun3 w1) of _ {
[] -> fun2;
: x ds ->
case ds of _ {
[] -> x;
: ipv ipv1 -> fun1
}
})
Note, this is really a comment and not an answer simply because I'm not sure what exactly the goal is, but the code wouldn't fit a comment.
How about defining a new class with undecidable instances?
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
class MyRead a where
myread :: String -> a
instance {-# OVERLAPPABLE #-} Read a => MyRead a where
myread = read
instance MyRead Int where
myread = const 0
main = do
print $ (myread "True" :: Bool) -- True
print $ (myread "\"string\"" :: String) -- "string"
print $ (myread "12" :: Int) -- 0
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
I'd like a variant of show (let's call it label) that acts just like show, except that it doesn't wrap Strings in " " or Chars in ' '. Examples:
> label 5
"5"
> label "hello"
"hello"
> label 'c'
"c"
I tried implementing this manually, but I ran into some walls. Here is what I tried:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Label where
class (Show a) => Label a where
label :: a -> String
instance Label [Char] where
label str = str
instance Label Char where
label c = [c]
-- Default case
instance Show a => Label a where
label x = show x
However, because the default case's class overlaps instance Label [Char] and instance Label Char, those types don't work with the label function.
Is there a library function that provides this functionality? If not, is there a workaround to get the above code to work?
The code above isn't going to work because instances are chosen only based on the "head", that is, the part after the class name. The "context", the stuff before the => such as `Show a' is only examined afterwards. The context can eliminate an instance and produce a compiler error, but not cause the compiler to pick a different instance. Because of this behavior, overlapping instances are a potential ambiguity.
There are compiler extensions that can let you write more complicated instances, but I suspect you're probably best off just writing individual instances of your Label class. What purpose do you have in mind for this? Depending on what you're trying to accomplish, there might be something more special-purpose already out there.
Your example code is pretty simple, though--if you want, simply adding the OverlappingInstances extension should make it work with no further modifications. Using OverlappingInstances causes GHC to tolerate some ambiguity, so long as there's an obvious "most specific" instance. In your code, the two instances with concrete types are as specific as it gets, so there shouldn't be any problems.
Might as well add TypeSynonymInstances while you're at it, for better readability:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Label where
class (Show a) => Label a where
label :: a -> String
instance Label String where label x = x
instance Label Char where label x = [x]
instance (Show a) => Label a where label = show
There's an OverlappingInstances language extension which will make this work.
Is there a library function that provides this functionality?
Yes. There's a fairly new library that provides helpful functions, such as toS, which can be used similarly to show. (see docs)
It can be installed with cabal under the string-conv package like so: cabal install string-conv
Reference:
Hackage
Not really what you want, since it adds an extra constraint to the type (Typeable)
but this is how you could do it generically:
Data.Generics> (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String)) 1
"1"
Data.Generics> (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String)) "hello"
"hello"
Data.Generics> (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String)) 'c'
"c"
Data.Generics> (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String)) ['f','l']
"fl"
Data.Generics> :t (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String))
(show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String))
:: (Show a, Typeable a) => a -> String