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
|
---
title: "On the Design of a Turing-Complete Appointment Book"
published: 2016-05-27
tags: events
repo: https://git.yggdrasil.li/gkleen/pub/events
base: https://git.yggdrasil.li/gkleen/pub/events/tree/events/src/Events/Types.hs?id=e04e707b1fb63b7857878e2d77c560abe3efd51b
---
I have a long history of using digital appointment books (calendars)
and not being satisfied with them (I´m currently being frustrated by
[Google Calendar][] after a long history of using [Remind][]).
Thus, of course, I had to implement my own, because, as always, all
existing software does not fullfill my exceedingly unrealistic
expectations with respect to customizability and extendability.
For now all I want from my appointment book is the ability to, given
an interval of time, print a list of events in some machine-parsable
format (probably [JSON][]).
> {-# LANGUAGE TemplateHaskell #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE UndecidableInstances #-}
>
> module Events.Types
> ( TimeRange(..), rangeStart, rangeDuration
> , Event(..), payload, occursWithin
> , EvalCtx(..), ctxVars, ctxEvents
> , ObjCtx(..), objOccurs, objPayload
> , Eval, evaluate
> , module Data.Aeson
> , module Data.Time.Clock
> , module Data.Default.Class
> ) where
>
> import Control.Lens.TH
>
> import Data.Aeson (Object)
>
> import Data.Time.Clock
>
> import Control.Monad.State.Lazy
> import ListT (ListT)
> import qualified ListT
>
> import Data.Default.Class
>
> import Data.Monoid
> import Control.Monad.Fix
> import Control.Lens
> import Data.Maybe
We can quite easily encode an interval of time as a lower bound and a
duration:
> data TimeRange = TimeRange
> { _rangeStart :: UTCTime
> , _rangeDuration :: NominalDiffTime
> }
> makeLenses ''TimeRange
For our purposes it´s sufficient to consider an event to be some data
we´ll display when needed and some way to determine whether the given
`TimeRange`{.haskell} intersects it:
> data Event = Event
> { _payload :: Object
> , _occursWithin :: TimeRange -> Bool
> }
> makeLenses ''Event
We are going to want to parse a specification of some kind into a form we can run.
Below we see one such form.
`ListT`{.haskell} allows for nondeterministic computation – it allows us to split
our worldline[^worldlineSplits] and continue depth-first much like `[]`{.haskell}.
Within every worldline we modify a distinct snapshot of `ObjCtx`{.haskell} we took
while branching.
We also share one `EvalCtx`{.haskell} across all worldlines.
> type Eval m a = StateT ObjCtx (ListT (StateT EvalCtx m)) a
`ListT`{.haskell} does not ship with extensive support for the
[transformers package][transformers][^pipes]:
> instance MonadState s m => MonadState s (ListT m) where
> get = lift get
> put = lift . put
The context shared among all worldlines mainly contains all objects that
eventually get computed – haskells lazyness ensures that we terminate as
long as we don´t have objects depend on themselves in a sufficiently
degenerate way[^degenerate].
> data EvalCtx = EvalCtx
> { _ctxEvents :: [Object]
> } deriving (Show)
> makeLenses ''EvalCtx
>
> instance Default EvalCtx where
> def = EvalCtx
> { _ctxEvents = mempty
> }
Every worldline constructs exactly one object while having access to a set
of declarations that can occur anywhere on the worldline[^ctxVars].
> data ObjCtx = ObjCtx
> { _objOccurs :: Bool
> , _objPayload :: Maybe Object
> , _objVars :: Object
> }
> makeLenses ''ObjCtx
>
> instance Default ObjCtx where
> def = ObjCtx
> { _objOccurs = False
> , _objPayload = Nothing
> , _objVars = mempty
> }
Constructing an `Object`{.haskell} from an `ObjCtx`{.haskell} is straightforward:
> objCtx :: ObjCtx -> Maybe Object
> objCtx (ObjCtx False _) = Nothing
> objCtx (ObjCtx True o) = o
`mfix`{.haskell} allows all values contained within our various `StateT`{.haskell}
layers to depend on one another:
> evaluate :: MonadFix m => Eval m () -> m [Object]
> evaluate x = catMaybes <$> mfix x'
> where
> x' = evalStateT (ListT.toList (objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes
[^ctxVars]: In the base version of this file we carry declarations we may refer to when
creating objects (`_objVars`{.haskell}) within `EvalCtx`{.haskell} instead of `ObjCtx`{.haskell}.
Why is that a bad idea?
[^worldlineSplits]: What does such a branching point look like in do notation?
[^pipes]: It has been pointed out to me that `ListT`{.haskell} from [pipes][] does.
[^degenerate]: Constructing an example that doesn´t terminate is trivial. Try constructing one that does while
still being self-referential!
[Google Calendar]: <https://calendar.google.com>
[Remind]: <https://www.roaringpenguin.com/products/remind>
[JSON]: <https://en.wikipedia.org/wiki/JSON>
[monad transformers]: <https://en.wikibooks.org/wiki/Haskell/Monad_transformers>
[transformers]: <https://hackage.haskell.org/package/transformers>
[pipes]: <https://hackage.haskell.org/package/pipes>
|
