gscholar-rss-0.1.0.0: src/Main.hs

{-# Language OverloadedStrings #-}

-- todo [release] date?
-- todo [release] fallo diventare script, asptta che cabal 2.4 vaa in
--                deb stable.

module Main where

import System.Environment
import Network.HTTP.Simple
import Text.HTML.Scalpel.Core
import Text.RSS.Syntax
import Text.RSS.Export
import Text.URI

import qualified Data.Text          as T
import qualified Data.Text.Lazy.IO  as TLI
import qualified Data.Text.Encoding as TE
import qualified Data.String        as DS


main :: IO ()
main = -- get args
       map T.pack <$> getArgs >>= \as ->

       -- malformed input
       if null as ||
          length as > 1 ||
          head as `elem` ["--help", "-h"]
       then putStrLn helps
       else

       -- scrape
       let url = head as in
       scrapeGet url page >>= \p ->
       printRSS url p

    where
          scrapeGet :: URL -> Scraper T.Text a -> IO a
          scrapeGet url s = getURLBody url  >>= \b ->
                            let r = maybe (error errs)
                                          id
                                          (scrapeStringLike b s)
                            in return r


-----------
-- TYPES --
-----------

data Page = Page Title [Article]
          deriving (Show, Eq)
type Title = T.Text

data Article = Article Title URL Author
             deriving (Show, Eq)
type Author = T.Text
type URL = T.Text


------------
-- SCRAPE --
------------

page :: Scraper T.Text Page
page = Page <$> text "title"
            <*> chroot ("div" @: ["id" @= "gs_res_ccl_mid"]) entries

entries :: Scraper T.Text [Article]
entries = chroots ("div" @: [hasClass "gs_ri"]) paper
    where
          paper = Article <$> text ("h3" @: [hasClass "gs_rt"])
                          <*> attr "href" "a"
                          <*> text ("div" @: [hasClass "gs_a"])

buildRSS :: URL -> Page -> RSS
buildRSS u (Page t as) =
        (nullRSS "rss title" "link") {
          rssChannel = (nullChannel u "link") {
            rssItems = map buildItem as }}
    where
          buildItem :: Article -> RSSItem
          buildItem (Article t u a) =
                (nullItem t) {
                    rssItemLink = Just $ u,
                    rssItemAuthor = Just $ a }


-------------
-- GET/PUT --
-------------

getURLBody :: URL -> IO T.Text
getURLBody url = getResponseBody <$> httpBS req >>= \b ->
                 return (TE.decodeLatin1 b)
    where
          req = DS.fromString (T.unpack url)

feedTitle :: URL -> Title
feedTitle url = case lookup "q" (queryToPairs $ T.unpack url) of
                  Nothing -> "Error: title not found"
                  Just t  -> "gscholar-rss: " <> T.pack t

printRSS :: URL -> Page -> IO ()
printRSS url s =
    case textRSS . buildRSS (feedTitle url) $ s of
      Nothing -> error errs
      Just s  -> TLI.putStrLn s

helps :: String
helps = unlines ["invoke as: ",
                 "gscholar-rss <search-url>"]

errs :: String
errs  = "Could not parse, please report to fa-ml@ariis.it"