readability 0.0.1.0 → 0.1.0.0

raw patch · 8 files changed

+144/−15 lines, 8 filesdep +aeson

Dependencies added: aeson

Files

CHANGELOG.md +6/−0
README.md +25/−0
app/Main.hs +40/−8
readability.cabal +3/−1
src/Readability.hs +1/−1
src/Readability/Internal.hs +3/−0
src/Readability/Title.hs +61/−0
src/Readability/Types.hs +5/−5

CHANGELOG.md view

@@ -1,5 +1,11 @@ # Revision history for readability +## 0.1.0.0 – 2020-07-09++* Added reading of data from standard input+* Added option `extract` to command line to choose what to print+* Added extraction of title and short title+ ## 0.0.1.0 – 2020-06-26  * First version

README.md view

@@ -124,6 +124,31 @@ held. Saving and wealth—what is the relation? ``` +We can also print only title or short title of the article:++``` shell+$> readability --extract shortTitle https://mises.org/wire/why-central-banks-are-threat-our-savings+Why Central Banks Are a Threat to Our Savings+```++Or we can print all available information as JSON for further processing:++``` shell+$> readability --extract all https://mises.org/wire/why-central-banks-are-threat-our-savings | jq '.'+{+  "article": "…",+  "shortTitle": "Why Central Banks Are a Threat to Our Savings",+  "title": "Why Central Banks Are a Threat to Our Savings | Mises Wire"+}+```++Raw HTML can be also provided using standard input when SOURCE is omitted:++``` shell+$> curl -s https://mises.org/wire/why-central-banks-are-threat-our-savings | readability -e title+Why Central Banks Are a Threat to Our Savings | Mises Wire+```+ ## Contribute  Project is hosted at https://sr.ht/~geyaeb/haskell-readability/ . The homepage provides links to [Mercurial repository](https://hg.sr.ht/~geyaeb/haskell-readability), [mailing list](https://lists.sr.ht/~geyaeb/haskell-readability) and [ticket tracker](https://todo.sr.ht/~geyaeb/haskell-readability).

app/Main.hs view

@@ -1,41 +1,73 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  module Main where +import Data.Aeson+import Data.Aeson.Text (encodeToLazyText)+import qualified Data.Text.IO as TIO import qualified Data.Text.Lazy.IO as TL import Network.HTTP.Simple import Options.Applicative import qualified Readability as R import Text.XML -data Source = File FilePath | Web Request deriving (Show)+data Source = StdIn | File FilePath | Web Request deriving (Show) -data Opts = Opts {optInput :: Source} deriving (Show)+data Extract = Body | Title | ShortTitle | All deriving (Eq, Show) +data Opts = Opts {optExtract :: Extract, optInput :: Source} deriving (Show)+ main :: IO () main = do-  (Opts src) <- execParser opts+  (Opts ext src) <- execParser opts   article <- case src of     File f -> R.fromFile f     Web req -> R.fromByteString . getResponseBody <$> httpLBS req-  case R.summary <$> article of-    Just doc -> TL.putStrLn $ renderText def {rsPretty = True, rsXMLDeclaration = True} doc+    StdIn -> R.fromText <$> TL.getContents+  case article of+    Just R.Article {..} -> do+      case ext of+        Body -> TL.putStrLn $ render summary+        Title -> maybe (return ()) TIO.putStrLn title+        ShortTitle -> maybe (return ()) TIO.putStrLn shortTitle+        All -> TL.putStrLn (encodeToLazyText $ object ["article" .= render summary, "title" .= title, "shortTitle" .= shortTitle])     Nothing -> return ()+  where+    render = renderText def {rsPretty = True, rsXMLDeclaration = True}  opts :: ParserInfo Opts opts =   info     (options <**> helper)     ( fullDesc-        <> progDesc "Provide FILE or URL as source"+        <> progDesc "Provide FILE or URL as source or nothing for reading from stdin"         <> header "readability - extract article from HTML"     )  options :: Parser Opts options = do-  inf <- argument source (metavar "SOURCE")-  pure $ Opts inf+  ext <-+    option+      extract+      ( value Body+          <> short 'e'+          <> long "extract"+          <> help "Extract 'article' (default), 'title', 'shortTitle', 'all' (as JSON)"+      )+  inf <- argument source (value StdIn <> metavar "SOURCE")+  pure $ Opts ext inf  source :: ReadM Source source = maybeReader \s -> Web <$> parseRequest s <|> Just (File s)++extract :: ReadM Extract+extract = eitherReader \case+  "article" -> Right Body+  "title" -> Right Title+  "shortTitle" -> Right ShortTitle+  "all" -> Right All+  _ -> Left "Only 'article', 'title', 'shortTitle' or 'all' can be extracted"

readability.cabal view

