1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
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
~~~
|
