Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# 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 = ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.