@@ -1,7 +1,7 @@ cabal-version: >= 1.10  name:                readability-version:             0.0.1.0+version:             0.1.0.0 synopsis:            Extracts text of main article from HTML document description:         Give @readability@ an HTML document and it will detect and extract text of the article while removing everything unnecessary like menus, advertisements or sidebars. It is more or less reimplementation of [python-readability](https://github.com/buriy/python-readability). homepage:            https://sr.ht/~geyaeb/haskell-readability@@ -26,6 +26,7 @@       Readability.Helper       Readability.Internal       Readability.Metrics+      Readability.Title       Readability.Types   hs-source-dirs:       src@@ -60,6 +61,7 @@      -Wall   build-depends:       base >=4.7 && <5+    , aeson >= 1.4 && < 1.6     , http-conduit == 2.3.*     , optparse-applicative == 0.15.*     , readability

src/Readability.hs view

@@ -25,7 +25,7 @@  -- | Extracts article from HTML represented as HTML document. fromDocument' :: Settings -> Document -> Maybe Article-fromDocument' s d = Article <$> I.summary s d+fromDocument' s d = (\smr -> Article smr (I.title d) (I.shortTitle d)) <$> I.summary s d  -- | Extracts article from HTML in ByteString. fromByteString :: ByteString -> Maybe Article

src/Readability/Internal.hs view

@@ -2,6 +2,8 @@  module Readability.Internal   ( Readability.Internal.summary,+    Readability.Title.shortTitle,+    Readability.Title.title,     rootSummary,   ) where@@ -11,6 +13,7 @@ import Readability.Clean import Readability.Helper import Readability.Metrics+import Readability.Title import Readability.Types import Text.XML import Text.XML.Cursor

+ src/Readability/Title.hs view

@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Readability.Title+  ( title,+    shortTitle,+  )+where++import Data.Foldable (find, maximumBy, minimumBy)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Ord (comparing)+import qualified Data.Text as T+import Text.XML+import Text.XML.Cursor++-- | Extracts title (@<title>@) from HTML document and normalizes by removing exceeding white spaces.+title :: Document -> Maybe T.Text+title doc =+  fmap (T.unwords . T.words) $+    find (not . T.null) $+      fromDocument doc $// checkName (== "title") &/ content++-- | Attempts to find shortened version of title without page name.+shortTitle :: Document -> Maybe T.Text+shortTitle doc = find (\c -> T.length c >= 15 && T.length c <= 150) (findShortTitle <$> title doc)+  where+    findShortTitle t = case candidates t of+      [] -> extractTitle t+      cs -> minimumBy (comparing T.length) cs+    candidates t =+      filter+        ( \c ->+            length (T.words c) >= 2+              && T.length c >= 15+              && c `T.isInfixOf` t+        )+        $ fromDocument doc $// checkElement maybeTitle &/ content++-- | Determines whether an element can hold a title of article.+-- These are considered as potential candidates (as CSS selector):+--  * h1, h2, h3+--  * #title, #head, #heading+--  * .pageTitle, .news_title, .title, .head, .heading, .contentheading, .small_header_red+maybeTitle :: Element -> Bool+maybeTitle Element {..} =+  elementName `elem` ["h1", "h2", "h3"]+    || maybe False (`elem` ["title", "head", "heading"]) (Map.lookup "id" elementAttributes)+    || maybe False (any (`elem` ["pageTitle", "news_article", "title", "head", "heading", "contentheading", "small_header_red"]) . T.words) (Map.lookup "class" elementAttributes)++-- | Attempts to extract article name from page title, for example "Chancellor Alistair Darling on brink of second bailout for banks | The Times" would detect @|@ as delimiter and would return "Chancellor Alistair Darling on brink of second bailout for banks".+extractTitle :: T.Text -> T.Text+extractTitle t = fromMaybe z y+  where+    delim = [" | ", " - ", " :: ", " – ", " — ", " / "]+    x d = T.unwords $ maximumBy (comparing length) $ filter (\l -> length l >= 4) $ T.words <$> T.splitOn d t+    y = listToMaybe (x <$> filter (`T.isInfixOf` t) delim)+    z =+      let (_, s) = T.breakOnEnd t ": "+       in if length (T.words s) >= 4 then s else T.drop 2 (fst $ T.breakOn t ": ")

src/Readability/Types.hs view

@@ -14,18 +14,18 @@  import Data.List (maximumBy) import qualified Data.Map.Strict as M--- import qualified Data.Text as T+import qualified Data.Text as T import Text.XML import Text.XML.Cursor  -- | Result of processing HTML through /readability/. data Article = Article   { -- | Body of article of original HTML.-    summary :: Document-    {- Title of original HTML if found.+    summary :: Document,+    -- | Title of original HTML if found.     title :: Maybe T.Text,-    -- Possibly simplified title.-    shortTitle :: Maybe T.Text-}+    -- | Possibly simplified title.+    shortTitle :: Maybe T.Text   }   deriving (Show)