Skip to content

Instantly share code, notes, and snippets.

@i-am-tom

i-am-tom/Cursed.hs

Created May 22, 2020
Embed
What would you like to do?
An oldie-but-goldie
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment