Skip to content

Instantly share code, notes, and snippets.

@jgrimes
Created November 9, 2017 14:16
Show Gist options
  • Save jgrimes/e757520ca25d712e145c5c30800b1f13 to your computer and use it in GitHub Desktop.
Save jgrimes/e757520ca25d712e145c5c30800b1f13 to your computer and use it in GitHub Desktop.
simple example of type safe deserialization + dynamic dispatch
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment