simple example of type safe deserialization + dynamic dispatch

Job.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
module Job where
import Data.Serialize (Serialize, encode, decode)
import Data.Typeable
import GHC.Generics
import Control.Monad (join)
import qualified Data.ByteString as B

-- Job is just a small typeclass representing types
-- that have an associated IO action.
class Job a where
  job :: a -> IO ()

-- existential types let us do something like
-- dynamic dispatch. i.e. we can box up anything
-- that has typeclass instances for Typeable, Serialize, and Job.
-- This lets us have things like heterogeneous lists, or in this
-- case a way to run any type of job that we happen to
-- get after parsing.

data AnyJob = forall n. (Typeable n, Serialize n, Job n) => AnyJob n

-- Custom job type. Only interesting part is
-- being able to derive a lot functionality automatically.
data CreateUser = CreateUser String
  deriving (Generic, Serialize, Typeable, Show, Eq)

instance Job CreateUser where
  job (CreateUser username) = putStrLn $ "Created: " ++ username

-- For jobs that are just a String, we will just
-- print it as is.
instance Job [Char] where
  job s = putStrLn s

-- Lets us just call `job` on an AnyJob, which will then do the
-- unpacking and execution of the contained job.
instance Job AnyJob where
  job (AnyJob a) = job a

-- ByteStrings are binary strings that can be portably written to
-- disk, sent over the network, etc.
-- `typeOf` is part of the magic here. Just like what you would do
-- in a unityped language, we encode the type of job along with the data.
-- The biggest difference being that in Haskell we need to use it explicitly
-- when deserializing as well.
serialAnyJob :: AnyJob -> B.ByteString
serialAnyJob (AnyJob x) = encode (show $ typeOf x, encode x)

-- the hackiest part of the whole thing, but not entirely
-- different from what happens in a unityped language,
-- we just have to do it explicitly since we must handle
-- error cases to maintain type safety.
-- Boilerplatey, could be taken care of with TemplateHaskell.
deserialAnyJob :: B.ByteString -> Either String AnyJob
deserialAnyJob s = join $ do
  (typ, bs) <- decode s
  return $ case typ of
    "[Char]" -> do
      bs' <- decode bs
      return $ AnyJob (bs' :: [Char])
    "CreateUser" -> do
      bs' <- decode bs
      return $ AnyJob (bs' :: CreateUser)
    -- using error here to demonstrate a useful development technique.
    -- error is the "bottom" value, which means it is a member of every type.
    -- It is useful when developing but shouldn't remain in finished software.
    -- We could just as easily have used underlying Either monad: Left "Unable to deserialize"
    _ -> error "Unable to deserialize job"

job1 = AnyJob "oh hey there"

job2 = AnyJob (CreateUser "jg")

ex1 :: [AnyJob]
ex1 = [job1, job2]

ex2 :: [B.ByteString]
ex2 = map serialAnyJob ex1

execJobs jobs = do
  case traverse deserialAnyJob jobs of
    Left err -> putStrLn err
    Right jobs' -> sequence_ $ map job jobs'

-- λ> execJobs ex2
-- oh hey there
-- Created: jg