Advent of Code day 1

adventday1.hs

{-

After feeling like you've been falling for a few minutes, you look at the device's tiny screen. 
"Error: Device must be calibrated before first use. Frequency drift detected. Cannot maintain
destination lock." Below the message, the device shows a sequence of changes in frequency 
(your puzzle input). A value like +6 means the current frequency increases by 6; a value like 
-3 means the current frequency decreases by 3.

For example, if the device displays frequency changes of +1, -2, +3, +1, then starting from 
a frequency of zero, the following changes would occur:

    Current frequency  0, change of +1; resulting frequency  1.
    Current frequency  1, change of -2; resulting frequency -1.
    Current frequency -1, change of +3; resulting frequency  2.
    Current frequency  2, change of +1; resulting frequency  3.

In this example, the resulting frequency is 3.

Here are other example situations:

    +1, +1, +1 results in  3
    +1, +1, -2 results in  0
    -1, -2, -3 results in -6

Starting with a frequency of zero, what is the resulting frequency after all of the changes 
in frequency have been applied?

-}

import Control.Exception
import Prelude hiding (lines)
import Data.List (find)
import Data.Maybe (catMaybes)
import Data.IntSet hiding (foldr)

main :: IO ()
main = do
  lines <- readLines []
  print (answerOne lines)
  answerTwoTests
  print (answerTwo lines)

newtype FrequencyChange =
  FrequencyChange { eval :: Int -> Int }

instance Read FrequencyChange where
  readsPrec _ ('+':rest) =
    case reads rest of
      [(n, "")] -> [(FrequencyChange (\acc -> acc + n), "")]
      _ -> []
  readsPrec _ ('-':rest) =
    case reads rest of
      [(n, "")] -> [(FrequencyChange (\acc -> acc - n), "")]
      _ -> []
  readsPrec _ _ = []

answerOne :: [FrequencyChange] -> Int
answerOne lines = foldr eval 0 lines

answerTwo :: [FrequencyChange] -> Maybe Int
answerTwo lines =
  let -- scanl is like "fold" but returns a list of intermediate results
      results = scanl evalLineAndKeepResult (0, mempty) (cycle lines)
      -- uncurry applies any function with two arguments to a tuple
      firstDouble = find (uncurry member) results in
    fst <$> firstDouble

evalLineAndKeepResult :: (Int, IntSet) -> FrequencyChange -> (Int, IntSet)
evalLineAndKeepResult (acc, results) line =
  (eval line acc, insert acc results)

answerTwoTests :: IO ()
answerTwoTests = do
  test1 <- mapM readLine ["+3","+3","+4","-2","-4"]
  print (answerTwo (catMaybes test1))
  test2 <- mapM readLine ["-6", "+3", "+8", "+5", "-6"]
  print (answerTwo (catMaybes test2))
  test3 <- mapM readLine ["+7", "+7", "-2", "-7", "-4"]
  print (answerTwo (catMaybes test3))

readLines :: [FrequencyChange] -> IO [FrequencyChange]
readLines acc = do
  res <- handle endOfFile (readLine =<< getLine)
  case res of
    Just line -> readLines (line:acc)
    Nothing   -> return (reverse acc)
  where endOfFile :: SomeException -> IO (Maybe FrequencyChange)
        endOfFile _  = return Nothing

readLine :: String -> IO (Maybe FrequencyChange)
readLine str = do
  handle badLine (return (Just (read str)))
  where badLine :: SomeException -> IO (Maybe FrequencyChange)
        badLine _  = return Nothing