A haskell solution to @yreynhout's Projection workshop https://gist.github.com/yreynhout/5d2faf478909fbd8e366396dfdde05b4

_test.hs

all (==True) [
  scenario
   (Given [
      GuestBookedAppointment "1" "Vanessa" "today" "4" "5",
      GuestRescheduledAppointment "1" "Vanessa" "tomorrow" "4" "5",
      GuestBookedAppointment "2" "Oliver" "today" "7" "5",
      GuestCancelledAppointment "1" "Vanessa" "Flight delayed" "5",
      GuestBookedAppointment "3" "Jim" "today" "7" "5"])
   (When (HowManyAppointments "today")) 
   (Then (NrOfAppointments 2)),

  scenario
   (Given [
      GuestBookedAppointment "2" "Oliver" "today" "7" "5"])
   (When (IsThereAnAppointmentFor "Oliver")) 
   (Then (HasAppointment True))
  ]

Beauforma.hs

{-# LANGUAGE ExistentialQuantification #-}
module Beauforma where
  
import qualified Data.Map.Strict as M 

data Event = 
  GuestBookedAppointment { 
      appointmentId :: Guid,
      guestId :: GuestId,
      appointmentDateAndTime :: DateTime,
      feelGoodPackageId :: Guid,
      subsidiaryId :: Guid }
  | GuestRescheduledAppointment { 
      appointmentId :: Guid,
      guestId :: GuestId, 
      appointmentDateAndTime :: DateTime, 
      feelGoodPackageId :: Guid, 
      subsidiaryId :: Guid }
  | GuestSwappedAppointmentFeelGoodPackage { 
      appointmentId :: Guid, 
      guestId :: GuestId, 
      feelGoodPackageId :: Guid, 
      subsidiaryId :: Guid }
  | GuestCancelledAppointment { 
      appointmentId :: Guid,
      guestId :: GuestId,
      reason :: String, 
      subsidiaryId :: Guid }
  | SubsidiaryCancelledAppointment { 
      appointmentId :: Guid,
      guestId :: GuestId,
      reason :: String, 
      subsidiaryId :: Guid }
  deriving(Show, Eq)
type State = M.Map Guid Appointment
data Appointment =  Appointment { 
      a_appointmentId:: Guid, 
      a_guestId:: GuestId,
      a_dateTime:: DateTime
      } deriving (Show, Eq, Ord)
type Guid = String
type GuestId = Guid
type DateTime = String
  
project :: [Event] -> State
project = foldl when newState

when :: State -> Event -> State
when s (GuestBookedAppointment appointmentId guestId dateTime _ _) = 
  M.insert guestId (Appointment appointmentId guestId dateTime) s
when s (GuestRescheduledAppointment _ guestId dateTime _ _) = 
  case (M.lookup guestId s) of
    Just (Appointment id _ _)
        -> M.insert guestId (Appointment id guestId dateTime) s
    Nothing -> s
when s (GuestSwappedAppointmentFeelGoodPackage _ _ _ _) = s
when s (GuestCancelledAppointment _ guestId _ _) = M.delete guestId s
when s (SubsidiaryCancelledAppointment _ guestId _ _) = M.delete guestId s

newState :: State
newState = M.empty

--

class (Show q, Eq q) => Query q where
  query :: State -> q -> QueryResult

data IsThereAnAppointmentFor = IsThereAnAppointmentFor GuestId deriving(Show, Eq)
instance Query IsThereAnAppointmentFor where
  query state (IsThereAnAppointmentFor g) = HasAppointment $ M.member g state
  

data HowManyAppointments = HowManyAppointments DateTime deriving(Show, Eq)
instance Query HowManyAppointments where
  query state (HowManyAppointments dateTime) = NrOfAppointments $ count $ M.filter p state
    where 
       p :: Appointment -> Bool
       p (Appointment _ _ dt) = dt == dateTime
       count s = length $  M.toList s

data QueryResult =  
  NrOfAppointments Int 
  | HasAppointment Bool
  deriving(Show, Ord, Eq)
  
--

data Given = Given [Event]
data When q = Query q => When q
data Then = Then QueryResult

scenario :: Query q => Given -> When q -> Then -> Bool
scenario (Given events) (When q) (Then expected) = query (project events) q == expected