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
|
---
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 wordline and continue depth-first much like `[]`{.haskell}.
Within every wordline 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]:
> 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.
> data EvalCtx = EvalCtx
> { _ctxEvents :: [Object]
> } deriving (Show)
> makeLenses ''EvalCtx
>
> instance Default EvalCtx where
> def = EvalCtx
> { _ctxEvents = mempty
> }
Every wordline constructs exactly one object while having access to a set
of declarations that can occur anywhere on the wordline.
> 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
[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>
|
