Santa's Flight Computer

'Twas the morning after Christmas. Santa was by the fire lounging in his reclining chair - engineered precisely for him by the elves - enjoying [yet another] glass of egg nog.

Mrs. Claus turned the corner with her clipboard and sat down across from him. She said nothing and appeared as if she had no intention of speaking.

Santa initially made eye contact with her, then retracted into his cup. He began to open his mouth – no, it fell closed. He tried a smile, but it quickly evaporated from his face. The silence continued for several minutes; the warmth draining from his bones.

He realized she was waiting for him to speak first. She always did. "The elves told me we set a production record this year. Shall we celeb-" She reflexively gave the most subtle of motions: for him to silence himself.

"An entire city", she paused. "The entire city of Portland, Nicholas…", fading off as she turned to look out the window. Santa genuinely didn't know what she was referring to. It had been a long night of sneaking down chimneys.

He began to open his mouth again, but this time only his jaw moved while his lips remained closed.

"You forgot your list, so you decided to wing it?" she said with equal parts of anger and despair.

"I was too far to turn back. I only have one night to deliver everything." "I've been doing this for thousands of years. What's the big deal?" Santa immediately looked back into his cup. He knew that was a mistake.

"You are solely responsible for the joy of children across the entire planet Earth." She leaned forward and stared deep into his eyes. "Do you understand the gravity of this situation?" "The elves' machine learning algorithms are already forecasting lower levels of belief. Their sensor networks overheard parents regret telling their children about you. If disbelief spreads out of Portland, we could fade into nothing. Nothing, Nicholas… nothing."

Santa stirred in his chair. Mrs. Claus' eyes remained fixed.

"This can never happen again" she said without looking at him. She turned and proceeded to walk away, aimlessly changing directions, not knowing what to do next.

module FlightComputer where

import Control.Monad.Trans.Reader (Reader, ReaderT, runReader, runReaderT, asks)
import Control.Monad.Trans.Writer (Writer, WriterT, runWriter, runWriterT, tell)
import Control.Monad.Trans.State (State, runState, get, modify)
import Control.Monad.Trans.Except (Except, ExceptT, runExcept, runExceptT, throwE)
import Control.Monad.Trans.Class (lift)
import qualified Data.Map as Map
import Data.Map (Map)

Not knowing what to do either, Santa strolled into the workshop. The elves knew everything, of course.

"Santa! Don't worry. We've been doing some research." announced the Head Elf. "We have an elegant solution for you. Let us walk through it together." The other elves all glanced at each other excitedly.

Santa sighed and nodded.

"Let's start from the beginning", said the Head Elf as they all came to surround Santa. "Could you please show us that list of yours?"

Santa tried a few of his jacket pockets, then patted his pants seemingly randomly… finally producing the list from his chest pocket. "Ah, yes, of course" mumbled Santa, as his cheeks went white.

The elves' eyes glowed. "Incredible! A mere piece of paper…", one exclaimed. "Such simplicity and elegance!" said another. "His discipline is world-renowned", whispered a third. Santa smiled, briefly… remembering his conversation with Mrs. Claus.

"Santa, we know you have a big job to do" the Head Elf continued, silencing the commotion. "You've been making it work all by yourself since the beginning of time… but the world is getting more complicated. There are more exceptions to deal with."

"I know! Mrs. Claus doesn't know what I have to deal with!" Santa looked over his shoulder. "These kids stay up late… sometimes I can't even deliver the presents!"

"We know, we know", the Head Elf replied. All of the elves stirred excitedly, some of them glancing towards the back of the room.

"That's why we built you the Flight Computer."

Santa's eyes widened and some color instantly returned to those rosy cheeks of his.

"First", said the Head Elf, "is the route. This replaces your paper list."

type Name = String
data FlightRoute = FlightRoute
  { stops :: [ Name ]
  } deriving Show

"Once you leave the North Pole, the route can't be updated again. It's fixed." "Follow me," said the Head Elf as he skipped to a terminal.

type ReaderExample a = Reader FlightRoute a

"Can you show me how to use it?" Santa said. "Sure, here's an example for you to run in GHCi" replied the Head Elf. "GH-what? Nevermind… Just show me."

demoRoute :: FlightRoute
demoRoute = FlightRoute { stops = ["Alice", "Bob", "Carol", "Dave"] }

routeReader :: ReaderExample [Name]
routeReader = asks stops

ghci> runReader routeReader demoRoute
["Alice","Bob","Carol","Dave"]

"There it is! Now I don't have to worry about forgetting the list!" exclaimed Santa.

Santa gazed at the piece of paper in his hand, paused, then, with a sigh, crumpled it up and threw it into the nearest fire in the workshop.

"Next", said the Head Elf, "we need a way to track what's in the sleigh." "We elves do our best to load it according to the route, but perfection is an illusion."

