oglaf/Main.hs

{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}

import Control.Monad             (when, forM_)
import Control.Exception         (try)
import Data.Text                 (Text, unpack)
import qualified Data.Text.IO    as T
import Data.Monoid
import Data.ByteString.Lazy      (hPut)
import System.IO
import System.IO.Temp            (withSystemTempFile)
import System.Environment        (getEnv, lookupEnv)
import Network.HTTP.Conduit      (HttpException, simpleHttp)

import Telegram
import Parser

url :: String
url = "http://oglaf.com"


commands :: String -> Comic -> [Command]
commands path Comic{..} =
  [ if page == 1
    then message user title
    else nothing 
  , sendFile user path
  , message  user descr ]


cache :: IO String
cache = do
  path <- lookupEnv "XDG_CACHE_HOME"
  case path of
    Just x  -> return (x <> "/oglaf")
    Nothing -> (<> "/.cache/oglaf") <$> getEnv "HOME"


lastComic :: IO Text
lastComic = do
  res <- try (T.readFile =<< cache)
  case res of
    Left (err :: IOError) -> do
      putStrLn ("Can't read saved state " <> show err)
      putStrLn "Send anyway"
      return ""
    Right title -> return title


setLastComic :: Text -> IO ()
setLastComic title = cache >>= flip T.writeFile title


findPages :: Text -> IO [Comic]
findPages = findPages' 1 where
  findPages' n link = do
    let page = if n>1 then show n else ""
    res <- simpleHttp (url <> (unpack link <> page))
    if isLastPage res
      then return [parseComic res n]
      else (parseComic res n :) <$> findPages' (succ n) link


main :: IO ()
main = do
  comics <- parseArchive <$> simpleHttp (url <> "/archive")
  when (null comics) (fail "error parsing comics archive")

  let latest = head comics
  last <- lastComic

  if latest == last
    then T.putStrLn ("Already sent " <> last <> ", stopping")
    else do
      pages   <- findPages latest
      process <- telegramProcess
      socket  <- telegramSocket

      send socket connect

      forM_ pages $ \comic ->
        withSystemTempFile "oglaf.png" $ \path temp -> do
          simpleHttp (imgUrl comic) >>= hPut temp
          hClose temp
          result <- try $ mapM (send socket) (commands path comic)

          case result of
            Left (err :: IOError) -> do
              putStrLn "failed" >> print err
              fail "Could not send the comic :("
            Right _ -> do
              setLastComic latest
              putStrLn ("Sent " <> show (page comic))

      closeTelegram socket process