Kata: Conference tickets - event validation

In the previous log, we have completed our tickets reservation system.

There is still a pending issue: Events can be malformed, from example, setting a maxAttendees to 10 and a daily limit to 100.

In the actual system, the one used for Lyon Craft, it is tolerated, which makes sense from an UX point of view, we don't want to force a user flow.

As a code kata, we could, and usually we do, avoid adding malformed inputs.

But, we can be playful.

There are two ways to handle it.

The first one, is at runtime, for instance, with some helpers, we can define a function which validate an input as follows:

-- describe "Building event" $ do
--   it "without max attendees and w/o daily limit should work" $
--     unboundedEvent [unboundedDay 1, boundedDay 2 20]
--       `shouldBe` Just (Event Nothing $ Map.fromList [(1, Nothing), (2, Just 20)])
--   it "with max attendees and w/o daily limit should work" $
--     boundedEvent 100 [unboundedDay 1, boundedDay 2 20]
--       `shouldBe` Just (Event (Just 100) $ Map.fromList [(1, Nothing), (2, Just 20)])
--   it "with max attendees and w/o daily limit should fail" $
--     boundedEvent 10 [unboundedDay 1, boundedDay 2 20]
--       `shouldBe` Nothing


mkEvent :: Maybe Int -> [(Int, Maybe Int)] -> Maybe Event
mkEvent maxAttendeesM daysWithBounds = do
  forM_ maxAttendeesM $ \m ->
    guard $ all (maybe True (<= m) . snd) daysWithBounds

  pure $ Event maxAttendeesM $ Map.fromList daysWithBounds

boundedEvent :: Int -> [(Int, Maybe Int)] -> Maybe Event
boundedEvent m = mkEvent (Just m)

unboundedEvent :: [(Int, Maybe Int)] -> Maybe Event
unboundedEvent = mkEvent Nothing

boundedDay :: Int -> Int -> (Int, Maybe Int)
boundedDay d m = (d, Just m)

unboundedDay :: Int -> (Int, Maybe Int)
unboundedDay d = (d, Nothing)

We could go a little further, making unboundedEvent produce an Event instead of Maybe Event, but we can do a lot better.

The other way to handle it is at type-level, we have two options:

• Relying on TemplateHaskell/QuasiQuotes, but it will involve parsing and so one, here, it is clear over-engineered
• Promoting bounds at type-level

We can start defining it as follows:

data Boundary = Unbounded | Bounded Nat

It's a regular type, but GHC allows its usage at type-level, Boundary becoming a Kind.

The next step is to rewrite Event, to expose Boundary as type-level, through Proxy because only Type Kind can have a runtime value.

There is also a challenge: each daily limit can be different.

Do get around this, we will introduce two existential types: in the new Event for the maxAttendees and another one, for each daily limit, capturing the global limit.

We can continue as follows:

data Event'
  = forall (total :: Boundary).
  Event'
  { maxAttendees' :: Proxy total,
    days' :: Map.Map Int (WithinBound total)
  }

data WithinBound (total :: Boundary)
  = forall (value :: Boundary).
    (AtMost value total) =>
    WithinBound (Proxy value)

The remaining part is AtMost, which is Constraint, ensuring value <= total when both bounds are set.

It is a basic type-level pattern-matching injecting a constraint when needed, as follows:

type family AtMost (value :: Boundary) (total :: Boundary) :: Constraint where
  AtMost ('Bounded value') ('Bounded total') = (value' <= total')
  AtMost _ _ = ()

We can test our code with few witnesses, as follows:

_unboundedEvent :: Event'
_unboundedEvent =
  Event'
    (Proxy @'Unbounded)
    (Map.fromList [(1, WithinBound (Proxy @'Unbounded)), (2, WithinBound (Proxy @('Bounded 20)))])

_unboundedEventWorking :: Event'
_unboundedEventWorking =
  Event'
    (Proxy @('Bounded 100))
    (Map.fromList [(1, WithinBound (Proxy @'Unbounded)), (2, WithinBound (Proxy @('Bounded 20)))])

_unboundedEventFailing :: Event'
_unboundedEventFailing =
  Event'
    (Proxy @('Bounded 10))
    (Map.fromList [(1, WithinBound (Proxy @'Unbounded)), (2, WithinBound (Proxy @('Bounded 20)))])

And it only yields one error as follows:

test/Spec.hs:166:62-72: error: [GHC-64725]
    • Cannot satisfy: 20 <= 10
    • In the expression: WithinBound (Proxy @('Bounded 20))
      In the expression: (2, WithinBound (Proxy @('Bounded 20)))
      In the first argument of ‘Map.fromList’, namely
        ‘[(1, WithinBound (Proxy @'Unbounded)),
          (2, WithinBound (Proxy @('Bounded 20)))]’
    |
166 |     (Map.fromList [(1, WithinBound (Proxy @'Unbounded)), (2, WithinBound (Proxy @('Bounded 20)))])
    |                                                              ^^^^^^^^^^^