Adding an Ord instance to 'singleton' package generated naturals

Question

I am using very simple type-level naturals generated with the singletons package. I am now trying to add an Ord instance to them.

{-# LANGUAGE MultiParamTypeClasses, TemplateHaskell, KindSignatures, DataKinds, ScopedTypeVariables, GADTs, TypeFamilies, FlexibleInstances, TypeOperators, UndecidableInstances, InstanceSigs #-}

module Functions where

import Data.Singletons
import Data.Singletons.TH
import Data.Singletons.Prelude
import Data.Promotion.Prelude

singletons [d|
             data Nat = Z | S Nat
               deriving Eq

             instance Ord Nat where
               (<=)    Z     _  = True
               (<=) (S _)    Z  = False
               (<=) (S n) (S m) = n <= m
             |]

I have been hitting one error after the other. The latest one is:

src/Functions.hs:10:1:
    Couldn't match kind ‘Nat’ with ‘*’
    When matching types
      n0 :: Nat
      t1 :: *
    Expected type: Sing t1
      Actual type: Sing n0
    Relevant bindings include
      n_a9na :: Sing n0 (bound at src/Functions.hs:10:1)
      lambda :: Sing n0 -> Sing m0 -> Sing (Apply (Apply (:<=$) t00) t10)
        (bound at src/Functions.hs:10:1)
    In the second argument of ‘applySing’, namely ‘n_a9na’
    In the first argument of ‘applySing’, namely
      ‘applySing (singFun2 (Proxy :: Proxy (:<=$)) (%:<=)) n_a9na’

src/Functions.hs:10:1:
    Could not deduce (SOrd 'KProxy) arising from a use of ‘%:<=’
    from the context (t00 ~ 'S n)
      bound by a pattern with constructor
                 SS :: forall (z_a9mg :: Nat) (n_a9mh :: Nat).
                       (z_a9mg ~ 'S n_a9mh) =>
                       Sing n_a9mh -> Sing z_a9mg,
               in an equation for ‘%:<=’
      at src/Functions.hs:(10,1)-(18,15)
    or from (t10 ~ 'S n1)
      bound by a pattern with constructor
                 SS :: forall (z_a9mg :: Nat) (n_a9mh :: Nat).
                       (z_a9mg ~ 'S n_a9mh) =>
                       Sing n_a9mh -> Sing z_a9mg,
               in an equation for ‘%:<=’
      at src/Functions.hs:(10,1)-(18,15)
    or from (t00 ~ Apply SSym0 n0, t10 ~ Apply SSym0 m0)
      bound by the type signature for
                 lambda_a9n9 :: (t00 ~ Apply SSym0 n0, t10 ~ Apply SSym0 m0) =>
                                Sing n0 -> Sing m0 -> Sing (Apply (Apply (:<=$) t00) t10)
      at src/Functions.hs:(10,1)-(18,15)
    In the second argument of ‘singFun2’, namely ‘(%:<=)’
    In the first argument of ‘applySing’, namely
      ‘singFun2 (Proxy :: Proxy (:<=$)) (%:<=)’
    In the first argument of ‘applySing’, namely
      ‘applySing (singFun2 (Proxy :: Proxy (:<=$)) (%:<=)) n_a9na’

Does anyone have an idea what the correct way to do this is?

Answer 1

I'm not sure why this is failing. I am equally puzzled by a similar failure I get when implementing compare instead, and even more puzzled by the failure I get when trying the (seemingly simple)

singletons [d| data Nat = Z | S Nat deriving (Eq,Ord) |]

My guess is that something in Ord is off... However, this works. I'm gonna try to take a look at the guts of singleton later.

singletons [d|
              data Nat = Z | S Nat
                 deriving (Eq)

              instance Ord Nat where
                compare = compare'

              compare' :: Nat -> Nat -> Ordering
              compare' Z Z  = EQ
              compare' (S _) Z = GT
              compare' Z (S _) = LT
              compare' (S n) (S m) = compare' n m
             |] 

By the way, I'm using GHC 8.0 here.

EDIT

After poking around in singletons, I've found the real source of problems (and been blown away with how much type-level hackery is possible). Using -ddump-splices from GHC I was able to get the actual Haskell code generated (for the initial code in your question). The offending parts were

instance PEq (Proxy :: Proxy Nat_a7Vb) where
  type (:==) (a_a8Rs :: Nat_a7Vb) (b_a8Rt :: Nat_a7Vb) = Equals_1627424016_a8Rr a_a8Rs b_a8Rt

and

instance POrd (Proxy :: Proxy Nat_a7Vb) where
  type (:<=) (a_aa9e :: Nat_a7Vb) (a_aa9f :: Nat_a7Vb) = Apply (Apply TFHelper_1627428966Sym0 a_aa9e) a_aa9f

Compiling the code generated, I received the slightly more useful error message for both of these

Expecting one more argument to ‘Proxy’
Expected kind ‘Proxy Nat_a7Vb’, but ‘Proxy’ has kind ‘k0 -> *’

pertaining to the (Proxy :: Proxy Nat_a7Vb) in the PEq and POrd classes. That won't compile without -XPolyKinds. Checked the repo for singletons and indeed it tells you that you need -XTypeInType enabled, which in turn enables -XPolyKinds.

So, there is no bug, you just need to add either PolyKinds or TypeInType (I recommend the latter, since that is what the package recommends...) to your LANGUAGE pragmas to get everything to work.