--- 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 ~~~