the name is kind of a joke

MakeImpure.hs

{-# LANGUAGE
    FlexibleInstances,
    MultiParamTypeClasses,
    FunctionalDependencies,
    UndecidableInstances
    #-}
module MakeImpure where

data Key a
class Get a where get :: Key a -> IO a
class Put a where put :: a -> IO (Key a)

class Fetch q a | q -> a where
    fetch :: q -> IO a

instance Get a => Fetch (Key a) a where
    fetch = get

-- this is very less than perfect, b/c now i'm stuck writing code gen to
-- create instances for tuples of various size.
-- in a perfect world, we could avoid that and need just a few instances.
instance (Fetch q1 a1, Fetch q2 a2) => Fetch (q1, q2) (a1, a2) where
    fetch (q1, q2) = (,) <$> fetch q1 <*> fetch q2

makeImpure :: (Fetch q a, Put b) => (a -> b) -> q -> IO (Key b)
makeImpure f q = put . f =<< fetch q

data Foo
instance Get Foo

data Bar
instance Get Bar

data Baz
instance Put Baz

-- in a perfect world, i'd could write `Foo -> Bar -> Baz`
pureDomainLogic :: (Foo, Bar) -> Baz
pureDomainLogic = undefined

-- in a prefect world, i'd get back a `Key Foo -> Key Bar -> IO (Key Baz)`
program :: (Key Foo, Key Bar) -> IO (Key Baz)
program = makeImpure pureDomainLogic

-- idiomatic haskell would be something like this
--
--     program :: Key Foo -> Key Bar -> IO (Key Baz)
--     program k1 k2 = put =<< pureDomainLogic <$> get k1 <*> get k2
--
-- that's too boiler-plately for me. i want an overloaded function
-- where i can just write `makeImpure foo` that will do the right
-- thing no matter how many arguments `foo` has, as long as I have
-- `Get` instances for the arguments and a `Put` instance for the
-- final result.