type Gift = String
data SleighState = SleighState
  { presents :: Map Name Gift
  } deriving Show

"The Flight Computer keeps track of what presents are in the sleigh. Before you depart for a house, the Flight Computer can help you double check the gift is there. No more digging around to find a gift that's not there. After you confirm the delivery, it will get removed from the sleigh." explained the Head Elf.

type StateExample a = State SleighState a

"Here's an example of it in action." the Head Elf said excitedly.

demoSleigh :: SleighState
demoSleigh = SleighState
  { presents = Map.fromList
      [ ("Alice", "Bicycle")
      , ("Bob", "Book")
      , ("Carol", "Doll")
      , ("Dave", "Drum Set")
      ]
  }

sleighAccessor :: StateExample ()
sleighAccessor = modify $ \s -> s { presents = Map.delete "Alice" (presents s) }

"Try it in GHCi," the Head Elf beckoned:

ghci> runState sleighAccessor demoSleigh
((), SleighState {presents = fromList [("Bob","Book"),("Carol","Doll"),("Dave","Drum Set")]})

"Simple, but beautiful!" exclaimed one of the young elves.

Mrs. Claus entered the workshop. The elves composed themselves.

"What about when we run into problems? We aren't perfect." said Mrs. Claus, this time offering a brief smile. "I want a report after each flight so we can correct mistakes."

"You needn't worry Mrs. Claus. You'll get your report." said the Head Elf confidently. "The report will include successful deliveries as well as the reason it was unsuccessful."

data SkipReason
  = NoGift
  | ChildAwake
  deriving (Show, Eq)

data LogEntry
  = Delivered Name Gift
  | Skipped Name SkipReason
  deriving (Show, Eq)

type WriterExample a = Writer [LogEntry] a

"Show me", demanded Mrs. Claus.

logDemo :: WriterExample ()
logDemo = do
  tell [Delivered "Alice" "Bicycle"]
  tell [Skipped "Bob" NoGift]

ghci> runWriter logDemo
((),[Delivered "Alice" "Bicycle",Skipped "Bob" NoGift])

"Later, I'll show you how the log is automatically updated. Santa doesn't have to do anything." said the Head Elf as he winked at Mrs. Claus.

Mrs. Claus stuck her elbow into Santa's ribs. "Great work everyone, let's continue."

"As Mrs. Claus has been reminding us, we aren't perfect." the Head Elf droned on. Some of the elves looked confused. "Not to worry, the Flight Computer is prepared to handle exceptions out there in the real world." The elves looked more hopeful.

data FlightError
  = ReindeerTired
  | SleighMalfunction
  deriving (Show, Eq)

type ExceptExample a = Except FlightError a

exceptDemo :: ExceptExample String
exceptDemo = throwE SleighMalfunction

ghci> runExcept exceptDemo
Left SleighMalfunction

ghci> runExcept (return "System nominal." :: ExceptExample String)
Right "System nominal."

"Santa", said the Head Elf. "This might be a good time to tell you we added some sensors to the sleigh."

"Sensors? What for?" asked Santa.

"Think of them like a check engine light. If they go off, you need to return to the North Pole for a pit stop."

"Is that really necessary? Those sensors can be so… sensitive."

Mrs. Claus stepped in. "Your flying isn't as graceful as it used to be. The sleigh has been taking a beating. Remember the year the sleigh broke down and half the world didn't get presents?"

Santa sighed, then said, "You're right", while trying to give Mrs. Claus an elbow back (she dodged it). Santa coughed to clear his throat, "We have to expect exceptions."

"Another thing", Mrs. Claus said. "The Reindeer Union have negotiated for breaks whenever they are tired."

"Yes", the Head Elf said. "We've installed a switch for Rudolph to indicate they are tired."

"Anything else I should know about?" asked Santa. "What's next?"

The Head Elf grinned ear to ear. "Next", he said, "we combine everything together."

type Flight a = ReaderT FlightRoute            -- outermost
                  (ExceptT FlightError
                    (WriterT [LogEntry]
                      (State SleighState)))    -- innermost
                  a

"The Flight Computer is composed of all the layers I just introduced", explained the Head Elf.

Santa yawned. "I barely remember… can you explain it all again?"

"First, we have the route. It can't be changed, and we have backups here at the workshop, so it can be the outermost layer. Next is the exception layer. Everything inside it survives if there is an error. That's why the log and state are inside. If something goes wrong, the Flight Computer still has a report of the flight when you get back."

"Sounds good to me." Santa looked around. Mrs. Claus nodded approvingly. "As long as I get my report."

The Head Elf nodded and quickly continued: "These helper functions let us access each layer of the stack."

-- Abort the flight
abort :: FlightError -> Flight a
abort = lift . throwE

-- Log an entry
logFlight :: LogEntry -> Flight ()
logFlight entry = lift $ lift $ tell [entry]

