Improved rss digests

nixos/machines/hera/cloud.nix

@@ -124,27 +124,7 @@ with lib; let
   };
   mainHostName = "cloud.maralorn.de";
 in {
-  systemd = {
-    services =
-      {
-        rss-server = {
-          serviceConfig.ExecStart = "${pkgs.python3}/bin/python -m http.server --bind ${hosts.vpn.hera} 8842 -d /var/www/rss";
-          wantedBy = ["multi-user.target"];
-        };
-        mastodon-digest = {
-          script = ''
-            ln -fs ${pkgs.privatePath "mastodon-env"} .env
-            now=$(date "+%Y-%m-%d")
-            mkdir -p /var/www/rss/mastodon/$now-highlights
-            mkdir -p /var/www/rss/mastodon/$now-all
-            ${pkgs.mastodon_digest}/bin/mastodon_digest -o /var/www/rss/mastodon/$now-highlights -n 24 -t lax --theme light
-            ${pkgs.mastodon_digest}/bin/mastodon_digest -o /var/www/rss/mastodon/$now-all -n 24 -t all --theme light -f list:3811
-          '';
-          startAt = "19:59";
-        };
-      }
-      // nextcloudServices mainHostName;
-  };
+  systemd.services = nextcloudServices mainHostName;
   services = {
     redis.servers."".enable = true;
     nextcloud = nextcloudConf mainHostName;

nixos/roles/miniflux.nix

@@ -2,19 +2,46 @@
   pkgs,
   config,
   ...
-}: {
+}: let
+  inherit (config.m-0) hosts;
+in {
   services.miniflux = {
     enable = true;
     adminCredentialsFile = pkgs.privatePath "miniflux-admin-credentials";
     config = {
       POLLING_FREQUENCY = "525600"; # We don‘t want polling so we set this to a year.
       BATCH_SIZE = "1000"; # To make sure that all feeds can get refreshed. Default is 100, which is probably fine.
-      LISTEN_ADDR = "[${config.m-0.hosts.vpn.hera}]:8100";
+      LISTEN_ADDR = "[${hosts.vpn.hera}]:8100";
     };
   };
-  systemd.services."refresh-miniflux" = {
-    script = "${pkgs.curl}/bin/curl -X PUT -H \"X-AUTH-TOKEN: $(cat $CREDENTIALS_DIRECTORY/miniflux_token)\" hera.vpn.m-0.eu:8100/v1/feeds/refresh";
-    startAt = "20:00:00";
-    serviceConfig.LoadCredential = ["miniflux_token:${pkgs.privatePath "miniflux-refresh-token"}"];
+  systemd.services = {
+    rss-server = {
+      serviceConfig.ExecStart = "${pkgs.python3}/bin/python -m http.server --bind ${hosts.vpn.hera} 8842 -d /var/www/rss";
+      wantedBy = ["multi-user.target"];
+    };
+    mastodon-digest = {
+      script = ''
+        ln -fs ${pkgs.privatePath "mastodon-env"} .env
+        now=$(date "+%Y-%m-%d")
+        mkdir -p /var/www/rss/mastodon/$now-home-feed-highlights
+        mkdir -p /var/www/rss/mastodon/$now-read-all-list
+        ${pkgs.mastodon_digest}/bin/mastodon_digest -o /var/www/rss/mastodon/$now-home-feed-highlights -n 24 -t lax --theme light
+        ${pkgs.mastodon_digest}/bin/mastodon_digest -o /var/www/rss/mastodon/$now-read-all-list -n 24 -t all --theme light -f list:3811
+        ${pkgs.logfeed}/bin/mastodon2rss /var/www/rss/mastodon.xml /var/www/rss/mastodon
+      '';
+      serviceConfig = {
+        Type = "oneshot";
+      };
+    };
+    refresh-miniflux = {
+      script = "${pkgs.curl}/bin/curl -X PUT -H \"X-AUTH-TOKEN: $(cat $CREDENTIALS_DIRECTORY/miniflux_token)\" hera.vpn.m-0.eu:8100/v1/feeds/refresh";
+      after = ["mastodon-digest.service"];
+      requires = ["mastodon-digest.service"];
+      startAt = "20:00:00";
+      serviceConfig = {
+        Type = "oneshot";
+        LoadCredential = ["miniflux_token:${pkgs.privatePath "miniflux-refresh-token"}"];
+      };
+    };
   };
 }

packages/logfeed/Mail.hs

@@ -1,16 +1,4 @@
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE ViewPatterns #-}
+module Mail (main) where
 
 import Control.Error (
   throwE,
@@ -28,7 +16,7 @@ import Data.MIME qualified as MIME
 import Data.MIME.Charset
 import Data.Map qualified as Map
 import Data.String.Interpolate
-import Data.Text qualified as T
+import Data.Text qualified as Text
 import Data.Time
 import Notmuch qualified
 import Options.Applicative qualified as O
@@ -38,7 +26,7 @@ import Say
 import Text.Atom.Feed
 import Text.Atom.Feed.Export (textFeed)
 import Text.HTML.TagSoup
-import Prelude ()
+import Witch
 
 data Options = Options
   { dbPath :: String
@@ -82,8 +70,8 @@ main = do
         O.fullDesc
   res <- runExceptT do
     (thrds, msgs) <- withExceptT
-      ( \(er :: Notmuch.Status) ->
-          [i|Failed to read notmuch data.\ndb path: #{dbPath}\nquery: Folder #{folder}\nerror: #{er}|]
+      ( \(notmuch_status :: Notmuch.Status) ->
+          [i|Failed to read notmuch data.\ndb path: #{dbPath}\nquery: Folder #{folder}\nerror: #{notmuch_status}|]
       )
       do
         db <- Notmuch.databaseOpenReadOnly dbPath
@@ -98,8 +86,7 @@ main = do
             fst
             (msgsByThread <> thrdsByThread)
     now <- lift getCurrentTime
-    let entries =
-          threadToEntry <$> sortOn (date :: Thread -> UTCTime) (rights result)
+    let entries = threadToEntry <$> sortOn (.date) (rights result)
         feed =
           nullFeed
             [i|read-later-e-mails-#{timestamp now}|]
@@ -109,15 +96,11 @@ main = do
     feedText <-
       tryJust [i|Failed to generate feed.|] . textFeed $
         feed
-          { feedEntries =
-              (if null errors then id else (errorsToEntry now errors :))
-                entries
+          { feedEntries = (if null errors then id else (errorsToEntry now errors :)) entries
           }
     say $ toStrict feedText
   either
-    ( \(er :: Text) ->
-        sayErr [i|mail2feed failed to export mails to rss.\n#{er}|]
-    )
+    (\(er :: Text) -> sayErr [i|mail2feed failed to export mails to rss.\n#{er}|])
     (const pass)
     res
 
@@ -130,7 +113,7 @@ threadToEntry Thread{subject, messages, threadid, totalCount, date, authors} =
  where
   threadUrl = [i|thread-#{threadid}-#{timestamp date}|]
   threadTitle = TextString [i|#{subject} (#{length messages}/#{totalCount})|]
-  content = T.intercalate [i|<br>\n<hr>\n|] (messageToHtml <$> messages)
+  content = Text.intercalate [i|<br>\n<hr>\n|] (messageToHtml <$> messages)
 
 errorsToEntry :: UTCTime -> [Error] -> Entry
 errorsToEntry now er =
@@ -142,14 +125,14 @@ errorsToEntry now er =
     { entryContent =
         Just
           . HTMLContent
-          . T.intercalate "<br>\n"
-          . T.splitOn "\n"
-          . T.intercalate "\n"
+          . Text.intercalate "<br>\n"
+          . Text.splitOn "\n"
+          . Text.intercalate "\n"
           $ er
     }
 
 timestamp :: UTCTime -> Text
-timestamp = toText . formatTime defaultTimeLocale "%Y-%m-%d %H:%M"
+timestamp = into . formatTime defaultTimeLocale "%Y-%m-%d %H:%M"
 
 processThread ::
   (MonadIO m, MonadCatch m) =>
@@ -158,7 +141,7 @@ processThread ::
   ) ->
   ExceptT Error m Thread
 processThread (threadid, toList -> thrdAndMsgs) =
-  handleIOError (\er -> throwE [i|IOError: #{er}|]) $ do
+  handleIOError (\io_error -> throwE [i|IOError: #{io_error}|]) $ do
     thread <-
       tryJust [i|No Thread object found for Threadid #{threadid}|]
         . viaNonEmpty head
@@ -166,7 +149,7 @@ processThread (threadid, toList -> thrdAndMsgs) =
         $ thrdAndMsgs
     let msgs = rights thrdAndMsgs
     results <- mapM processMessage msgs
-    let messages = sortOn (date :: Message -> UTCTime) results
+    let messages = sortOn (.date) results
     subject <- decodeUtf8 <$> Notmuch.threadSubject thread
     totalCount <- Notmuch.threadTotalMessages thread
     authors <- (^. Notmuch.matchedAuthors) <$> Notmuch.threadAuthors thread
@@ -175,7 +158,7 @@ processThread (threadid, toList -> thrdAndMsgs) =
 
 messageToHtml :: Message -> Text
 messageToHtml Message{headers, body} =
-  T.intercalate "<br>\n" $
+  Text.intercalate "<br>\n" $
     ((\(name, content) -> [i|<b>#{name}:</b> #{content}|]) <$> headers)
       <> one (bodyToHtml body)
 
@@ -183,7 +166,7 @@ bodyToHtml :: Body -> Text
 bodyToHtml (HTMLBody x) = fromMaybe x onlyBody
  where
   onlyBody = renderTags . takeWhile (not . isTagCloseName "body") <$> (viaNonEmpty tail . dropWhile (not . isTagOpenName "body") . parseTags $ x)
-bodyToHtml (TextBody x) = T.intercalate "<br>\n" . T.splitOn "\n" $ x
+bodyToHtml (TextBody x) = Text.intercalate "<br>\n" . Text.splitOn "\n" $ x
 
 processMessage :: (MonadIO m, MonadCatch m) => Notmuch.Message n a -> m Message
 processMessage msg = do
@@ -205,10 +188,10 @@ processMessage msg = do
           , ("Unsubscribe", unsub)
           ]
   msgEither <- runExceptT $ withExceptT
-    (\er -> [i|Failed to read msg\nFilename:#{fileName}\nerror: #{er}|])
+    (\error_msg -> [i|Failed to read msg\nFilename:#{fileName}\nerror: #{error_msg}|])
     do
       msgContent <-
-        handleIOError (\er -> throwE [i|IOError: #{er}|]) $
+        handleIOError (\io_error -> throwE [i|IOError: #{io_error}|]) $
           readFileBS fileName
       parseResult <-
         hoistEither . first toText $

packages/logfeed/Mastodon.hs

@@ -0,0 +1,50 @@
+module Main where
+
+import Data.String.Interpolate (i)
+import Data.Text qualified as Text
+import Data.Time (UTCTime)
+import Data.Time qualified as Time
+import Relude hiding (
+  intercalate,
+  zip,
+ )
+import System.Environment ()
+import System.FilePattern.Directory (getDirectoryFiles)
+import Text.Atom.Feed
+import Text.Atom.Feed.Export (textFeed)
+import Witch
+
+timestamp :: UTCTime -> Text
+timestamp = into . Time.formatTime Time.defaultTimeLocale "%Y-%m-%d %H:%M"
+
+main :: IO ()
+main = do
+  [out_file, dir] <- getArgs
+  now <- Time.getCurrentTime
+  new_files <- getDirectoryFiles dir [Time.formatTime Time.defaultTimeLocale "%Y-%m-%d-*/index.html" now]
+
+  let entries =
+        fmap
+          ( ( \file_name ->
+                let
+                  folder_name =
+                    Text.dropEnd 11 file_name
+                 in
+                  ( nullEntry
+                      folder_name
+                      (TextString [i|mastodon digest #{Text.drop 11 folder_name}|])
+                      (timestamp now)
+                  )
+                    { entryLinks = [nullLink [i|http://hera.vpn.m-0.eu:8842/mastodon/#{file_name}|]]
+                    }
+            )
+              . into
+          )
+          new_files
+      feed =
+        nullFeed
+          [i|mastodon-summary-#{timestamp now}|]
+          (TextString "Mastodon Digests")
+          (timestamp now)
+  whenJust (textFeed feed{feedEntries = entries}) $
+    \file -> writeFileLText out_file file

packages/logfeed/Weechat.hs

@@ -1,14 +1,3 @@
-{-# LANGUAGE ExtendedDefaultRules #-}
-{-# LANGUAGE GHC2021 #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
 module Main where
 
 import Data.List.Extra qualified as L
@@ -37,6 +26,8 @@ import Text.Megaparsec qualified as MP
 import Text.Megaparsec.Char qualified as MP
 import Text.Megaparsec.Char qualified as MPC
 import Text.Megaparsec.Char.Lexer qualified as MP
+import Witch (into, unsafeInto)
+import Witch.Encoding (UTF_8)
 
 -- TODO: use Text instead of linked lists of chars
 
@@ -145,6 +136,7 @@ yesterday = T.addDays (negate 1) . today
 timestamp :: T.UTCTime -> Text
 timestamp = toText . T.formatTime T.defaultTimeLocale "%Y-%m-%d %H:%M"
 
+blockList :: [Text]
 blockList =
   [ "#haskell"
   , "#general"
@@ -187,7 +179,7 @@ data Log = Log
 readLogFiles :: NonEmpty LogFile -> IO Log
 readLogFiles files =
   readLogFile (head files)
-    <$> mapM (readFileText . toString . (logFolder <>) . path) files
+    <$> mapM (fmap (unsafeInto @Text . into @(UTF_8 ByteString)) . readFileBS . into . (logFolder <>) . path) files
 
 readLogFile :: LogFile -> NonEmpty Text -> Log
 readLogFile LogFile{channel, server} contents =

packages/logfeed/hie.yaml

@@ -0,0 +1,2 @@
+cradle:
+  cabal:

packages/logfeed/logfeed.cabal

@@ -1,23 +1,40 @@
-cabal-version: >=1.10
+cabal-version: 2.2
 
 -- Initial package description 'logfeed.cabal' generated by 'cabal init'.
 -- For further documentation, see http://haskell.org/cabal/users-guide/
 
-name:          logfeed
+name:          rssfeeds
 version:       0.1.0.0
 author:        maralorn
 maintainer:    mail@maralorn.de
 build-type:    Simple
 
-executable log2rss
-  main-is:            Main.hs
+common common-options
   ghc-options:        -Wall -Wcompat
-  default-extensions: ImportQualifiedPost
+  default-extensions:
+    NoImplicitPrelude
+    BlockArguments
+    DataKinds
+    DuplicateRecordFields
+    ExtendedDefaultRules
+    ImportQualifiedPost
+    KindSignatures
+    LambdaCase
+    MultiWayIf
+    NamedFieldPuns
+    OverloadedRecordDot
+    OverloadedStrings
+    PartialTypeSignatures
+    QuasiQuotes
+    ScopedTypeVariables
+    TupleSections
+    ViewPatterns
 
-  -- other-modules:
-  -- other-extensions:
+executable weechat2rss
+  import:           common-options
+  main-is:          Weechat.hs
   build-depends:
-      base
+    , base
     , containers
     , extra
     , feed                >=1.3.0.0
@@ -27,15 +44,15 @@ executable log2rss
     , string-interpolate
     , text
     , time
+    , witch
 
-  default-language:   GHC2021
+  default-language: GHC2021
 
 executable mail2rss
-  default-extensions: ImportQualifiedPost
-  main-is:            Mail.hs
-  ghc-options:        -Wall -Wcompat
+  import:           common-options
+  main-is:          Mail.hs
   build-depends:
-      base
+    , base
     , containers
     , errors
     , exceptions
@@ -53,5 +70,24 @@ executable mail2rss
     , tagsoup
     , text
     , time
+    , witch
 
-  default-language:   GHC2021
+  default-language: GHC2021
+
+executable mastodon2rss
+  import:           common-options
+  main-is:          Mastodon.hs
+  build-depends:
+    , base
+    , containers
+    , extra
+    , feed                >=1.3.0.0
+    , filepattern
+    , megaparsec
+    , relude
+    , string-interpolate
+    , text
+    , time
+    , witch
+
+  default-language: GHC2021