Another love letter to {-# INCOHERENT #-}

Coherence.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Nothing very serious.
--
-- >>> 5 Years
-- Years 5
--
-- >>> 5 Years :: Months
-- Months 60
--
-- >>> 5 Years + 3 Months
-- Years 5
--
-- >>> (5 Years + 3 Months) :: Months
-- Months 63
module Coherence where

import Data.Coerce (coerce)

newtype Months = Months Integer
  deriving (Show, Num, Integral, Real, Enum, Ord, Eq, Generic)

newtype Years = Years Integer
  deriving (Show, Num, Integral, Real, Enum, Ord, Eq, Generic)

instance {-# INCOHERENT #-} result ~ Years
    => Num ((Integer -> Years) -> result) where
  fromInteger f toYears = toYears f

instance Num ((Integer -> Years) -> Months) where
  fromInteger f toYears = coerce (toYears f * 12)

instance {-# INCOHERENT #-} result ~ Months
    => Num ((Integer -> Months) -> result) where
  fromInteger f toMonths = toMonths f

instance Num ((Integer -> Months) -> Years) where
  fromInteger f toMonths = coerce (toMonths f `div` 12)