From d65d4d606a9f4b2035ca74a3323da61804049bc6 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 28 May 2016 16:05:39 +0200 Subject: events-01 Reviewed-by: Gregor Kleen --- provider/posts/events/01.lhs | 142 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 142 insertions(+) create mode 100644 provider/posts/events/01.lhs 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 @@ +--- +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]: +[Remind]: +[JSON]: +[monad transformers]: +[transformers]: -- cgit v1.2.3