96 lines
2.5 KiB
Haskell
96 lines
2.5 KiB
Haskell
|
{-# 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
|