Haskell: Encouraging GHC to infer the correct intermediate type

Question

I thought it'd be neat to allow arbitrary chained comparison in Haskell, so you could do simple range checks like:

x <= y < z

And more complex stuff like

x /= y < z == a

Where the above two are semantically equivalent to

x <= y && y < z
x /= y && y < z && z == a

Just seeing if I could get the syntax to work.

So I got most of the way there using a couple of type classes:

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module ChainedOrd where

import Prelude hiding ((<), (<=), (>), (>=), (==), (/=))

class Booly v a where
  truthy :: v -> a
  falsy :: v -> a

instance Booly a Bool where
  truthy = const True
  falsy = const False

instance Booly a (Maybe a) where
  truthy = Just
  falsy = const Nothing

class ChainedOrd a b where
  (<),(>),(<=),(>=),(==),(/=) :: (Booly b c) => a -> b -> c

infixl 4 <
infixl 4 >
infixl 4 <=
infixl 4 >=
infixl 4 ==
infixl 4 /=

instance Ord a => ChainedOrd a a where
  x < y     = case compare x y of LT -> truthy y ; _ -> falsy y
  x > y     = case compare x y of GT -> truthy y ; _ -> falsy y
  x <= y    = case compare x y of GT -> falsy y  ; _ -> truthy y
  x >= y    = case compare x y of LT -> falsy y  ; _ -> truthy y
  x == y    = case compare x y of EQ -> truthy y ; _ -> falsy y
  x /= y    = case compare x y of EQ -> falsy y  ; _ -> truthy y

instance Ord a => ChainedOrd (Maybe a) a where
  Just x < y     = case compare x y of LT -> truthy y ; _ -> falsy y
  Nothing < y    = falsy y
  Just x > y     = case compare x y of GT -> truthy y ; _ -> falsy y
  Nothing > y    = falsy y
  Just x <= y    = case compare x y of GT -> falsy y  ; _ -> truthy y
  Nothing <= y   = falsy y
  Just x >= y    = case compare x y of LT -> falsy y  ; _ -> truthy y
  Nothing >= y   = falsy y
  Just x == y    = case compare x y of EQ -> truthy y ; _ -> falsy y
  Nothing == y   = falsy y
  Just x /= y    = case compare x y of EQ -> falsy y  ; _ -> truthy y
  Nothing /= y   = falsy y

Which compiles fine, but doesn't quite seem to allow chaining, due to the problem of intermediate types.

-- works
checkRange1 :: Ord a => a -> a -> a -> Bool
checkRange1 x y z = x `lem` y <= z
  where lem :: Ord a => a -> a -> Maybe a
        lem = (<=)

-- works
checkRange2 :: Ord a => a -> a -> a -> Bool
checkRange2 x y z = (x <= y) `leb` z
  where leb :: Ord a => Maybe a -> a -> Bool
        leb = (<=)

checkRange1 and checkRange2 work fine, since they both put a constraint on the intermediate type (either as a result of the first comparison, or as an argument to the second).

-- error
checkRange3 :: Ord a => a -> a -> a -> Bool
checkRange3 x y z = (x <= y) <= z

When I try to let the compiler infer the intermediate type, though, it barks at me.

ChainedOrd.hs:64:30:
    Ambiguous type variable `a0' in the constraints:
      (ChainedOrd a0 a) arising from a use of `<='
                        at ChainedOrd.hs:64:30-31
      (Booly a a0) arising from a use of `<=' at ChainedOrd.hs:64:24-25
    Probable fix: add a type signature that fixes these type variable(s)
    In the expression: (x <= y) <= z
    In an equation for `checkRange3': checkRange3 x y z = (x <= y) <= z

Is there any way I can convince the compiler that it should use Maybe a as the intermediate type a0 satisifying Booly a a0, ChainedOrd a0 a, since that's the only instance it knows about?

Failing that, is there another way I can make arbitrary comparison chaining work?

Answer 1

infixl 4 ==?

class ChainedEq a b where
  (==?) :: a -> b -> Maybe b

