{-# 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 res <- try $ simpleHttp (url <> page) case res of Left (_ :: HttpException) -> return [] Right cur -> (parseComic cur n :) <$> findPages' (succ n) link where page = unpack link <> show n 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