-- Get the current state of the sleigh
getSleigh :: Flight SleighState
getSleigh = lift $ lift $ lift get

-- Modify the state of the sleigh
updateSleigh :: (SleighState -> SleighState) -> Flight ()
updateSleigh f = lift $ lift $ lift $ modify f

Santa looked confused.

The Head Elf gestured to the terminal. "Santa, these are the main functions you'll use out there in the world. Before you leave for a stop, you can check to make sure the present is in the sleigh. After it's been delivered, you can confirm it. If you weren't able to deliver it because the child was awake, you can report this as well.

checkNextDelivery :: Name -> Flight (Maybe Gift)
checkNextDelivery name = do
  s <- getSleigh
  return $ Map.lookup name (presents s)

confirmDelivery :: Name -> Gift -> Flight ()
confirmDelivery name gift = do
  updateSleigh $ \st -> st { presents = Map.delete name (presents st) }
  logFlight $ Delivered name gift

skipDelivery :: Name -> SkipReason -> Flight ()
skipDelivery name reason = logFlight $ Skipped name reason

"Behold!" exclaimed the Head Elf. Some of the elves gasped, others broke into applause.

Mr. and Mrs. Claus gave each other a confused look.

"The Monad Transformer! This is why we are able to so elegantly call upon our Flight Computer."

runFlight :: Flight a
          -> FlightRoute
          -> SleighState
          -> ((Either FlightError a, [LogEntry]), SleighState)

runFlight flight config initialState =
  runState (runWriterT (runExceptT (runReaderT flight config))) initialState

The elves have been endlessly testing the Flight Computer. It's nearly one year later. The Head Elf wants to run one more test…

"Let us simulate a full flight," the Head Elf said. "This hard-coded demonstration shows all the cases the Flight Computer handles."

fullDemo :: ((Either FlightError (), [LogEntry]), SleighState)
fullDemo = runFlight flight demoRoute demoSleigh
  where
    flight = do
      -- Alice: successful delivery
      mGift <- checkNextDelivery "Alice"
      case mGift of
        Nothing   -> skipDelivery "Alice" NoGift
        Just gift -> confirmDelivery "Alice" gift

      -- Eve: no gift loaded (not in sleigh, elves do make mistakes)
      mGift <- checkNextDelivery "Eve"
      case mGift of
        Nothing   -> skipDelivery "Eve" NoGift
        Just gift -> confirmDelivery "Eve" gift

      -- Bob: not delivered, child is awake!
      mGift <- checkNextDelivery "Bob"
      case mGift of
        Nothing   -> skipDelivery "Bob" NoGift -- gift exists, but...
        Just _    -> skipDelivery "Bob" ChildAwake
        -- gift stays in sleigh (did not confirm delivery)

      -- Carol: successful delivery
      mGift <- checkNextDelivery "Carol"
      case mGift of
        Nothing   -> skipDelivery "Carol" NoGift
        Just gift -> confirmDelivery "Carol" gift

      -- Sensors detect malfunction! Flight Computer gives report for this flight.
      abort SleighMalfunction -- could also be ReindeerTired!

      -- Dave: never reached
      mGift <- checkNextDelivery "Dave"
      case mGift of
        Nothing   -> skipDelivery "Dave" NoGift
        Just gift -> confirmDelivery "Dave" gift

ghci> fullDemo
((Left SleighMalfunction,
  [Delivered "Alice" "Bicycle",
   Skipped "Eve" NoGift,
   Skipped "Bob" ChildAwake,
   Delivered "Carol" "Doll"]),
 SleighState {presents = fromList [("Bob","Book"),("Dave","Drum Set")]})

"Got it." Santa nodded.

"For those cities where all the kids are asleep, it looks a lot nicer." The Head Elf's eyes sparkled. "I wrote this helper function to demonstrate it. However, when you're out in the world, you at least need to confirm each delivery."

deliver :: Name -> Flight ()
deliver name = do
  mGift <- checkNextDelivery name
  case mGift of
    Nothing   -> skipDelivery name NoGift
    Just gift -> confirmDelivery name gift

happyPath :: ((Either FlightError (), [LogEntry]), SleighState)
happyPath = runFlight flight demoRoute demoSleigh
  where
    flight = do
      route <- asks stops
      mapM_ deliver route

ghci> happyPath
((Right (),[Delivered "Alice" "Bicycle",
            Delivered "Bob" "Book",
            Delivered "Carol" "Doll",
            Delivered "Dave" "Drum Set"]),
 SleighState {presents = fromList []})

"See that?" the Head Elf beamed. "The route drives everything now. No more paper lists."

Santa nodded slowly. "I think I'm starting to understand… nomads?"

Mrs. Claus turned to walk away. "Get some rest everyone. We have a big day tomorrow."