Elevators

elevator.clj

(defn elevator [commands]
  (letfn [(ff-open [[cmd & rest]]
            #(case cmd
               :close (ff-closed rest)
               :done true
               false))
          (ff-closed [[cmd & rest]]
            #(case cmd
               :open (ff-open   rest)
               :up   (sf-closed rest)
               false))
          (sf-open [[cmd & rest]]
            #(case cmd
               :close (sf-closed rest)
               :done true
               false))
          (sf-closed [[cmd & rest]]
            #(case cmd
               :open (sf-open rest)
               :down (ff-closed rest)
               false))]
    (trampoline ff-open commands)))

(elevator [:close :up :open :close :down :open :done])

elevator.hs

module Main where

data Action = Close | Open | Up | Down | Done      deriving Show
data State = FFOpen | FFClosed | SFOpen | SFClosed deriving Show

elevator :: [Action] -> Bool
elevator actions = elevator' FFOpen actions where
  elevator' FFOpen (Done :_)    = True
  elevator' FFOpen ( _   :[])   = False
  elevator' FFOpen (Close:rest) = elevator' FFClosed rest
  elevator' FFOpen _            = False

  elevator' FFClosed ( _  :[])   = False
  elevator' FFClosed (Open:rest) = elevator' FFOpen   rest
  elevator' FFClosed (Up  :rest) = elevator' SFClosed rest
  elevator' FFClosed _           = False

  elevator' SFOpen (Done :_)    = True
  elevator' SFOpen ( _   :[])   = False
  elevator' SFOpen (Close:rest) = elevator' SFClosed rest
  elevator' SFOpen _            = False

  elevator' SFClosed ( _  :[])   = False
  elevator' SFClosed (Open:rest) = elevator' SFOpen   rest
  elevator' SFClosed (Down:rest) = elevator' FFClosed rest
  elevator' SFClosed _           = False

main = print $ elevator [Close, Up, Open, Close, Down, Open, Done]