---
title: Building an Extensible Framework for Specifying Compile-Time Configuration using Universal Quantification
tags: Thermoprint
published: 2016-02-18
repo: https://git.yggdrasil.li/thermoprint?h=rewrite
---

When I write *Universal Quantification* I mean what is commonly referred to as
[existential quantification](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/data-type-extensions.html#existential-quantification),
which I think is a misnomer.  To wit:

$( \exists x \ldotp f(x) ) \to y$ is isomorphic to $\forall x \ldotp (f(x) \to y)$ (I
won´t try to back this claim up with actual category theory just now. You might want to
nag me occasionally if this bothers you -- I really should invest some more time into
category theory). Since haskell does not support `exists` we´re required to use the
`forall`-version, which really is universally quantified.

## Printer Configuration

What we want is to have the user provide us with a set of specifications of how to
interact with one printer each.
Something like the following:

~~~ {.haskell}
newtype PrinterMethod = PM { unPM :: Printout -> IO (Maybe PrintingError) }

data Printer = Printer
  { print :: PrinterMethod
  , queue :: TVar Queue
  }
~~~

The first step in refining this is necessitated by having the user provide the
[monad-transformer-stack](http://book.realworldhaskell.org/read/monad-transformers.html)
to use at compile time.
Thus we introduce our first universal quantification (in conjunction with
[polymorphic components](https://prime.haskell.org/wiki/PolymorphicComponents)) -- this
one is not isomorphic to an existential one:

~~~ {.haskell}
newtype PrinterMethod = PM { unPm :: forall m. MonadResource m => Printout -> m (Maybe PrintingError) }
~~~

Since we don´t want to *burden* the user with the details of setting up `TVar Queue`{.haskell} we
also introduce function to help with that:

~~~ {.haskell}
printer :: MonadResource m => PrinterMethod -> m Printer
printer p = Printer p <$> liftIO (newTVarIO def)
~~~

We could at this point provide ways to set up `PrinterMethod`{.haskell}s and have the user
provide us with a list of them.

We, however, have numerous examples of printers which require some setup (such opening a
file descriptor). The idiomatic way to handle this is to decorate that setup with some
constraints and construct our list of printers in an
[`Applicative`{.haskell}](https://hackage.haskell.org/package/base/docs/Control-Applicative.html#t:Applicative)
fashion:

~~~ {.haskell}
printer :: MonadResource m => m PrinterMethod -> m Printer
printer p = Printer <$> p <*> liftIO (newTVarIO def)
~~~

At this point a toy implementation of a printer we might provide looks like this:

~~~ {.haskell}
debugPrint :: Applicative m => m PrinterMethod
debugPrint = pure . PM $ const return Nothing <=< liftIO . putStrLn . toString

toString :: Printout -> String
toString = undefined
~~~

## Management of Printer Queues

We would like the user to be able to modify the printer queues we maintain in arbitrary
ways.
The motivation for this being various cleanup operations such as pruning all successful
jobs older than a few minutes or limiting the size of history to an arbitrary number of
entries.

A pattern for this type of modification of a value residing in a `TVar`{.haskell} might
look like this:

~~~ {.haskell}
modify :: TVar a -> StateT a STM () -> IO ()
modify q f = atomically $ writeTVar =<< runStateT f =<< readTVar q
~~~

A rather natural extension of this is to allow what we will henceforth call a
`QueueManager`{.haskell} (currently `StateT a STM ()`{.haskell}) to return an indication
of when it wants to be run again:

~~~ {.haskell}
type QueueManager = StateT Queue STM Micro

runQM :: QueueManager -> TVar Queue -> IO ()
runQM qm q = sleep << qm'
  where
    qm' = atomically $ (\(a, s) -> a <$ writeTVar q s) =<< runStateT qm =<< readTVar q
	sleep (abs -> delay) = threadDelay (fromEnum delay) >> runQM qm q
~~~

It stands to reason that sometimes we don't want to run the `QueueManager`{.haskell} ever
again (probably causing the thread running it to terminate).
For doing so we
[extend the real numbers](https://en.wikipedia.org/wiki/Extended_real_number_line) as
represented by `Micro`{.haskell} to
[`Extended Micro`{.haskell}](https://hackage.haskell.org/package/extended-reals):

~~~ {.haskell}
type QueueManager = StateT Queue STM (Extended Micro)

runQM …
  where
    …
    sleep (abs -> delay)
      | (Finite d) <- delay = threadDelay (fromEnum d) >> runQM qm q
      | otherwise           = return ()
~~~

`QueueManager`{.haskell}s whose type effectively is `Queue -> STM (Queue, Extended Micro)`{.haskell}
are certainly useful but can carry no state between invocations (which would be useful
e.g. for limiting the rate at which we prune jobs).

Therefore we allow the user to provide an arbitrary monad functor (we use
`MFunctor`{.haskell} from
[mmorph](https://hackage.haskell.org/package/mmorph-1.0.6/docs/Control-Monad-Morph.html#t:MFunctor)
instead of `Servant.Server.Internal.Enter` because
[servant-server](https://hackage.haskell.org/package/servant-server-0.4.4.6/docs/Servant-Server-Internal-Enter.html#v:Nat)
doesn't provide all the tools we require for this) which can carry all the state we could
ever want:

~~~ {.haskell}
type QueueManager t = QueueManagerM t (Extended Micro)
type QueueManagerM t = ComposeT (StateT Queue) t STM -- 'ComposeT' is required since we need 'QueueManagerM' to have the form 't' STM' for some 't'' in order to be able to use 'lift'

runQM :: (MFunctor t, MonadTrans t, MonadIO (t IO), Monad (t STM)) => QueueManager t -> TVar Queue -> t IO ()
runQM … -- nearly identical except for a sprinkling of 'lift'
~~~

The final touches are to introduce a typeclass `HasQueue`{.haskell} for convenience:

~~~ {.haskell}
class HasQueue a where
  extractQueue :: a -> TVar Queue

instance HasQueue (TVar Queue) where
  extractQueue = id

instance HasQueue Printer where
  extractQueue = queue
~~~

and provide some utility functions for composing `QueueManager`{.haskell}s:

~~~ {.haskell}
intersection :: (Foldable f, MonadState Queue (QueueManagerM t)) => f (QueueManager t) -> QueueManager t
-- ^ Combine two 'QueueManager's keeping only 'QueueEntry's both managers decide to keep
--
-- Side effects propagate left to right

idQM :: Monad (QueueManagerM t) => QueueManager t
-- ^ Identity of 'intersect'

union :: (Foldable f, MonadState Queue (QueueManagerM t)) => f (QueueManager t) -> QueueManager t
-- ^ Combine two 'QueueManager's keeping all 'QueueEntry's either of the managers decides to keep
--
-- Side effects propagate left to right

nullQM :: MonadState Queue (QueueManagerM t) => QueueManager t
-- ^ Identity of 'union'
~~~

We merge the effects of two `QueueManager`{.haskell}s by converting the resulting
`Queue`{.haskell}s to `Set`{.haskell}s and using `Set.union`{.haskell} and
`Set.intersection`{.haskell} with appropriate `Ord`{.haskell} and `Eq`{.haskell}
instances.

### Configuration of `QueueManager`{.haskell}s

A `QueueManager`{.haskell}s configuration shall be a `QueueManager t`{.haskell} associated
with a specification of how to collapse its monad transformer `t`{.haskell}.
Using universal quantification this is straightforward:

~~~ {.haskell}
data QMConfig m = forall t. ( MonadTrans t
                            , MFunctor t
                            , Monad (t STM)
                            , MonadIO (t IO)
                            ) => QMConfig { manager  :: QueueManager t
                                          , collapse :: (t IO) :~> m
                                          }
										  
runQM' :: Printer -> QMConfig m -> m ()
runQM' printer (QMConfig qm nat) = unNat nat $ runQM qm printer
~~~