Santa.hs

import Control.Monad (zipWithM)
import Data.Foldable (foldlM)

data Command = Up | Down

parseChar :: Char -> Int -> Either String Command
parseChar '(' _ = Right Up
parseChar ')' _ = Right Down
parseChar c i = Left $ "Parse Error: unexpected token " ++ [c] ++ " at index " ++ (show i)

parse :: String -> Either String [Command]
parse str = zipWithM parseChar str [0..]

floors :: [Command] -> [Int]
floors = scanl command 0
  where
    command :: Int -> Command -> Int
    command floor Up = floor + 1
    command floor Down = floor - 1

basement :: [Int] -> Either String Int
basement fs = case filter ((< 0) . snd) $ zip [0..] fs of
  ((i, _):_) -> Right i
  [] -> Left "Santa never hit the basement!"
  
hoistError :: Either String a -> IO a
hoistError (Left err) = fail err
hoistError (Right a) = return a

main :: IO ()
main = do
  cmds <- hoistError $ parse $ (replicate 1000 '(') ++ (replicate 1001 ')') ++ (replicate 2000 '(')
  let fs = floors cmds
  putStrLn $ "Santa ended on floor " ++ (show $ last $ fs)
  basement <- hoistError $ basement $ fs
  putStrLn $ "Santa entered the basement on command " ++ (show basement)