src/Advent.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 module Advent (runAdvent, getDay, cacheAllDays) where
   3
   4 import Control.Concurrent (threadDelay)
   5
   6 import Data.ByteString.Char8 (pack)
   7 import Data.ByteString.Lazy (ByteString)
   8 import qualified Data.Text.Lazy as L
   9 import qualified Data.Text.Lazy.IO as L
  10 import qualified Data.Text.Lazy.Encoding as L
  11
  12 import Data.Time.Clock
  13 import Data.Time.Calendar
  14 import Data.Time.LocalTime
  15 import Data.Time.Format
  16
  17 import Control.Monad.Catch
  18 import Control.Monad.Reader
  19
  20 import System.Directory
  21 import System.Environment
  22
  23 import Network.HTTP.Conduit
  24 import Network.HTTP.Types
  25 import Data.Time (ZonedTime(ZonedTime))
  26
  27 import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)
  28
  29 runAdvent :: MonadIO m => ReaderT Manager m b -> m b
  30 runAdvent f = do
  31   liftIO $ hSetBuffering stdout NoBuffering
  32   man <- liftIO $ newManager tlsManagerSettings
  33   runReaderT f man
  34
  35 download :: (MonadReader Manager m, MonadIO m, MonadThrow m) => String -> m (Response ByteString)
  36 download url = do
  37   man <- ask
  38   req <- parseRequest url
  39   session <- liftIO $ getEnv "AOC_SESSION"
  40   let sessionCookie = Cookie
  41         { cookie_name = "session"
  42         , cookie_value = pack session
  43         , cookie_expiry_time = future
  44         , cookie_domain = "adventofcode.com"
  45         , cookie_path = "/"
  46         , cookie_creation_time = past
  47         , cookie_last_access_time = past
  48         , cookie_persistent = False
  49         , cookie_host_only = False
  50         , cookie_secure_only = False
  51         , cookie_http_only = False
  52         }
  53   httpLbs req {cookieJar = Just $ createCookieJar [sessionCookie]} man
  54
  55   where
  56     past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
  57     future = UTCTime (ModifiedJulianDay 562000) (secondsToDiffTime 0)
  58
  59 getDay :: (MonadReader Manager m, MonadIO m, MonadThrow m) => Int -> Int -> m String
  60 getDay year day = do
  61   cached <- liftIO $ (&&) <$> doesFileExist dayCache <*> doesFileExist inputCache
  62   if cached
  63     then liftIO $ readFile dayCache
  64     else do
  65       liftIO $ putStrLn $ "Caching " <> show year <> "/" <> show day
  66       liftIO $ createDirectoryIfMissing True cacheDir
  67       day <- retreiveDay
  68       liftIO $ writeFile dayCache day
  69       pure day
  70
  71   where
  72     cacheDir   = "aocache/"
  73     dayCache   = cacheDir <> show year <> "." <> show day
  74     inputCache = dayCache <> ".input"
  75
  76     retreiveDay = do
  77       day <- download $ "https://adventofcode.com/" <> show year <> "/day/" <> show day <> "/input"
  78       if statusCode (responseStatus day) == 200
  79         then do
  80           let body = L.unpack . L.decodeUtf8 . responseBody
  81           pure $ body day
  82         else do
  83           -- TODO: Check calendar to know how long to wait for!!!
  84           currentTime <- liftIO getCurrentTime
  85           let estTime = utcToZonedTime (hoursToTimeZone (-5)) currentTime
  86               dayTime = zonedTimeToUTC $ estTime { zonedTimeToLocalTime = (zonedTimeToLocalTime estTime) { localTimeOfDay = midnight } }
  87               dayTime' | currentTime > dayTime = addUTCTime nominalDay dayTime
  88                        | otherwise = dayTime
  89           countdown dayTime'
  90           retreiveDay
  91
  92     countdown dest = do
  93       current <- liftIO getCurrentTime
  94       when (current <= dest) $ do
  95         let remaining = dest `diffUTCTime` current
  96         liftIO $ putStr $ formatTime defaultTimeLocale "%H:%M:%S\r" remaining
  97         liftIO $ threadDelay 1000000
  98         countdown dest
  99
 100 cacheAllDays :: (MonadReader Manager m, MonadIO m, MonadThrow m) => m ()
 101 cacheAllDays = sequence_ [getDay year day | year <- [2015..2021], day <- [1..25]]