MarkerClass.hs

{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
module MarkerClass where

import GHC.TypeLits -- for error messages

-- Suppose we have a class for serialising/deserialising
-- types into/from JSON:

class JSON a where
  fromJSON :: String -> a
  toJSON   :: a -> String

data Person1 = MkPerson1 { name :: String, age :: Int }

instance JSON Person1 where
  fromJSON = undefined
  toJSON = undefined

-- JSON can be used to present our type through some external API, and
-- also to insert into some database as a JSON blob.

serveAPI1 :: JSON a => a -> IO ()
serveAPI1 = undefined

insertDB1 :: JSON a => a -> IO ()
insertDB1 = undefined

main1 :: IO ()
main1 = serveAPI1 (MkPerson1 "Bob" 10)

-- Now the problem is this: just by looking at 'Person1', how can
-- we tell whether it's some internal type (i.e. only put into the DB),
-- or part of an external API? The only way is to look at how it's
-- being used, which is very tedious.
-- We could have separate module namespaces for these sorts of types, but even then
-- it's easy to get tripped up.


-- * Marker classes

-- Here's a simple idea: we create two empty "marker classes" whose
-- sole purpose is to signify whether something is an API type, a DB
-- type, or both.

class API a
class DB a

data Person = MkPerson { name :: String, age :: Int }
  deriving DB
-- we can simply derive this, because there's no implementation to
-- fill in (this requires -XDeriveAnyClass)

instance JSON Person where
  fromJSON = undefined
  toJSON = undefined

-- With this, we can provide more precise types for the API and DB functions:

serveAPI :: (API a, JSON a) => a -> IO ()
serveAPI = undefined

insertDB :: (DB a, JSON a) => a -> IO ()
insertDB = undefined

-- Since the Person type is not marked as an API type, the following doesn't type check
-- main :: IO ()
-- main = serveAPI (MkPerson "Bob" 10)

-- We can go the extra mile, and provide a friendlier error message in the above case:

instance {-# OVERLAPPABLE #-} TypeError ('ShowType a ':<>: 'Text " does not belong to the API!") => API a

-- MarkerClass.hs:73:8-35: error: …
--     • Person does not belong to the API!
--     • In the expression: serveAPI (MkPerson "Bob" 10)
--       In an equation for ‘main’: main = serveAPI (MkPerson "Bob" 10)
--    |
-- Compilation failed.