{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fplugin Data.Constraint.Deriving #-}
{-# OPTIONS_GHC -fplugin-opt Data.Constraint.Deriving:dump-instances #-}
module Spec.ToInstance01 where
{-
This is a minimal example for deriving multiple instances
for a newtype over a type family.
The plugin provides two advantages over manually implementing instances using singletons:
* No need to implement every class function manually
* Instance elaboration at the call site happens only once for many used functions,
rather than once for every fuction usage.
-}
import Data.Constraint
import Data.Constraint.Deriving
import Data.Constraint.Unsafe
newtype Number t = Number (NumberFam t)
type family NumberFam t where
NumberFam Int = Int
NumberFam Double = Double
data NumberSing t where
NumInt :: NumberSing Int
NumDouble :: NumberSing Double
class KnownNumber t where numberSing :: NumberSing t
instance KnownNumber Int where numberSing = NumInt
instance KnownNumber Double where numberSing = NumDouble
{-# ANN deriveEq (ToInstance NoOverlap) #-}
deriveEq :: KnownNumber t => Dict (Eq (Number t))
deriveEq = deriveIt numberSing
{-# ANN deriveOrd (ToInstance NoOverlap) #-}
deriveOrd :: KnownNumber t => Dict (Ord (Number t))
deriveOrd = deriveIt numberSing
{-# ANN deriveNum (ToInstance NoOverlap) #-}
deriveNum :: KnownNumber t => Dict (Num (Number t))
deriveNum = deriveIt numberSing
deriveIt :: (c Double, c Int) => NumberSing t -> Dict (c (Number t))
deriveIt NumInt = mapDict (unsafeDerive Number) Dict
deriveIt NumDouble = mapDict (unsafeDerive Number) Dict