[Haskell-cafe] Proposal: Generic conditions for 'if' and 'case'
Nicolas Trangez
nicolas at incubaid.com
Mon Sep 2 14:28:47 CEST 2013
On Sun, 2013-09-01 at 15:51 -0700, Wvv wrote:
> I think it is an old idea, but nevertheless.
> Now we have next functions:
>
> if (a :: Bool) then x else y
>
> case b of
> a1 :: Bool -> x1
> a2 :: Bool -> x2
> ...
>
> Let we have generic conditions for 'if' and 'case':
>
> class Boolean a where
> toBool :: a -> Bool
>
> instance Boolean Bool where
> toBool = id
>
> instance Boolean [a] where
> toBool [] = False
> toBool _ = True
>
> instance Boolean (Maybe a) where
> toBool Nothing = False
> toBool _ = True
>
> instance Boolean Int where
> toBool 0 = False
> toBool _ = True
>
> if' (a :: Boolean b) then x else y
>
> case' d of
> a1 :: Boolean b1 -> x1
> a2 :: Boolean b2 -> x2
> ...
>
>
> It is very easy to implement to desugar:
> if' a then ... == if toBool ( a ) then ...
I wasn't at my computer when I sent my previous reply, so here's a more
full-fledged answer:
This is possible using the RebindableSyntax extension. Make sure to read
the documentation of the extension before using it, it might have some
unexpected implications.
Be careful when using this scheme as well... I'd think lots of
Haskell'ers would frown upon this kind of implicit conversions (they
remind me of Python and its __nonzero__ stuff).
Here's an example implementing your proposal:
{-# LANGUAGE RebindableSyntax #-}
import Prelude
class Boolean a where
toBool :: a -> Bool
instance Boolean Bool where
toBool = id
instance Boolean [a] where
toBool = not . null
instance Boolean (Maybe a) where
toBool = maybe False (const True)
instance Boolean Int where
toBool = (/= 0)
ifThenElse :: Boolean a => a -> b -> b -> b
ifThenElse i t e = case toBool i of
True -> t
False -> e
main :: IO ()
main = do
test False
test ([] :: [Int])
test [1]
test (Nothing :: Maybe Int)
test (Just 1 :: Maybe Int)
test (0 :: Int)
test (1 :: Int)
{- test 'c' fails to type-check: no instance Boolean Char defined!
-}
where
test v = putStrLn $ show v ++ " is " ++ (if v then "true" else
"false")
which outputs
False is false
[] is false
[1] is true
Nothing is false
Just 1 is true
0 is false
1 is true
Using RebindableSyntax, 'if I then T else E' is rewritten into
'ifThenElse I T E' by the compiler, for whatever 'ifThenElse' is in
scope.
Nicolas
More information about the Haskell-Cafe
mailing list