cancel.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GADTs #-}

{-# OPTIONS_GHC -Wall #-}

module Main where

import GHC.TypeLits
import GHC.Exts

main :: IO ()
main = return ()

data Status = Pending | Completed | Canceled

data Job (status :: Status) where
    JobPending :: Id -> URL -> Job 'Pending
    JobCompleted :: Id -> Timestamp -> Job 'Completed
    JobCanceled :: Id -> Reason -> Timestamp -> Job 'Canceled

type Timestamp = Int
type Reason = String
type Id = Int
type URL = String

runJob :: Job 'Pending -> IO (Job 'Completed)
runJob (JobPending i req) = do
    putStrLn ("Running job: " ++ show i)
    putStrLn ("Making request: " ++ req)
    let now = 300
    return (JobCompleted i now)

cancelJob :: Reason -> Job 'Pending -> IO (Job 'Canceled)
cancelJob reason (JobPending i _) = do
    putStrLn ("Canceling job: " ++ show i)
    let now = 400
    return (JobCanceled i reason now)

jobTimestamp :: HasTimestamp status => Job status -> Timestamp
jobTimestamp (JobCompleted _ t) = t
jobTimestamp (JobCanceled _ _ t) = t

type family HasTimestamp (status :: Status) :: Constraint where
    HasTimestamp 'Pending = TypeError ('Text "No timestamp for Pending")
    HasTimestamp 'Completed = ()
    HasTimestamp 'Canceled = ()