summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorlassulus <lass@lassul.us>2017-04-27 23:13:58 +0200
committerlassulus <lass@lassul.us>2017-04-30 19:55:39 +0200
commitca30ec09790c60c5bc904488fb5e17c36dad10aa (patch)
tree487c9d1e84cb27812ed2c91c16b3a67c5114d922
"Boom!"
-rw-r--r--news.hs78
-rw-r--r--shell.nix39
2 files changed, 117 insertions, 0 deletions
diff --git a/news.hs b/news.hs
new file mode 100644
index 0000000..ce48ccc
--- /dev/null
+++ b/news.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Data.Monoid
+import Prelude hiding (elem)
+import Network.Wreq
+import Control.Lens
+import Text.Feed.Import
+import qualified Text.Atom.Feed as Atom
+import qualified Data.ByteString.Lazy.Char8 as LBS8
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString as BS
+import Text.RSS.Syntax
+import qualified Text.Feed.Types as Feed
+import qualified Data.BloomFilter as Bloom
+import qualified Data.BloomFilter.Easy as Bloom
+import Control.Concurrent
+import System.Environment
+import System.IO
+import Control.Exception
+
+
+data Item = Item
+ { ni_title :: BS.ByteString
+ , ni_link :: BS.ByteString
+ }
+ deriving Show
+
+
+atomEntryToItems :: Atom.Entry -> [Item]
+atomEntryToItems entry =
+ map (Item title) links
+ where
+ title = BS8.pack $ Atom.txtToString (Atom.entryTitle entry)
+ links = map (BS8.pack . Atom.linkHref) (Atom.entryLinks entry)
+
+rssItemToItems :: RSSItem -> [Item]
+rssItemToItems item =
+ map (Item title) links
+ where
+ title = maybe "untitled" BS8.pack (rssItemTitle item)
+ links = maybe [] ((:[]) . BS8.pack) (rssItemLink item)
+
+
+main :: IO ()
+main = do
+ hSetBuffering stdout LineBuffering
+ [url, delayString] <- getArgs
+ let delay = read delayString :: Int
+ rec url delay (Bloom.easyList 0.000001 ([] :: [BS.ByteString]))
+ return ()
+ where
+ rec url delay bloom =
+ ( do
+ r <- get url
+ let f = parseFeedString $ LBS8.unpack $ r ^. responseBody
+ items =
+ case f of
+ Just (Feed.RSSFeed rss) ->
+ concatMap rssItemToItems (rssItems (rssChannel rss))
+ Just (Feed.AtomFeed atom) ->
+ concatMap atomEntryToItems (Atom.feedEntries atom)
+ _ -> []
+
+ bloom' = Bloom.insertList (map ni_link items) bloom
+ newLinkItems = filter (\item ->
+ let link = ni_link item in
+ link `Bloom.notElem` bloom
+ ) items
+ mapM_ print (map (\item ->
+ let title = ni_title item
+ link = ni_link item
+ in title <> " " <> link
+ ) newLinkItems)
+ threadDelay (delay * 10^6)
+ rec url delay bloom'
+ )
+ `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException)) >> rec url delay bloom
+
+
diff --git a/shell.nix b/shell.nix
new file mode 100644
index 0000000..9abf4be
--- /dev/null
+++ b/shell.nix
@@ -0,0 +1,39 @@
+
+let
+ pname = "news";
+ version = "1";
+
+ pkgs = nixpkgs // extrapkgs;
+ nixpkgs = import <nixpkgs> {};
+ extrapkgs = {
+ };
+ hsPkgs = pkgs.haskellPackages.override {
+ overrides = self: super: {
+ };
+ };
+ hsEnv = hsPkgs.ghcWithPackages (_hsPkgs: with _hsPkgs;
+ [
+ bloomfilter
+ irc
+ irc-client
+ feed
+ split
+ warp
+ wai-util
+ wreq
+ ]);
+in
+
+pkgs.myEnvFun {
+ name = "${pname}-${version}";
+
+ buildInputs = with pkgs; [
+ hsEnv
+ ];
+
+ extraCmds = with pkgs; ''
+ $(grep export ${hsEnv.outPath}/bin/ghc)
+ '';
+}
+
+# vim: set fdm=marker :