From 50c7bbc2c82ab31ab49e2bb3a2b25e116fb67062 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 18 Feb 2016 17:31:48 +0000 Subject: Updated thermoprint-5 with queue management --- provider/posts/thermoprint-5.md | 132 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 130 insertions(+), 2 deletions(-) diff --git a/provider/posts/thermoprint-5.md b/provider/posts/thermoprint-5.md index 47132e2..0249734 100644 --- a/provider/posts/thermoprint-5.md +++ b/provider/posts/thermoprint-5.md @@ -1,7 +1,7 @@ --- title: Building an Extensible Framework for Specifying Compile-Time Configuration using Universal Quantification tags: Thermoprint -published: 2016-01-24 +published: 2016-02-18 --- When I write *Universal Quantification* I mean what is commonly referred to as @@ -14,6 +14,8 @@ nag me occasionally if this bothers you -- I really should invest some more time 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: @@ -31,7 +33,8 @@ 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)): +[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) } @@ -68,3 +71,128 @@ 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 +~~~ -- cgit v1.2.3