OverloadSingletonI.hs

{-# LANGUAGE GADTs, KindSignatures, DataKinds, RankNTypes, TypeFamilies, TypeFamilyDependencies, AllowAmbiguousTypes, ScopedTypeVariables #-}

module OverloadSingletonI where

import Prelude hiding (negate)

data OverloadMode = NegateInt | NegateBool 

data SOverloadMode :: OverloadMode -> * -> * where
  SNegateInt :: SOverloadMode NegateInt (Int -> Int)
  SNegateBool :: SOverloadMode NegateBool (Bool -> Bool)

type family OverloadType (mode :: OverloadMode) = r | r -> mode where
  OverloadType NegateInt = Int -> Int
  OverloadType NegateBool = Bool -> Bool

class SOverloadModeI (mode :: OverloadMode) where
  sOverloadMode :: SOverloadMode mode (OverloadType mode)

instance SOverloadModeI NegateInt where
  sOverloadMode = SNegateInt

instance SOverloadModeI NegateBool where
  sOverloadMode = SNegateBool

negate :: forall (mode :: OverloadMode). SOverloadModeI mode => OverloadType mode 
negate = negate' sOverloadMode

negate' :: forall (mode :: OverloadMode). SOverloadMode mode (OverloadType mode) -> OverloadType mode 
negate' SNegateInt = \x -> (- x)
negate' SNegateBool = \b -> not b

negate_1 :: Int
negate_1 = negate (1 :: Int)

negate_True :: Bool
negate_True = negate True