---
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>