1 files changed, 198 insertions, 0 deletions

diff --git a/provider/posts/thermoprint/5.md b/provider/posts/thermoprint/5.md
new file mode 100644
index 0000000..0249734
--- /dev/null
+++ b/provider/posts/thermoprint/5.md
@@ -0,0 +1,198 @@
+---
+title: Building an Extensible Framework for Specifying Compile-Time Configuration using Universal Quantification
+tags: Thermoprint
+published: 2016-02-18
+---
+
+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
+~~~