dirty-haskell.org: On the Design of a Turing-Complete Appointment Book

It's not crazy — it's having fun with types.

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 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 allows for nondeterministic computation – it allows us to split our worldline1 and continue depth-first much like [].

Within every worldline we modify a distinct snapshot of ObjCtx we took while branching.

We also share one EvalCtx across all worldlines.

> type Eval m a = StateT ObjCtx (ListT (StateT EvalCtx m)) a

ListT does not ship with extensive support for the transformers package2:

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

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

> 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 from an ObjCtx is straightforward:

> objCtx :: ObjCtx -> Maybe Object
> objCtx (ObjCtx False _) = Nothing
> objCtx (ObjCtx True  o) = o

mfix allows all values contained within our various StateT 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

  1. What does such a branching point look like in do notation?↩

  2. It has been pointed out to me that ListT from pipes does.↩

  3. Constructing an example that doesn´t terminate is trivial. Try constructing one that does while still being self-referential!↩

  4. In the base version of this file we carry declarations we may refer to when creating objects (_objVars) within EvalCtx instead of ObjCtx. Why is that a bad idea?↩