summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--provider/posts/events/01.lhs142
1 files changed, 142 insertions, 0 deletions
diff --git a/provider/posts/events/01.lhs b/provider/posts/events/01.lhs
new file mode 100644
index 0000000..fd1bd03
--- /dev/null
+++ b/provider/posts/events/01.lhs
@@ -0,0 +1,142 @@
1---
2title: "On the Design of a Turing-Complete Appointment Book"
3published: 2016-05-27
4tags: events
5repo: https://git.yggdrasil.li/gkleen/pub/events
6base: https://git.yggdrasil.li/gkleen/pub/events/tree/events/src/Events/Types.hs?id=e04e707b1fb63b7857878e2d77c560abe3efd51b
7---
8
9I have a long history of using digital appointment books (calendars)
10and not being satisfied with them (I´m currently being frustrated by
11[Google Calendar][] after a long history of using [Remind][]).
12Thus, of course, I had to implement my own, because, as always, all
13existing software does not fullfill my exceedingly unrealistic
14expectations with respect to customizability and extendability.
15
16For now all I want from my appointment book is the ability to, given
17an interval of time, print a list of events in some machine-parsable
18format (probably [JSON][]).
19
20> {-# LANGUAGE TemplateHaskell #-}
21> {-# LANGUAGE MultiParamTypeClasses #-}
22> {-# LANGUAGE FlexibleInstances #-}
23> {-# LANGUAGE UndecidableInstances #-}
24>
25> module Events.Types
26> ( TimeRange(..), rangeStart, rangeDuration
27> , Event(..), payload, occursWithin
28> , EvalCtx(..), ctxVars, ctxEvents
29> , ObjCtx(..), objOccurs, objPayload
30> , Eval, evaluate
31> , module Data.Aeson
32> , module Data.Time.Clock
33> , module Data.Default.Class
34> ) where
35>
36> import Control.Lens.TH
37>
38> import Data.Aeson (Object)
39>
40> import Data.Time.Clock
41>
42> import Control.Monad.State.Lazy
43> import ListT (ListT)
44> import qualified ListT
45>
46> import Data.Default.Class
47>
48> import Data.Monoid
49> import Control.Monad.Fix
50> import Control.Lens
51> import Data.Maybe
52
53We can quite easily encode an interval of time as a lower bound and a
54duration:
55
56> data TimeRange = TimeRange
57> { _rangeStart :: UTCTime
58> , _rangeDuration :: NominalDiffTime
59> }
60> makeLenses ''TimeRange
61
62For our purposes it´s sufficient to consider an event to be some data
63we´ll display when needed and some way to determine whether the given
64`TimeRange`{.haskell} intersects it:
65
66> data Event = Event
67> { _payload :: Object
68> , _occursWithin :: TimeRange -> Bool
69> }
70> makeLenses ''Event
71
72We are going to want to parse a specification of some kind into a form we can run.
73Below we see one such form.
74
75`ListT`{.haskell} allows for nondeterministic computation – it allows us to split
76our wordline and continue depth-first much like `[]`{.haskell}.
77
78Within every wordline we modify a distinct snapshot of `ObjCtx`{.haskell} we took
79while branching.
80
81We also share one `EvalCtx`{.haskell} across all worldlines.
82
83> type Eval m a = StateT ObjCtx (ListT (StateT EvalCtx m)) a
84
85`ListT`{.haskell} does not ship with extensive support for the
86[transformers package][transformers]:
87
88> instance MonadState s m => MonadState s (ListT m) where
89> get = lift get
90> put = lift . put
91
92The context shared among all worldlines mainly contains all objects that
93eventually get computed – haskells lazyness ensures that we terminate as
94long as we don´t have objects depend on themselves in a sufficiently
95degenerate way.
96
97> data EvalCtx = EvalCtx
98> { _ctxEvents :: [Object]
99> } deriving (Show)
100> makeLenses ''EvalCtx
101>
102> instance Default EvalCtx where
103> def = EvalCtx
104> { _ctxEvents = mempty
105> }
106
107Every wordline constructs exactly one object while having access to a set
108of declarations that can occur anywhere on the wordline.
109
110> data ObjCtx = ObjCtx
111> { _objOccurs :: Bool
112> , _objPayload :: Maybe Object
113> , _objVars :: Object
114> }
115> makeLenses ''ObjCtx
116>
117> instance Default ObjCtx where
118> def = ObjCtx
119> { _objOccurs = False
120> , _objPayload = Nothing
121> , _objVars = mempty
122> }
123
124Constructing an `Object`{.haskell} from an `ObjCtx`{.haskell} is straightforward:
125
126> objCtx :: ObjCtx -> Maybe Object
127> objCtx (ObjCtx False _) = Nothing
128> objCtx (ObjCtx True o) = o
129
130`mfix`{.haskell} allows all values contained within our various `StateT`{.haskell}
131layers to depend on one another:
132
133> evaluate :: MonadFix m => Eval m () -> m [Object]
134> evaluate x = catMaybes <$> mfix x'
135> where
136> x' = evalStateT (ListT.toList (objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes
137
138[Google Calendar]: <https://calendar.google.com>
139[Remind]: <https://www.roaringpenguin.com/products/remind>
140[JSON]: <https://en.wikipedia.org/wiki/JSON>
141[monad transformers]: <https://en.wikibooks.org/wiki/Haskell/Monad_transformers>
142[transformers]: <https://hackage.haskell.org/package/transformers>