An oldie-but-goldie

Cursed.hs

{-# OPTIONS_GHC -Wno-missing-methods #-}

{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE UndecidableSuperClasses #-}

import Data.Coerce (coerce)
import Data.Kind (Constraint)
import GHC.Exts (IsList (..))

-- $> main
main :: IO ()
main = do
  print (2 minutes)            -- 2 minutes
  print (2 minutes :: Seconds) -- 120 seconds

  -- 19829 seconds
  print ([ 5 hours, 30 minutes, 29 seconds ] :: Seconds)

------------------------------------------------------------
-- Not all the instances below are lawful. This class provides a type-safe
-- way of of statically declaring this to GHC and readers alike. For example,
-- after defining an unlawful @Num@ instance, we can go on to define a @Num*@
-- instance, where the asterisk denotes that terms and conditions apply.
class c x => (*) (c :: k -> Constraint) (x :: k)

------------------------------------------------------------
-- Human-readable times. Shout-out to @kcsongor

newtype Hours = Hours { getHours :: Int }
  deriving newtype (Eq, Ord, Num)

instance Show Hours where
  show (Hours 1) = "1 hour"
  show (Hours n) = show n <> " hours"

newtype Minutes = Minutes { getMinutes :: Int }
  deriving newtype (Eq, Ord, Num)

instance Show Minutes where
  show (Minutes 1) = "1 minute"
  show (Minutes n) = show n <> " minutes"

newtype Seconds = Seconds { getSeconds :: Int }
  deriving newtype (Eq, Ord, Num)

instance Show Seconds where
  show (Seconds 1) = "1 second"
  show (Seconds n) = show n <> " seconds"

hour, hours :: Int -> Hours
hour  = Hours
hours = Hours

minute, minutes :: Int -> Minutes
minute  = Minutes
minutes = Minutes

second, seconds :: Int -> Seconds
second  = Seconds
seconds = Seconds

-- Conversions (e.g. @120 seconds :: Minutes@)
instance Num ((Int -> Hours) -> Minutes) where
  fromInteger x _ = Minutes (fromInteger x * 60)

instance Num ((Int -> Minutes) -> Hours) where
  fromInteger x _ = Hours (fromInteger x `div` 60)

instance Num ((Int -> Minutes) -> Seconds) where
  fromInteger x _ = Seconds (fromInteger x * 60)

instance Num ((Int -> Seconds) -> Minutes) where
  fromInteger x _ = Minutes (fromInteger x `div` 60)

instance Num ((Int -> Seconds) -> Hours) where
  fromInteger x _ = Hours (fromInteger x `div` 3600)

instance Num ((Int -> Hours) -> Seconds) where
  fromInteger x _ = Seconds (fromInteger x * 3600)

-- Compulsory INCOHERENT instance. If you don't specify the target type
-- (i.e. a conversion), assume it's the constructor used. For example,
-- GHC will now infer a type of @Minutes@ for @2 minutes@, which seems
-- like a thing we'd want.
instance {-# INCOHERENT #-} i ~ o
    => Num ((Int -> i) -> o) where
  fromInteger x i = i (fromInteger x)

------------------------------------------------------------

-- Of course, this is just a fun trick, and far from practical. In the real
-- world, people don't say "3599 seconds"; they'd say, "59 minutes, 59
-- seconds". If we want our code to be enterprise-ready, we need to appeal to
-- the everyday user.

instance IsList Seconds where
  type Item Seconds = Seconds

  fromList = foldr (+) (0 seconds)
  toList = pure

instance IsList Minutes where
  type Item Minutes = Minutes

  fromList = foldr (+) (0 minutes)
  toList = pure

instance IsList Hours where
  type Item Hours = Hours

  fromList = foldr (+) (0 hours)
  toList = pure

-- | T&Cs apply.
instance IsList* Seconds
instance IsList* Minutes
instance IsList* Hours