instance (Eq a) => ChainedEq (Maybe a) a where
  x ==? y = if x == Just y
    then x
    else Nothing

instance (Eq a) => ChainedEq a a where
  x ==? y = if x == y
    then Just x
    else Nothing

unChain :: Maybe a -> Bool
unChain Nothing = False
unChain (Just _) = True

test :: Int -> Int -> Int -> Bool
test x y z = unChain $ x ==? y ==? z

Answer 2

There are ways to tell the compiler which type to use,

checkRange4 x y z = ((x <= y) `asTypeOf` Just x) <= z

or you can use ScopedTypeVariables, bring the type variable into scope and put a type signature on x <= y. But you can't tell the compiler to use the only instances it knows about. The compiler operates on an open world assumption, other instances may be defined, and the code has to work if they are and come into scope. So whatever you do will be more clunky than

checkRange5 x y z = x <= y && y <= z

Answer 3

Here's how I would do it:

{-# LANGUAGE NoMonomorphismRestriction #-}

data Chain v e = Link { evaluation :: e
                      , val :: v
                      , next :: Chain v e
                      }
               | Start { val :: v }


liftChain :: (a -> a -> b) -> Chain a b -> a -> Chain a b
liftChain f ch x = Link { evaluation = val ch `f` x, val = x, next = ch }

(.<)  = liftChain (<)
(.>)  = liftChain (>)
(.<=) = liftChain (<=)
(.>=) = liftChain (>=)
(.==) = liftChain (==)

toList :: Chain v e -> [v]
toList (Start v) = [v]
toList (Link _ v n) = v : toList n

toList' :: Chain v e -> [e]
toList' (Start _) = []
toList' (Link e _ n) = e : toList' n

and' :: Chain v Bool -> Bool
and' = and . toList'

Usage:

ghci> and' $ Start 3 .< 4 .< 7 .== 7 .< 9 .>= 0 .== (2-2)
True

Answer 4

It gave me no rest that this couldn't seem to be expressible without awkward terminating/unpacking functions. What I came up with to allow purely infix-chained expressions:

{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE TypeFamilies              #-}

module ChainedComp where

infixl 4 ==.. , .==. , ==?

data Comp1Chain a = Sofar1OK a | Already1Failed
data Comp2Chain a = Sofar2OK a | Already2Failed
data Comp3Chain a = Sofar3OK a | Already3Failed
-- ...

(==..) :: (Eq a) => a -> a -> Comp1Chain a
x==..y | x==y       = Sofar1OK y
       | otherwise  = Already1Failed

class ChainableComp c where
  type AppendElem c :: *
  type ChainAfterAppend c :: *
  (.==.) :: c -> AppendElem c -> ChainAfterAppend c
  (==?) :: c -> AppendElem c -> Bool


instance (Eq a) => ChainableComp (Comp1Chain a) where
  type AppendElem (Comp1Chain a) = a
  type ChainAfterAppend (Comp1Chain a) = Comp2Chain a
  chn.==.y | (Sofar1OK x)<-chn, x==y  = Sofar2OK x
           | otherwise                = Already2Failed
  chn==?y | (Sofar1OK x)<-chn, x==y  = True
          | otherwise                = False
instance (Eq a) => ChainableComp (Comp2Chain a) where
  type AppendElem (Comp2Chain a) = a
  type ChainAfterAppend (Comp2Chain a) = Comp3Chain a
  chn.==.y | (Sofar2OK x)<-chn, x==y  = Sofar3OK x
           | otherwise                = Already3Failed
  chn==?y | (Sofar2OK x)<-chn, x==y  = True
          | otherwise                = False
-- ...

And with that, you can write

*ChainedComp> 7 ==..7.==.7==? 7
True
*ChainedComp> 7 ==..7.==.6==? 7
False
*ChainedComp> 5 ==..5.==.5.==.4.==.5.==.5==? 5
False

Not exactly beautiful, either, but IMO better readable than the other solutions. The amount of necessary instance declarations is of course not so nice, but it's once-and-for-all, so I suppose that's not too bad.