Formatting

.hlint.yaml

@@ -0,0 +1,5 @@
+- arguments:
+  - -XRecursiveDo
+  - -XQuasiQuotes
+- ignore:
+    name: Eta reduce

apps/kassandra/backend/src/Backend.hs

@@ -50,13 +50,13 @@ serveWebsocket config backendRequestQueue params =
       mayCreds = liftA2 (,) mayUsername mayPassword
       action (Just (username, password))
         | Just userConfig <- lookup username (users config)
-          , PasswordCheckSuccess <- checkPassword (mkPassword password) (passwordHash userConfig) =
+        , PasswordCheckSuccess <- checkPassword (mkPassword password) (passwordHash userConfig) =
-          acceptSocket backendRequestQueue username userConfig
+            acceptSocket backendRequestQueue username userConfig
       action (Just (username, _))
         | Just _ <- lookup username (users config) =
-          \connection -> do
+            \connection -> do
-            say [i|Rejecting Websocket request for #{username :: Text}, wrong password.|]
+              say [i|Rejecting Websocket request for #{username :: Text}, wrong password.|]
-            rejectRequest connection "No valid 'username' and 'password' provided."
+              rejectRequest connection "No valid 'username' and 'password' provided."
       action _ = \connection -> do
         say [i|Rejecting Websocket request #{show mayUsername :: Text}. No matching user found.|]
         rejectRequest connection "No valid 'username' and 'password' provided."

apps/kassandra/default.nix

@@ -1,147 +1,165 @@
-{ obelisk ? import ./.obelisk/impl {
+{
-    system = builtins.currentSystem;
+  obelisk ?
-    config.android_sdk.accept_license = true;
+    import ./.obelisk/impl {
-  }
+      system = builtins.currentSystem;
+      config.android_sdk.accept_license = true;
+    },
 }:
 with obelisk;
-project ./. (
+  project ./. (
-  { pkgs, ... }:
+    {pkgs, ...}: let
-  let
+      inherit
-    inherit (pkgs.haskell.lib)
+        (pkgs.haskell.lib)
-      markUnbroken dontCheck addBuildDepend doJailbreak
+        markUnbroken
-      overrideCabal
+        dontCheck
-      ;
+        addBuildDepend
-  in
+        doJailbreak
-  {
+        overrideCabal
-    android = {
+        ;
-      applicationId = "de.maralorn.kassandra";
+    in {
-      displayName = "Kassandra";
+      android = {
-      releaseKey = null;
+        applicationId = "de.maralorn.kassandra";
-      isRelease = true;
+        displayName = "Kassandra";
-      version = {
+        releaseKey = null;
-        code = import ./code.nix;
+        isRelease = true;
-        name = "0.1.0";
+        version = {
+          code = import ./code.nix;
+          name = "0.1.0";
+        };
       };
-    };
+      overrides = self: super: {
-    overrides = self: super: {
+        kassandra = overrideCabal super.kassandra {doHaddock = false;};
-      kassandra = overrideCabal super.kassandra { doHaddock = false; };
+        backend = addBuildDepend super.backend pkgs.taskwarrior;
-      backend = addBuildDepend super.backend pkgs.taskwarrior;
+        clay = markUnbroken (dontCheck super.clay);
-      clay = markUnbroken (dontCheck super.clay);
+        haskeline = dontCheck (self.callHackage "haskeline" "0.8.0.1" {});
-      haskeline = dontCheck (self.callHackage "haskeline" "0.8.0.1" { });
+        repline = doJailbreak (self.callHackage "repline" "0.4.0.0" {});
-      repline = doJailbreak (self.callHackage "repline" "0.4.0.0" { });
+        dhall = dontCheck (self.callHackage "dhall" "1.35.0" {});
-      dhall = dontCheck (self.callHackage "dhall" "1.35.0" { });
+        relude = dontCheck super.relude;
-      relude = dontCheck super.relude;
+        stm-containers = markUnbroken super.stm-containers;
-      stm-containers = markUnbroken super.stm-containers;
+        stm-hamt = markUnbroken (doJailbreak super.stm-hamt);
-      stm-hamt = markUnbroken (doJailbreak super.stm-hamt);
+        streamly-bytestring =
-      streamly-bytestring = self.callHackageDirect
+          self.callHackageDirect
-        {
+          {
-          pkg = "streamly-bytestring";
+            pkg = "streamly-bytestring";
-          ver = "0.1.2";
+            ver = "0.1.2";
-          sha256 = "08xhp8zgf5n1j4v1br1dz9ih8j05vk92swp3nz9in5xajllkc7qv";
+            sha256 = "08xhp8zgf5n1j4v1br1dz9ih8j05vk92swp3nz9in5xajllkc7qv";
-        }
+          }
-        { };
+          {};
-      streamly = self.callHackageDirect
+        streamly =
-        {
+          self.callHackageDirect
-          pkg = "streamly";
+          {
-          ver = "0.7.0";
+            pkg = "streamly";
-          sha256 = "0hr2cz14w6nnbvhnq1fvr8v4rzyqcj3b9khf2rszyji00fmp27l1";
+            ver = "0.7.0";
-        }
+            sha256 = "0hr2cz14w6nnbvhnq1fvr8v4rzyqcj3b9khf2rszyji00fmp27l1";
-        { };
+          }
-      nonempty-vector = self.callHackageDirect
+          {};
-        {
+        nonempty-vector =
-          pkg = "nonempty-vector";
+          self.callHackageDirect
-          ver = "0.1.0.0";
+          {
-          sha256 = "06abdmdy9z0w6ishiibir3qfjpqxmb4mrkhgyc4j58hd14s8rj0x";
+            pkg = "nonempty-vector";
-        }
+            ver = "0.1.0.0";
-        { };
+            sha256 = "06abdmdy9z0w6ishiibir3qfjpqxmb4mrkhgyc4j58hd14s8rj0x";
-      nonempty-containers = self.callHackageDirect
+          }
-        {
+          {};
-          pkg = "nonempty-containers";
+        nonempty-containers =
-          ver = "0.3.4.1";
+          self.callHackageDirect
-          sha256 = "0nbnr0az201lv09dwcxcppkfc9b05kyw4la990z5asn9737pvpr2";
+          {
-        }
+            pkg = "nonempty-containers";
-        { };
+            ver = "0.3.4.1";
-      iCalendar = overrideCabal (doJailbreak (markUnbroken super.iCalendar)) {
+            sha256 = "0nbnr0az201lv09dwcxcppkfc9b05kyw4la990z5asn9737pvpr2";
-        preConfigure = ''substituteInPlace iCalendar.cabal --replace "network >=2.6 && <2.7" "network -any"'';
+          }
+          {};
+        iCalendar = overrideCabal (doJailbreak (markUnbroken super.iCalendar)) {
+          preConfigure = ''substituteInPlace iCalendar.cabal --replace "network >=2.6 && <2.7" "network -any"'';
+        };
+        prettyprinter =
+          self.callHackageDirect
+          {
+            pkg = "prettyprinter";
+            ver = "1.5.1";
+            sha256 = "0wx01rvgwnnmg10sh9x2whif5z12058w5djh7m5swz94wvkg5cg3";
+          }
+          {};
+        cborg-json =
+          self.callHackageDirect
+          {
+            pkg = "cborg-json";
+            ver = "0.2.2.0";
+            sha256 = "1s7pv3jz8s1qb0ydcc5nra9f63jp4ay4d0vncv919bakf8snj4vw";
+          }
+          {};
+        generic-random =
+          self.callHackageDirect
+          {
+            pkg = "generic-random";
+            ver = "1.3.0.0";
+            sha256 = "0m7lb40wgmyszv8l6qmarkfgs8r0idgl9agwsi72236hpvp353ad";
+          }
+          {};
+        atomic-write =
+          self.callHackageDirect
+          {
+            pkg = "atomic-write";
+            ver = "0.2.0.7";
+            sha256 = "1r9ckwljdbw3mi8rmzmsnh89z8nhw2qnds9n271gkjgavb6hxxf3";
+          }
+          {};
+        taskwarrior =
+          self.callHackageDirect
+          {
+            pkg = "taskwarrior";
+            ver = "0.5.0.0";
+            sha256 = "sha256-elDUtz0NSG4WHxkyCQ1CunYXWIVRj6EqkKSchPy+c3E=";
+          }
+          {};
+        base64 =
+          self.callHackageDirect
+          {
+            pkg = "base64";
+            ver = "0.4.1";
+            sha256 = "1pz9s8bmnkrrr3v5mhkwv8vaf251vmxs87zzc5nsjsa027j9lr22";
+          }
+          {};
+        password =
+          self.callHackageDirect
+          {
+            pkg = "password";
+            ver = "2.0.1.0";
+            sha256 = "1q99v7w6bdfpnw245aa3zaj3x7mhl9i2y7f2rzlc30g066p9jhaz";
+          }
+          {};
+        indexed-profunctors =
+          self.callHackageDirect
+          {
+            pkg = "indexed-profunctors";
+            ver = "0.1";
+            sha256 = "0vpgbymfhnvip90jwvyniqi34lhz5n3ni1f21g81n5rap0q140za";
+          }
+          {};
+        generic-lens-core =
+          self.callHackageDirect
+          {
+            pkg = "generic-lens-core";
+            ver = "2.0.0.0";
+            sha256 = "07parw0frqxxkjbbas9m9xb3pmpqrx9wz63m35wa6xqng9vlcscm";
+          }
+          {};
+        generic-optics =
+          self.callHackageDirect
+          {
+            pkg = "generic-optics";
+            ver = "2.0.0.0";
+            sha256 = "0xy5k5b35w1i1zxy0dv5fk1b3zrd3hx3v5kh593k2la7ri880wmq";
+          }
+          {};
+        optics-core = self.callHackage "optics-core" "0.3.0.1" {};
+        optics-th = self.callHackage "optics-th" "0.3.0.2" {};
+        optics-extra = self.callHackage "optics-extra" "0.3" {};
+        optics = self.callHackage "optics" "0.3" {};
       };
-      prettyprinter = self.callHackageDirect
+      packages = {
-        {
+        kassandra = ./kassandra;
-          pkg = "prettyprinter";
+        standalone = ./standalone;
-          ver = "1.5.1";
+      };
-          sha256 = "0wx01rvgwnnmg10sh9x2whif5z12058w5djh7m5swz94wvkg5cg3";
+    }
-        }
+  )
-        { };
-      cborg-json = self.callHackageDirect
-        {
-          pkg = "cborg-json";
-          ver = "0.2.2.0";
-          sha256 = "1s7pv3jz8s1qb0ydcc5nra9f63jp4ay4d0vncv919bakf8snj4vw";
-        }
-        { };
-      generic-random = self.callHackageDirect
-        {
-          pkg = "generic-random";
-          ver = "1.3.0.0";
-          sha256 = "0m7lb40wgmyszv8l6qmarkfgs8r0idgl9agwsi72236hpvp353ad";
-        }
-        { };
-      atomic-write = self.callHackageDirect
-        {
-          pkg = "atomic-write";
-          ver = "0.2.0.7";
-          sha256 = "1r9ckwljdbw3mi8rmzmsnh89z8nhw2qnds9n271gkjgavb6hxxf3";
-        }
-        { };
-      taskwarrior = self.callHackageDirect
-        {
-          pkg = "taskwarrior";
-          ver = "0.5.0.0";
-          sha256 = "sha256-elDUtz0NSG4WHxkyCQ1CunYXWIVRj6EqkKSchPy+c3E=";
-        }
-        { };
-      base64 = self.callHackageDirect
-        {
-          pkg = "base64";
-          ver = "0.4.1";
-          sha256 = "1pz9s8bmnkrrr3v5mhkwv8vaf251vmxs87zzc5nsjsa027j9lr22";
-        }
-        { };
-      password = self.callHackageDirect
-        {
-          pkg = "password";
-          ver = "2.0.1.0";
-          sha256 = "1q99v7w6bdfpnw245aa3zaj3x7mhl9i2y7f2rzlc30g066p9jhaz";
-        }
-        { };
-      indexed-profunctors = self.callHackageDirect
-        {
-          pkg = "indexed-profunctors";
-          ver = "0.1";
-          sha256 = "0vpgbymfhnvip90jwvyniqi34lhz5n3ni1f21g81n5rap0q140za";
-        }
-        { };
-      generic-lens-core = self.callHackageDirect
-        {
-          pkg = "generic-lens-core";
-          ver = "2.0.0.0";
-          sha256 = "07parw0frqxxkjbbas9m9xb3pmpqrx9wz63m35wa6xqng9vlcscm";
-        }
-        { };
-      generic-optics = self.callHackageDirect
-        {
-          pkg = "generic-optics";
-          ver = "2.0.0.0";
-          sha256 = "0xy5k5b35w1i1zxy0dv5fk1b3zrd3hx3v5kh593k2la7ri880wmq";
-        }
-        { };
-      optics-core = self.callHackage "optics-core" "0.3.0.1" { };
-      optics-th = self.callHackage "optics-th" "0.3.0.2" { };
-      optics-extra = self.callHackage "optics-extra" "0.3" { };
-      optics = self.callHackage "optics" "0.3" { };
-    };
-    packages = {
-      kassandra = ./kassandra;
-      standalone = ./standalone;
-    };
-  }
-)

apps/kassandra/frontend/src/Frontend.hs

@@ -28,8 +28,9 @@ frontend =
     }
 
 frontendBody :: WidgetJSM t m => m ()
-frontendBody = D.dyn_ . fmap (maybe pass mainWidget)
+frontendBody =
-  =<< remoteBackendWidget (wrap D.never) Nothing
+  D.dyn_ . fmap (maybe pass mainWidget)
+    =<< remoteBackendWidget (wrap D.never) Nothing
 
 css = cssAsText (static @"MaterialIcons-Regular-Outlined.otf")
 

apps/kassandra/frontend/src/Frontend/Route.hs

@@ -12,7 +12,7 @@ import Control.Category
 import qualified Control.Category
 import Data.Text (Text)
 
---import Data.Functor.Identity
+-- import Data.Functor.Identity
 
 import Obelisk.Route
 import Obelisk.Route.TH
@@ -41,7 +41,7 @@ fullRouteEncoder =
     (FullRoute_Backend BackendRouteMissing :/ ())
     ( \case
         BackendRouteMissing -> PathSegment "missing" $ unitEncoder mempty
-        BackendRouteSocket -> PathSegment "socket" $ Control.Category.id
+        BackendRouteSocket -> PathSegment "socket" Control.Category.id
     )
     ( \case
         FrontendRouteMain -> PathEnd $ unitEncoder mempty

apps/kassandra/kassandra/src/Kassandra/Config.hs

@@ -23,7 +23,7 @@ module Kassandra.Config (
   TaskwarriorOption (..),
 ) where
 
-import Data.Default.Class ( Default(..) )
+import Data.Default.Class (Default (..))
 import Data.Password.Argon2 (
   Argon2,
   PasswordHash,
@@ -142,22 +142,22 @@ data PasswordConfig = Prompt | Password {plaintext :: Text} | PasswordCommand {c
 
 data LocalBackend
   = TaskwarriorBackend
-      { -- | Set config file
+      { taskRcPath :: Maybe Text
-        taskRcPath :: Maybe Text
+      -- ^ Set config file
-      , -- | Set task data directory
+      , taskDataPath :: Maybe Text
-        taskDataPath :: Maybe Text
+      -- ^ Set task data directory
-      , -- | Override config variables
+      , taskConfig :: Seq TaskwarriorOption
-        taskConfig :: Seq TaskwarriorOption
+      -- ^ Override config variables
-      , -- | Path to taskwarrior binary. Nothing => Lookup "task" from PATH
+      , taskBin :: Maybe Text
-        taskBin :: Maybe Text
+      -- ^ Path to taskwarrior binary. Nothing => Lookup "task" from PATH
-      , -- | Use the first free port from the given range for the taskwarrior hook listener.
+      , hookListenPort :: PortConfig
-        hookListenPort :: PortConfig
+      -- ^ Use the first free port from the given range for the taskwarrior hook listener.
-      , -- | Created hooks are called ".on-add.<suffix>.<port>" and ".on-remove.<suffix>.<port>"
+      , hookSuffix :: Text
-        hookSuffix :: Text
+      -- ^ Created hooks are called ".on-add.<suffix>.<port>" and ".on-remove.<suffix>.<port>"
-      , -- | Ensure existence of taskwarrior hook on every start
+      , createHooksOnStart :: Bool
-        createHooksOnStart :: Bool
+      -- ^ Ensure existence of taskwarrior hook on every start
-      , -- | Remove hook on exit.
+      , removeHooksOnExit :: Bool
-        removeHooksOnExit :: Bool
+      -- ^ Remove hook on exit.
       }
   | GitBackend
       { directoryPath :: Text

apps/kassandra/kassandra/src/Kassandra/Css.hs

@@ -31,10 +31,11 @@ css fontPath = do
     fontFace $ do
       fontFamily [fontName] []
       fontFaceSrc [FontFaceSrcUrl fontSrc (Just OpenType)]
-  let --darkBlue      = rgb 0 0 33
+  let
-      lightBlue = rgb 200 200 255
+    -- darkBlue      = rgb 0 0 33
-      noMargin = margin (px 0) (px 0) (px 0) (px 0)
+    lightBlue = rgb 200 200 255
-      noPadding = padding (px 0) (px 0) (px 0) (px 0)
+    noMargin = margin (px 0) (px 0) (px 0) (px 0)
+    noPadding = padding (px 0) (px 0) (px 0) (px 0)
   star ? do
     fontFamily ["B612"] []
     noMargin
@@ -91,13 +92,13 @@ css fontPath = do
           color white
   ".button" ? buttonCss
   ".selector" ? buttonCss
-  --".tag" ? ".icon" ? do
+  -- ".tag" ? ".icon" ? do
-  --position absolute
+  -- position absolute
-  --borderRadius tagRadius tagRadius tagRadius tagRadius
+  -- borderRadius tagRadius tagRadius tagRadius tagRadius
-  --background lightBlue
+  -- background lightBlue
-  --marginLeft (em (-1.1))
+  -- marginLeft (em (-1.1))
-  --marginTop (em 0.70)
+  -- marginTop (em 0.70)
-  --fontSize (em 0.85)
+  -- fontSize (em 0.85)
   ".material-icons" ? do
     fontFamily [fontName] []
     fontWeight normal
@@ -141,9 +142,9 @@ css fontPath = do
   ".children" ? do
     padding (px 0) (px 0) (px 0) leftBarWidth
     background black
-  --".slimButton" ? do
+  -- ".slimButton" ? do
-  --marginRight (px (-5))
+  -- marginRight (px (-5))
-  --marginLeft (px (-5))
+  -- marginLeft (px (-5))
   let blockSize = do
         width (em 1)
         height (em 1)
@@ -162,5 +163,6 @@ css fontPath = do
       ".grey" & color (grayish 160)
       ".show" & color black
       ".showable" & display none
-    active & i ? do
+    active
-      background black
+      & i ? do
+        background black

apps/kassandra/kassandra/src/Kassandra/Debug.hs

@@ -21,6 +21,9 @@ import Reflex as R
 import System.IO.Unsafe (unsafePerformIO)
 
 import qualified Debug.Trace as Trace
+import Relude.Extra.Bifunctor
+import Relude.Extra.Enum
+import Say
 import System.Console.ANSI (
   Color (..),
   ColorIntensity (Vivid),
@@ -28,9 +31,6 @@ import System.Console.ANSI (
   SGR (..),
   setSGRCode,
  )
-import Relude.Extra.Bifunctor
-import Relude.Extra.Enum
-import Say
 
 data Severity = Debug | Info | Warning | Error deriving stock (Show, Read, Eq, Ord)
 
@@ -149,7 +149,8 @@ showSeverity = \case
  where
   color :: Color -> Text -> Text
   color c txt =
-    toText (setSGRCode [SetColor Foreground Vivid c]) <> txt
+    toText (setSGRCode [SetColor Foreground Vivid c])
+      <> txt
       <> toText
         (setSGRCode [Reset])
 

apps/kassandra/kassandra/src/Kassandra/MainWidget.hs

@@ -9,7 +9,7 @@ import qualified Data.Sequence as Seq
 import qualified Data.Sequence.NonEmpty as NESeq
 import qualified Data.Set as Set
 import Kassandra.AgendaWidget (agendaWidget)
-import Kassandra.BaseWidgets (button, br)
+import Kassandra.BaseWidgets (br, button)
 import Kassandra.Calendar (CalendarEvent)
 import Kassandra.Config (DefinitionElement, Widget (DefinitionElementWidget, SearchWidget))
 import Kassandra.Debug (
@@ -183,17 +183,20 @@ nextWidget = do
       <$> getTasks
   D.dynText $
     (\x y -> if length x + length y > 0 then [i|There are #{length x} tasks in the inbox and #{length y} tasks unsorted.|] else "Nothing to do.")
-      <$> inboxTasks <*> unsortedTasks
+      <$> inboxTasks
+      <*> unsortedTasks
   inboxTaskDyn <- R.maybeDyn $ Seq.lookup 0 <$> inboxTasks
   let decorateSortTask x = D.el "p" (D.text "Sort this task into the task tree:") *> taskTreeWidget x
-      decorateInboxTask x = D.el "p" $ do
+      decorateInboxTask x =
-         D.text "Process this task from the inbox:" *> br
+        D.el "p" $
-         D.text "1. Does it need to be done?" *> br
+          do
-         D.text "2. Can you do it in under 2 minutes?" *> br
+            D.text "Process this task from the inbox:" *> br
-         D.text "3. Should someone else do this?" *> br
+            D.text "1. Does it need to be done?" *> br
-         D.text "4. Should you split this task into sub tasks?" *> br
+            D.text "2. Can you do it in under 2 minutes?" *> br
-         D.text "5. On which tag list does it belong or when do you want to do it?" *> br
+            D.text "3. Should someone else do this?" *> br
-       *> taskTreeWidget x
+            D.text "4. Should you split this task into sub tasks?" *> br
+            D.text "5. On which tag list does it belong or when do you want to do it?" *> br
+            *> taskTreeWidget x
       sortTask = do
         taskDyn <- R.maybeDyn $ viaNonEmpty head <$> unsortedTasks
         D.dyn_ (maybe pass decorateSortTask <$> taskDyn)

apps/kassandra/kassandra/src/Kassandra/ReflexUtil.hs

@@ -10,7 +10,8 @@ module Kassandra.ReflexUtil (
 
 import qualified Data.Map as Map
 import qualified Data.Patch.Map as Patch
---import qualified Data.Patch.MapWithMove as Patch
+
+-- import qualified Data.Patch.MapWithMove as Patch
 import qualified Data.Sequence as Seq
 import qualified Reflex as R
 import qualified Reflex.Dom as D
@@ -29,27 +30,28 @@ smartSimpleList ::
   m ()
 smartSimpleList widget listElements = do
   void $ R.simpleList (toList <$> listElements) \vDyn -> do
-     u <- R.holdUniqDyn vDyn
+    u <- R.holdUniqDyn vDyn
-     D.dyn_ . fmap widget $ u
+    D.dyn_ . fmap widget $ u
-  --postBuild <- R.getPostBuild
-  --keyMap <- R.holdUniqDyn $ Seq.foldMapWithIndex (curry one) <$> listElements
-  --let keyMapChange =
-        --R.attachWith
-          --((Newtype.under @(Map Int (Patch.NodeInfo Int v)) fixPatchMap .) . Patch.patchThatChangesMap)
-          --(R.current keyMap)
-          --(R.updated keyMap)
-      --initialKeyMap = Patch.patchMapWithMoveInsertAll <$> R.tag (R.current keyMap) postBuild
-      --keyMapEvents = keyMapChange <> initialKeyMap
-  --void $ R.mapMapWithAdjustWithMove (const widget) mempty keyMapEvents
 
--- | A workaround for a bug in patchThatChangesMap in patch 0.0.3.2.
+-- postBuild <- R.getPostBuild
---fixPatchMap :: Map Int (Patch.NodeInfo Int v) -> Map Int (Patch.NodeInfo Int v)
+-- keyMap <- R.holdUniqDyn $ Seq.foldMapWithIndex (curry one) <$> listElements
---fixPatchMap inputMap = appEndo setMoves . fmap (Patch.nodeInfoSetTo Nothing) $ inputMap
+-- let keyMapChange =
--- where
+-- R.attachWith
---  setMoves = Map.foldMapWithKey f inputMap
+-- ((Newtype.under @(Map Int (Patch.NodeInfo Int v)) fixPatchMap .) . Patch.patchThatChangesMap)
---  f to' (Patch.NodeInfo (Patch.From_Move from) _) = Endo $ Map.adjust (Patch.nodeInfoSetTo (Just to')) from
+-- (R.current keyMap)
---  f _ _ = mempty
+-- (R.updated keyMap)
+-- initialKeyMap = Patch.patchMapWithMoveInsertAll <$> R.tag (R.current keyMap) postBuild
+-- keyMapEvents = keyMapChange <> initialKeyMap
+-- void $ R.mapMapWithAdjustWithMove (const widget) mempty keyMapEvents
 
+{- | A workaround for a bug in patchThatChangesMap in patch 0.0.3.2.
+fixPatchMap :: Map Int (Patch.NodeInfo Int v) -> Map Int (Patch.NodeInfo Int v)
+fixPatchMap inputMap = appEndo setMoves . fmap (Patch.nodeInfoSetTo Nothing) $ inputMap
+ where
+  setMoves = Map.foldMapWithKey f inputMap
+  f to' (Patch.NodeInfo (Patch.From_Move from) _) = Endo $ Map.adjust (Patch.nodeInfoSetTo (Just to')) from
+  f _ _ = mempty
+-}
 listWithGaps ::
   (R.Adjustable t m, R.PostBuild t m, R.MonadHold t m, MonadFix m, Ord v, D.NotReady t m) =>
   (v -> m ()) ->
@@ -62,9 +64,9 @@ listWithGaps widget gapWidget listD = do
   gapWidget lastElementD
  where
   elementWidget currentElement = do
-      elementPair <- R.holdUniqDyn $ (,Just currentElement) . Map.lookup currentElement <$> prevElementsD
+    elementPair <- R.holdUniqDyn $ (,Just currentElement) . Map.lookup currentElement <$> prevElementsD
-      gapWidget elementPair
+    gapWidget elementPair
-      widget currentElement
+    widget currentElement
   prevElementsD = (\xs -> Map.unions . fmap one $ Seq.zip (Seq.drop 1 xs) xs) <$> listD
 
 keyDynamic ::

apps/kassandra/kassandra/src/Kassandra/RemoteBackendWidget.hs

@@ -51,7 +51,7 @@ remoteBackendWidget closeEvent mayBackend = D.divClass "remoteBackend" $ do
   backendDyn <- maybe inputBackend getPassword mayBackend
   responseEvent <-
     D.dyn
-      (withBackend (closeEvent <> wrap (() <$ R.updated backendDyn)) <$> backendDyn)
+      (withBackend (closeEvent <> wrap (void $ R.updated backendDyn)) <$> backendDyn)
   D.holdDyn Nothing responseEvent
  where
   getPassword :: RemoteBackend PasswordConfig -> m (R.Dynamic t (Maybe (RemoteBackend Text)))
@@ -122,9 +122,9 @@ remoteBackendWidget closeEvent mayBackend = D.divClass "remoteBackend" $ do
     D.inputElement $
       D.def
         & lensVL D.inputElementConfig_initialValue
-        .~ defaultValue
+          .~ defaultValue
         & lensVL (D.inputElementConfig_elementConfig . D.elementConfig_initialAttributes)
-        .~ if hidden then "type" D.=: "password" else mempty
+          .~ if hidden then "type" D.=: "password" else mempty
   inputValue = R.current . D._inputElement_value
 
 data WebSocketState = WebSocketError Text | Connecting deriving stock (Show)

apps/kassandra/kassandra/src/Kassandra/Sorting.hs

@@ -7,12 +7,12 @@ module Kassandra.Sorting (
 
 import qualified Data.Aeson as Aeson
 import Data.Scientific (toRealFloat)
+import qualified Data.Sequence as Seq
 import Data.Set (member)
 import Kassandra.Types (TaskInfos)
 import qualified Reflex as R
 import Relude.Extra.Foldable1 (maximum1)
 import qualified Taskwarrior.Task as Task
-import qualified Data.Sequence as Seq
 
 data SortMode = SortModePartof UUID | SortModeTag Task.Tag
   deriving stock (Show, Eq, Ord, Generic)
@@ -80,9 +80,9 @@ sortingChanges mode list =
         | otherwise = assureSort minTouchedDist sortedList
       getWrite (task, sortState)
         | has #_WillWrite sortState || not (taskInList mode task) =
-          Just . setSortOrder mode (newValue sortState) . insertInList mode $ task
+            Just . setSortOrder mode (newValue sortState) . insertInList mode $ task
         | otherwise =
-          Nothing
+            Nothing
    in mapMaybe getWrite finalList
 
 applyUntil :: (a -> a) -> (a -> Bool) -> a -> a
@@ -92,7 +92,7 @@ applyUntil f condition x
 
 minOrder, maxOrder, minDist, minTouchedDist :: Double
 minOrder = -1
-maxOrder = - minOrder
+maxOrder = -minOrder
 minDist = 10 ** (-6)
 minTouchedDist = 10 ** (-3)
 
@@ -111,9 +111,9 @@ unSetWorstUnsorted unSet delta (IsNonEmpty (x :<|| xs))
       Seq.breakl
         ((worst ==) . snd)
         (toSeq badnesses) =
-    fine <> (unSet a <| alsoFine)
+      fine <> (unSet a <| alsoFine)
   | otherwise =
-    error "Assumed wrong invariant in unSetWorstUnsorted" -- The list of badnesses has to contain its maximum
+      error "Assumed wrong invariant in unSetWorstUnsorted" -- The list of badnesses has to contain its maximum
  where
   badnesses = go mempty (x :<|| xs) <&> \(a, _, badness) -> (a, badness)
   worst = maximum1 $ snd <$> badnesses
@@ -146,16 +146,16 @@ addSortState f = go (minOrder, 0)
   go (iprev, dprev) list
     | IsEmpty <- list = mempty
     | IsNonEmpty (x :<|| xs) <- list
-      , Just int <- f x =
+    , Just int <- f x =
-      (x, HasSortPos int) <| go (int, 0) xs
+        (x, HasSortPos int) <| go (int, 0) xs
     | IsNonEmpty (x :<|| xs) <- list
-      , next@(IsNonEmpty ((_, sortStateNext -> (inext, dnext)) :<|| _)) <-
+    , next@(IsNonEmpty ((_, sortStateNext -> (inext, dnext)) :<|| _)) <-
-          go
+        go
-            (iprev, dprev + 1)
+          (iprev, dprev + 1)
-            xs =
+          xs =
-      (x, WillWrite iprev (dprev + 1) inext (dnext + 1)) <| next
+        (x, WillWrite iprev (dprev + 1) inext (dnext + 1)) <| next
     | IsNonEmpty (x :<|| _) <- list =
-      one (x, WillWrite iprev (dprev + 1) maxOrder 1)
+        one (x, WillWrite iprev (dprev + 1) maxOrder 1)
 
 insertBefore :: Seq Task -> Seq Task -> Maybe UUID -> Seq Task
 insertBefore list toInsert = \case

apps/kassandra/kassandra/src/Kassandra/TaskWidget.hs

@@ -10,8 +10,9 @@ import qualified Data.Sequence.NonEmpty as NESeq
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import Kassandra.BaseWidgets (
+  br,
   button,
-  icon, br
+  icon,
  )
 import Kassandra.Config (DefinitionElement)
 import Kassandra.Debug (
@@ -138,7 +139,8 @@ dependenciesWidget = do
   revDepends <- filter stillTodo <<$>> lookupTasksM (taskInfos ^. #revDepends)
   depends <- filter stillTodo <<$>> (lookupTasksM . toList) (taskInfos ^. #depends)
   D.dyn_ $
-    whenNotNull <$> depends
+    whenNotNull
+      <$> depends
       <*> pure
         ( \ds -> do
             br
@@ -150,7 +152,8 @@ dependenciesWidget = do
               br
         )
   D.dyn_ $
-    whenJust . nonEmptySeq <$> revDepends
+    whenJust . nonEmptySeq
+      <$> revDepends
       <*> pure
         ( \rds -> do
             br
@@ -186,7 +189,8 @@ dropChildWidget = do
   childrenD <- getChildren
   showIcon <- fmap not <$> getIsExpanded (taskInfos ^. #uuid)
   D.dyn_ $
-    when <$> showIcon
+    when
+      <$> showIcon
       <*> pure
         ( childDropArea
             ( SortPosition
@@ -204,11 +208,11 @@ dropChildWidget = do
     (icon "dropHere plusOne" "block")
     $ fmap
       ( \dependencies ->
-          one $
+          one
-            #depends
+            $ #depends
               %~ Set.union (Set.fromList $ toList $ (^. #uuid) <$> dependencies)
-              $ taskInfos
+            $ taskInfos
-                ^. #task
+              ^. #task
       )
   taskDropArea
     (taskInfos ^. #uuid % to (R.constDyn . one))
@@ -245,7 +249,8 @@ childrenWidget taskInfosD = do
   showOptional :: Bool -> m ()
   showOptional x = when x $ do
     children <-
-      R.holdUniqDyn . fmap (filter stillTodo) =<< lookupTasksDynM
+      R.holdUniqDyn . fmap (filter stillTodo)
+        =<< lookupTasksDynM
         =<< R.holdUniqDyn
           (taskInfosD ^. mapping #children)
     let sortModeD = SortModePartof <$> taskInfosD ^. mapping #uuid
@@ -256,7 +261,6 @@ childrenWidget taskInfosD = do
     D.divClass "children" $
       taskList (sortModeD ^. #current) sortedList blacklist taskWidget
 
-
 taskList ::
   StandardWidget t m r e =>
   R.Behavior t SortMode ->
@@ -368,7 +372,8 @@ statusWidget = do
     (el, ()) <- D.elAttr' "div" ("class" =: "checkbox") $ do
       D.elClass
         "i"
-        ( "material-icons " <> showClass
+        ( "material-icons "
+            <> showClass
             <> if isJust handlerMay
               then " hideable"
               else ""

apps/kassandra/kassandra/src/Prelude.hs

@@ -53,11 +53,12 @@ module Prelude (
   pattern IsNonEmpty,
   pattern (:<||),
   pattern (:||>),
-  (|>),(<|),
+  (|>),
+  (<|),
   toSeq,
   mapMaybe,
   filter,
-  partitionEithersNESeq
+  partitionEithersNESeq,
 ) where
 
 import Control.Concurrent.Async (
@@ -81,12 +82,11 @@ import Data.Generics.Product.Typed (HasType (typed))
 import Data.Generics.Sum.Constructors (AsConstructor' (_Ctor'))
 import Data.Generics.Sum.Typed (AsType (_Typed))
 import Data.List.Extra (firstJust)
-import Data.Sequence.NonEmpty hiding (filter, (|>), (<|))
+import Data.Sequence ((<|), (|>))
-import Data.Sequence ((|>),(<|))
+import Data.Sequence.NonEmpty hiding (filter, (<|), (|>))
 import Data.String.Interpolate (i)
 import Data.Text.Optics hiding (text)
-import Data.These (partitionEithersNE, These(..))
+import Data.These (These (..), partitionEithersNE)
-import Data.Witherable ( mapMaybe, (<$?>), (<&?>), filter )
 import Data.Time (
   UTCTime,
   addUTCTime,
@@ -105,14 +105,15 @@ import Data.Time.LocalTime (
   zonedTimeToLocalTime,
  )
 import Data.UUID (UUID)
+import Data.Witherable (filter, mapMaybe, (<$?>), (<&?>))
 import Language.Haskell.TH.Syntax (
   Dec,
   Name,
   Q,
  )
-import Optics hiding ((|>), (<|))
+import Optics hiding ((<|), (|>))
 import Optics.TH
-import Relude hiding (uncons, mapMaybe, filter)
+import Relude hiding (filter, mapMaybe, uncons)
 import Relude.Extra.Foldable1
 import Taskwarrior.Status (Status)
 import Taskwarrior.Task (Task)
@@ -122,7 +123,7 @@ instance One (NESeq a) where
   one = singleton
 
 instance Foldable1 NESeq where
-   foldMap1 f = foldMapWithIndex (const f)
+  foldMap1 f = foldMapWithIndex (const f)
 
 -- (lensField .~ noPrefixNamer $ fieldLabelsRules) == noPrefixFieldLabels but only in optics-th 0.2
 makeLabels :: Name -> Q [Dec]

apps/kassandra/obelisk-shell.nix

@@ -1 +1 @@
-(import ./. { }).shells.ghc
+(import ./. {}).shells.ghc

apps/kassandra/release.nix

@@ -1,18 +1,16 @@
-{ pkgs ? import (import nix/sources.nix).nixpkgs { } }:
+{pkgs ? import (import nix/sources.nix).nixpkgs {}}: let
-let
   haskellPackages = pkgs.haskellPackages.extend (
     self: super: {
-      kassandra = self.callCabal2nix "kassandra" ./kassandra { };
+      kassandra = self.callCabal2nix "kassandra" ./kassandra {};
-      standalone = self.callCabal2nix "standalone" ./standalone { };
+      standalone = self.callCabal2nix "standalone" ./standalone {};
     }
   );
-  reflex-platform = import ./. { };
+  reflex-platform = import ./. {};
-in
+in {
-{
   lib = haskellPackages.kassandra;
   app = haskellPackages.standalone;
   server = reflex-platform.exe;
-  android = pkgs.runCommand "kassandra-android-apk" { } ''
+  android = pkgs.runCommand "kassandra-android-apk" {} ''
     mkdir -p $out
     cp ${reflex-platform.android.frontend}/android-app-release-unsigned.apk $out/de.maralorn.kassandra_${import ./code.nix}.apk
   '';

apps/kassandra/standalone/src/Kassandra/Backend/Calendar.hs

@@ -73,9 +73,9 @@ import Kassandra.Debug (Severity (..), log)
 import qualified Streamly.Data.Fold as FL
 import Streamly.External.ByteString (fromArray, toArray)
 import qualified Streamly.FileSystem.Handle as FS
+import Streamly.Internal.Data.Array.Stream.Foreign (splitOn)
 import qualified Streamly.Internal.FileSystem.File as FSFile
 import Streamly.Memory.Array as Mem (fromList)
-import Streamly.Internal.Data.Array.Stream.Foreign (splitOn)
 
 dirName :: FilePath
 dirName = "/home/maralorn/.calendars/"
@@ -121,12 +121,12 @@ saveCache cache = do
 writeJSONStream :: (IsStream t, MonadIO (t IO), ToJSON k, ToJSON v) => STM.Map k v -> FilePath -> t IO ()
 writeJSONStream stmMap fileName =
   FSFile.withFile fileName WriteMode \handle ->
-    liftIO $
+    liftIO
-      S.fold (FS.writeChunks handle)
+      $ S.fold (FS.writeChunks handle)
         . asyncly
         . S.intersperse (Mem.fromList [10])
         . fmap (toArray . toStrict . encode)
-        $ streamSTMMap stmMap
+      $ streamSTMMap stmMap
 
 streamSTMMap :: forall t k v. (MonadIO (t IO), IsStream t) => STM.Map k v -> t IO (k, v)
 streamSTMMap = join . atomically . UnfoldlM.foldlM' (\x y -> pure $ S.cons y x) S.nil . STM.unfoldlM
@@ -145,7 +145,8 @@ data Cache = Cache
   { icsCache :: ICSCache
   , tzCache :: TZCache
   , uidCache :: UIDCache
-  } deriving (Generic)
+  }
+  deriving (Generic)
 
 newCache :: IO Cache
 newCache = atomically $ Cache <$> STM.new <*> STM.new <*> STM.new
@@ -284,11 +285,11 @@ translateEvent cache calendarName vEvent =
   -- Also we are ignoring the timezone delivered with this calendar and taking our own
   getTimes
     | Just (DTStartDateTime start _) <- veDTStart vEvent
-      , Just (Left (DTEndDateTime end _)) <- veDTEndDuration vEvent =
+    , Just (Left (DTEndDateTime end _)) <- veDTEndDuration vEvent =
-      S.yieldM . liftIO $ SimpleEvent <$> datetimeToTZTime cache start <*> datetimeToTZTime cache end
+        S.yieldM . liftIO $ SimpleEvent <$> datetimeToTZTime cache start <*> datetimeToTZTime cache end
     | Just (dateValue . dtStartDateValue -> start) <- veDTStart vEvent
-      , Just (Left (dateValue . dtEndDateValue -> end)) <- veDTEndDuration vEvent =
+    , Just (Left (dateValue . dtEndDateValue -> end)) <- veDTEndDuration vEvent =
-      S.yield $ AllDayEvent start (addDays (-1) end)
+        S.yield $ AllDayEvent start (addDays (-1) end)
     | otherwise = S.nil
 
 datetimeToTZTime :: Cache -> DateTime -> IO TZTime

apps/kassandra/standalone/src/Kassandra/Standalone/Config.hs

@@ -6,14 +6,15 @@ module Kassandra.Standalone.Config (
   StandaloneAccount (LocalAccount, RemoteAccount),
   BackendConfig (..),
   backends,
- dhallTypes
+  dhallTypes,
 ) where
 
 import Dhall (FromDhall)
 import Kassandra.Config (
-  Dict,
   AccountConfig,
   DefinitionElement,
+  Dict,
+  ListItem,
   ListQuery,
   LocalBackend,
   NamedBackend,
@@ -24,7 +25,7 @@ import Kassandra.Config (
   TaskwarriorOption,
   TreeOption,
   UserConfig,
-  Widget, ListItem
+  Widget,
  )
 import Kassandra.Config.Dhall (
   DhallLoadConfig (..),
@@ -42,7 +43,7 @@ data StandaloneAccount = RemoteAccount {backend :: Maybe (RemoteBackend Password
   deriving stock (Show, Eq, Ord, Generic)
   deriving anyclass (FromDhall)
 
-data BackendConfig = BackendConfig
+newtype BackendConfig = BackendConfig
   { users :: Dict AccountConfig
   }
   deriving (Show, Eq, Generic, FromDhall)

apps/logfeed/Mail.hs

@@ -1,41 +1,44 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# 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 #-}
 
-import           Prelude                        ( )
+import Control.Error (
-import           Relude
+  throwE,
-import qualified Notmuch
+  tryJust,
-import           Say
+  tryRight,
-import           Data.String.Interpolate
+  withExceptT,
-import qualified Data.MIME                     as MIME
+ )
-import           Data.MIME.Charset
+import Control.Lens hiding (argument)
-import           Control.Lens            hiding ( argument )
+import Control.Monad.Catch (
-import           Control.Error                  ( withExceptT
+  MonadCatch,
-                                                , throwE
+  handleIOError,
-                                                , tryJust, tryRight
+ )
-                                                )
-import qualified Data.Text                     as T
-import           Control.Monad.Catch            ( MonadCatch
-                                                , handleIOError
-                                                )
-import           Data.Time
-import           Relude.Extra.Group
-import qualified Data.Map                      as Map
-import qualified Options.Applicative           as O
-import           Text.Atom.Feed.Export          ( textFeed )
-import           Text.Atom.Feed
-import           Text.HTML.TagSoup
 import Data.Either.Extra (mapLeft)
+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.Time
+import Notmuch qualified
+import Options.Applicative qualified as O
+import Relude
+import Relude.Extra.Group
+import Say
+import Text.Atom.Feed
+import Text.Atom.Feed.Export (textFeed)
+import Text.HTML.TagSoup
+import Prelude ()
 
 data Options = Options
   { dbPath :: String
@@ -43,166 +46,184 @@ data Options = Options
   }
 
 data Thread = Thread
-  { subject    :: Text
+  { subject :: Text
-  , threadid   :: ByteString
+  , threadid :: ByteString
-  , authors    :: [Text]
+  , authors :: [Text]
-  , date       :: UTCTime
+  , date :: UTCTime
   , totalCount :: Int
-  , messages   :: [Message]
+  , messages :: [Message]
   }
 type Error = Text
 
 data Body = HTMLBody Text | TextBody Text
 
 data Message = Message
-  { date    :: UTCTime
+  { date :: UTCTime
   , headers :: [(Text, Text)]
-  , body    :: Body
+  , body :: Body
   }
 
 main :: IO ()
 main = do
-  Options { dbPath, folder } <- O.execParser $ O.info
+  Options{dbPath, folder} <-
-    (    Options
+    O.execParser $
-    <$>  O.argument
+      O.info
-           O.str
+        ( Options
-           (  O.metavar "DBPATH"
+            <$> O.argument
-           <> O.help "The full path to the notmuch database"
+              O.str
-           )
+              ( O.metavar "DBPATH"
-    <*>  O.argument
+                  <> O.help "The full path to the notmuch database"
-           O.str
+              )
-           (O.metavar "FOLDER" <> O.help "The maildir to scan for messages.")
+            <*> O.argument
-    <**> O.helper
+              O.str
-    )
+              (O.metavar "FOLDER" <> O.help "The maildir to scan for messages.")
-    O.fullDesc
+            <**> O.helper
+        )
+        O.fullDesc
   res <- runExceptT do
     (thrds, msgs) <- withExceptT
-      (\(er :: Notmuch.Status) ->
+      ( \(er :: Notmuch.Status) ->
-        [i|Failed to read notmuch data.\ndb path: #{dbPath}\nquery: Folder #{folder}\nerror: #{er}|]
+          [i|Failed to read notmuch data.\ndb path: #{dbPath}\nquery: Folder #{folder}\nerror: #{er}|]
       )
       do
         db <- Notmuch.databaseOpenReadOnly dbPath
-        q  <- Notmuch.query db (Notmuch.Folder folder)
+        q <- Notmuch.query db (Notmuch.Folder folder)
         (,) <$> Notmuch.threads q <*> Notmuch.messages q
-    msgsByThread  <- forM msgs \msg -> Notmuch.threadId msg <&> (, Right msg)
+    msgsByThread <- forM msgs \msg -> Notmuch.threadId msg <&> (,Right msg)
-    thrdsByThread <- forM thrds \thrd -> Notmuch.threadId thrd <&> (, Left thrd)
+    thrdsByThread <- forM thrds \thrd -> Notmuch.threadId thrd <&> (,Left thrd)
-    result        <-
+    result <-
-      mapM (runExceptT . processThread) . Map.toList $ fmap snd <$> groupBy
+      mapM (runExceptT . processThread) . Map.toList $
-        fst
+        fmap snd
-        (msgsByThread <> thrdsByThread)
+          <$> groupBy
+            fst
+            (msgsByThread <> thrdsByThread)
     now <- lift getCurrentTime
     let entries =
           threadToEntry <$> sortOn (date :: Thread -> UTCTime) (rights result)
-        feed = nullFeed [i|read-later-e-mails-#{timestamp now}|]
+        feed =
-                        (TextString "Readlater-E-Mail")
+          nullFeed
-                        (timestamp now)
+            [i|read-later-e-mails-#{timestamp now}|]
+            (TextString "Readlater-E-Mail")
+            (timestamp now)
         errors = lefts result
-    feedText <- tryJust [i|Failed to generate feed.|] . textFeed $ feed
+    feedText <-
-      { feedEntries = (if null errors then id else (errorsToEntry now errors :))
+      tryJust [i|Failed to generate feed.|] . textFeed $
-                        entries
+        feed
-      }
+          { feedEntries =
+              (if null errors then id else (errorsToEntry now errors :))
+                entries
+          }
     say $ toStrict feedText
   either
-    (\(er :: Text) ->
+    ( \(er :: Text) ->
-      sayErr [i|mail2feed failed to export mails to rss.\n#{er}|]
+        sayErr [i|mail2feed failed to export mails to rss.\n#{er}|]
     )
     (const pass)
     res
 
 threadToEntry :: Thread -> Entry
-threadToEntry Thread { subject, messages, threadid, totalCount, date, authors }
+threadToEntry Thread{subject, messages, threadid, totalCount, date, authors} =
-  = (nullEntry threadUrl threadTitle (timestamp date))
+  (nullEntry threadUrl threadTitle (timestamp date))
     { entryContent = Just . HTMLContent $ content
-    , entryAuthors = (\x -> nullPerson { personName = x }) <$> authors
+    , entryAuthors = (\x -> nullPerson{personName = x}) <$> authors
     }
  where
-  threadUrl   = [i|thread-#{threadid}-#{timestamp date}|]
+  threadUrl = [i|thread-#{threadid}-#{timestamp date}|]
   threadTitle = TextString [i|#{subject} (#{length messages}/#{totalCount})|]
-  content     = T.intercalate [i|<br>\n<hr>\n|] (messageToHtml <$> messages)
+  content = T.intercalate [i|<br>\n<hr>\n|] (messageToHtml <$> messages)
 
 errorsToEntry :: UTCTime -> [Error] -> Entry
-errorsToEntry now er = (nullEntry [i|mailerrors - #{timestamp now}|]
+errorsToEntry now er =
-                                  (TextString [i|Mail processing Errors|])
+  ( nullEntry
-                                  (timestamp now)
+      [i|mailerrors - #{timestamp now}|]
-                       )
+      (TextString [i|Mail processing Errors|])
-  { entryContent = Just
+      (timestamp now)
-                   . HTMLContent
+  )
-                   . T.intercalate "<br>\n"
+    { entryContent =
-                   . T.splitOn "\n"
+        Just
-                   . T.intercalate "\n"
+          . HTMLContent
-                   $ er
+          . T.intercalate "<br>\n"
-  }
+          . T.splitOn "\n"
+          . T.intercalate "\n"
+          $ er
+    }
 
 timestamp :: UTCTime -> Text
 timestamp = toText . formatTime defaultTimeLocale "%Y-%m-%d %H:%M"
 
-processThread
+processThread ::
-  :: (MonadIO m, MonadCatch m)
+  (MonadIO m, MonadCatch m) =>
-  => ( Notmuch.ThreadId
+  ( Notmuch.ThreadId
-     , NonEmpty (Either (Notmuch.Thread a) (Notmuch.Message n a))
+  , NonEmpty (Either (Notmuch.Thread a) (Notmuch.Message n a))
-     )
+  ) ->
-  -> ExceptT Error m Thread
+  ExceptT Error m Thread
 processThread (threadid, toList -> thrdAndMsgs) =
   handleIOError (\er -> throwE [i|IOError: #{er}|]) $ do
     thread <-
       tryJust [i|No Thread object found for Threadid #{threadid}|]
-      . viaNonEmpty head
+        . viaNonEmpty head
-      . lefts
+        . lefts
-      $ thrdAndMsgs
+        $ thrdAndMsgs
     let msgs = rights thrdAndMsgs
     results <- mapM processMessage msgs
     let messages = sortOn (date :: Message -> UTCTime) results
-    subject    <- decodeUtf8 <$> Notmuch.threadSubject thread
+    subject <- decodeUtf8 <$> Notmuch.threadSubject thread
     totalCount <- Notmuch.threadTotalMessages thread
-    authors    <- (^. Notmuch.matchedAuthors) <$> Notmuch.threadAuthors thread
+    authors <- (^. Notmuch.matchedAuthors) <$> Notmuch.threadAuthors thread
-    date       <- Notmuch.threadNewestDate thread
+    date <- Notmuch.threadNewestDate thread
-    pure (Thread { subject, threadid, messages, totalCount, authors, date })
+    pure (Thread{subject, threadid, messages, totalCount, authors, date})
-
 
 messageToHtml :: Message -> Text
-messageToHtml Message { headers, body } =
+messageToHtml Message{headers, body} =
-  T.intercalate "<br>\n"
+  T.intercalate "<br>\n" $
-    $  ((\(name, content) -> [i|<b>#{name}:</b> #{content}|]) <$> headers)
+    ((\(name, content) -> [i|<b>#{name}:</b> #{content}|]) <$> headers)
-    <> one (bodyToHtml body)
+      <> one (bodyToHtml body)
 
 bodyToHtml :: Body -> Text
 bodyToHtml (HTMLBody x) = fromMaybe x onlyBody
-   where onlyBody = renderTags . takeWhile (not . isTagCloseName "body") <$> (viaNonEmpty tail . dropWhile (not . isTagOpenName "body") . parseTags $ x)
+ 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
 
 processMessage :: (MonadIO m, MonadCatch m) => Notmuch.Message n a -> m Message
 processMessage msg = do
-  fileName  <- Notmuch.messageFilename msg
+  fileName <- Notmuch.messageFilename msg
-  date      <- Notmuch.messageDate msg
+  date <- Notmuch.messageDate msg
-  subject   <- tryHdr "subject" msg
+  subject <- tryHdr "subject" msg
   fromField <- tryHdr "from" msg
-  toField   <- tryHdr "to" msg
+  toField <- tryHdr "to" msg
-  cc        <- tryHdr "cc" msg
+  cc <- tryHdr "cc" msg
-  unsub     <- tryHdr "list-unsubscribe" msg
+  unsub <- tryHdr "list-unsubscribe" msg
-  let hdrs = mapMaybe
+  let hdrs =
-        (\(x, a) -> (x, ) <$> a)
+        mapMaybe
-        [ ("Subject", subject)
+          (\(x, a) -> (x,) <$> a)
-        , ("From"   , fromField)
+          [ ("Subject", subject)
-        , ("To"     , toField)
+          , ("From", fromField)
-        , ("Cc"     , cc)
+          , ("To", toField)
-        , ("Date"   , Just (timestamp date))
+          , ("Cc", cc)
-        , ("Unsubscribe"  , unsub)
+          , ("Date", Just (timestamp date))
-        ]
+          , ("Unsubscribe", unsub)
+          ]
   msgEither <- runExceptT $ withExceptT
     (\er -> [i|Failed to read msg\nFilename:#{fileName}\nerror: #{er}|])
     do
-      msgContent <- handleIOError (\er -> throwE [i|IOError: #{er}|])
+      msgContent <-
-        $ readFileBS fileName
+        handleIOError (\er -> throwE [i|IOError: #{er}|]) $
-      parseResult <- hoistEither . first toText $ MIME.parse
+          readFileBS fileName
-        (MIME.message MIME.mime)
+      parseResult <-
-        msgContent
+        hoistEither . first toText $
-      textPart <- tryJust [i|No text or html part in message|] $ firstOf
+          MIME.parse
-        (MIME.entities . filtered isHtml <> MIME.entities . filtered isTextPlain
+            (MIME.message MIME.mime)
-        )
+            msgContent
-        parseResult
+      textPart <-
+        tryJust [i|No text or html part in message|] $
+          firstOf
+            ( MIME.entities . filtered isHtml <> MIME.entities . filtered isTextPlain
+            )
+            parseResult
       (if isHtml textPart then HTMLBody else TextBody)
-        <$> tryRight (mapLeft ("Could not decode message "<> ) $ decode textPart)
+        <$> tryRight (mapLeft ("Could not decode message " <>) $ decode textPart)
-  pure $ Message { date, headers = hdrs, body = either TextBody id msgEither }
+  pure $ Message{date, headers = hdrs, body = either TextBody id msgEither}
 
 tryHdr :: MonadIO m => ByteString -> Notmuch.Message n a -> m (Maybe Text)
 tryHdr h msg =

apps/logfeed/Main.hs

@@ -1,29 +1,41 @@
-{-# LANGUAGE ViewPatterns, ScopedTypeVariables, NamedFieldPuns, OverloadedStrings, NoImplicitPrelude, ExtendedDefaultRules, QuasiQuotes, MultiWayIf #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
 module Main where
 
-import qualified Data.List.Extra               as L
+import qualified Data.List.Extra as L
-import           Data.List.NonEmpty             ( groupBy
+import Data.List.NonEmpty (
-                                                , zip
+  groupBy,
-                                                )
+  zip,
-import           Data.String.Interpolate        ( i )
+ )
-import           Data.Text                      ( intercalate
+import Data.String.Interpolate (i)
-                                                , replace
+import Data.Text (
-                                                )
+  intercalate,
-import qualified Data.Text                     as Text
+  replace,
-import qualified Data.Time.Calendar            as T
+ )
-import qualified Data.Time.Clock               as T
+import qualified Data.Text as Text
-import qualified Data.Time.Format              as T
+import qualified Data.Time.Calendar as T
-import           Relude                  hiding ( intercalate
+import qualified Data.Time.Clock as T
-                                                , zip
+import qualified Data.Time.Format as T
-                                                )
+import Relude hiding (
-import           System.Environment ()
+  intercalate,
-import           System.FilePattern.Directory   ( getDirectoryFiles )
+  zip,
-import           Text.Atom.Feed
+ )
-import           Text.Atom.Feed.Export          ( textFeed )
+import System.Environment ()
-import qualified Text.Megaparsec               as MP
+import System.FilePattern.Directory (getDirectoryFiles)
-import qualified Text.Megaparsec.Char          as MP
+import Text.Atom.Feed
-import qualified Text.Megaparsec.Char          as MPC
+import Text.Atom.Feed.Export (textFeed)
-import qualified Text.Megaparsec.Char.Lexer    as MP
+import qualified Text.Megaparsec as MP
+import qualified Text.Megaparsec.Char as MP
+import qualified Text.Megaparsec.Char as MPC
+import qualified Text.Megaparsec.Char.Lexer as MP
+
 -- TODO: use Text instead of linked lists of chars
 
 type WeechatLog = [WeechatLine]
@@ -31,14 +43,15 @@ data WeechatLine = WeechatLine
   { wlDate :: Text
   , wlTime :: Text
   , wlNick :: Text
-  , wlMsg  :: Text
+  , wlMsg :: Text
   }
   deriving (Show, Eq, Ord)
+
 -- TODO: specific handling of join/part/network messages
 
 data LogFile = LogFile
-  { path    :: Text
+  { path :: Text
-  , server  :: Text
+  , server :: Text
   , channel :: Text
   }
   deriving (Show, Eq, Ord, Read)
@@ -88,8 +101,8 @@ ircParser :: Text -> Parser LogFile
 ircParser p = do
   void $ MP.count 4 MP.digitChar
   void dirSep
-  prefix  <- symbol "irc:" :: Parser Text
+  prefix <- symbol "irc:" :: Parser Text
-  server  <- folder
+  server <- folder
   channel <- folder
   void parseDate
   void $ symbol ".weechatlog"
@@ -101,23 +114,26 @@ logFolder = "/home/maralorn/logs/"
 main :: IO ()
 main = do
   now <- T.getCurrentTime
-  let getFiles t p = L.groupSortOn (\x -> (channel x, server x))
+  let getFiles t p =
-          .   mapMaybe ((\x -> MP.parseMaybe (p x) x) . toText)
+        L.groupSortOn (\x -> (channel x, server x))
+          . mapMaybe ((\x -> MP.parseMaybe (p x) x) . toText)
           <$> getDirectoryFiles
-                (toString logFolder)
+            (toString logFolder)
-                (   T.formatTime T.defaultTimeLocale t
+            ( T.formatTime T.defaultTimeLocale t
                 <$> [yesterday now, today now]
-                )
+            )
   matrixFiles <- getFiles "%Y/matrix:*/*.!*/%Y-%m-%d-*.weechatlog" matrixParser
-  ircFiles    <- getFiles "%Y/irc:*/#*/%Y-%m-%d.weechatlog" ircParser
+  ircFiles <- getFiles "%Y/irc:*/#*/%Y-%m-%d.weechatlog" ircParser
-  logs        <- mapM readLogFiles $ mapMaybe nonEmpty $ matrixFiles <> ircFiles
+  logs <- mapM readLogFiles $ mapMaybe nonEmpty $ matrixFiles <> ircFiles
   let entries = logs & mapMaybe (logToFeedEntry now)
-      feed    = nullFeed [i|weechat-logs-#{timestamp now}|]
+      feed =
-                         (TextString "Weechat Logs")
+        nullFeed
-                         (timestamp now)
+          [i|weechat-logs-#{timestamp now}|]
+          (TextString "Weechat Logs")
+          (timestamp now)
   [pathToWrite] <- getArgs
-  whenJust (textFeed feed { feedEntries = entries })
+  whenJust (textFeed feed{feedEntries = entries}) $
-    $ \file -> writeFileLText pathToWrite file
+    \file -> writeFileLText pathToWrite file
 
 today :: T.UTCTime -> T.Day
 today = T.utctDay
@@ -129,14 +145,17 @@ timestamp = toText . T.formatTime T.defaultTimeLocale "%Y-%m-%d %H:%M"
 
 logToFeedEntry :: T.UTCTime -> Log -> Maybe Entry
 logToFeedEntry now =
-  \Log { logchannel, logserver, messages = filter msgFilter -> messages } ->
+  \Log{logchannel, logserver, messages = filter msgFilter -> messages} ->
     if not (null messages)
-      then Just (nullEntry [i|#{logserver}-#{logchannel}-#{timestamp now}|]
+      then
-                           (TextString [i|#{logchannel} - (#{logserver})|])
+        Just
-                           (timestamp now)
+          ( nullEntry
-                )
+              [i|#{logserver}-#{logchannel}-#{timestamp now}|]
-        { entryContent = Just $ HTMLContent $ printHTML messages
+              (TextString [i|#{logchannel} - (#{logserver})|])
-        }
+              (timestamp now)
+          )
+            { entryContent = Just $ HTMLContent $ printHTML messages
+            }
       else Nothing
  where
   cutoff =
@@ -145,8 +164,8 @@ logToFeedEntry now =
 
 data Log = Log
   { logchannel :: Text
-  , logserver  :: Text
+  , logserver :: Text
-  , messages   :: [WeechatLine]
+  , messages :: [WeechatLine]
   }
   deriving (Show, Eq, Ord)
 
@@ -155,16 +174,16 @@ readLogFiles files =
   readLogFile (head files)
     <$> mapM (readFileText . toString . (logFolder <>) . path) files
 
-
 readLogFile :: LogFile -> NonEmpty Text -> Log
-readLogFile LogFile { channel, server } contents = Log
+readLogFile LogFile{channel, server} contents =
-  { logchannel = channel
+  Log
-  , logserver  = server
+    { logchannel = channel
-  , messages   = L.sortOn (\x -> (wlDate x, wlTime x))
+    , logserver = server
-                 .   concat
+    , messages =
-                 $   parseWeechatLog
+        L.sortOn (\x -> (wlDate x, wlTime x))
-                 <$> contents
+          . concatMap parseWeechatLog
-  }
+          $ contents
+    }
 
 parseWeechatLine :: Parser WeechatLine
 parseWeechatLine = do
@@ -179,34 +198,38 @@ parseWeechatLog :: Text -> [WeechatLine]
 parseWeechatLog = filter actualMessage . mapMaybe parseLine . lines
  where
   actualMessage = not . (`elem` ["-->", "<--", "--"]) . wlNick
-  parseLine     = MP.parseMaybe parseWeechatLine
+  parseLine = MP.parseMaybe parseWeechatLine
 
 printHTML :: [WeechatLine] -> Text
 printHTML log = intercalate "\n" $ map printDay days
  where
   days = groupBy ((==) `on` wlDate) log
   printDay ls =
-    intercalate "\n" $ ["<h3>" <> wlDate (head ls) <> "</h3>"] <> toList
+    intercalate "\n" $
-      (printRow <$> zip (WeechatLine "" "" "" "" :| toList ls) ls)
+      ["<h3>" <> wlDate (head ls) <> "</h3>"]
+        <> toList
+          (printRow <$> zip (WeechatLine "" "" "" "" :| toList ls) ls)
   printRow :: (WeechatLine, WeechatLine) -> Text
   printRow (prevRow, curRow) =
     "<i>" <> time <> "</i> <b>" <> printNick <> "</b> " <> message <> "<br>"
    where
     prevTime = Text.take 5 $ wlTime prevRow
-    curTime  = Text.take 5 $ wlTime curRow
+    curTime = Text.take 5 $ wlTime curRow
     prevNick = wlNick prevRow
-    curNick  = wlNick curRow
+    curNick = wlNick curRow
-    time | prevTime == curTime = ""
+    time
-         | otherwise           = curTime
+      | prevTime == curTime = ""
-    nick | specialNick curNick = curNick
+      | otherwise = curTime
-         | prevNick == curNick = ""
+    nick
-         | otherwise           = curNick
+      | specialNick curNick = curNick
+      | prevNick == curNick = ""
+      | otherwise = curNick
     printNick = Text.dropWhile (`elem` ['&', '@']) nick
-    msg       = wlMsg curRow
+    msg = wlMsg curRow
     message
-      | not (Text.null msg) && Text.head msg == '>'
+      | not (Text.null msg) && Text.head msg == '>' =
-      = "|<i style='color: grey'>" <> escape (Text.tail msg) <> "</i>"
+          "|<i style='color: grey'>" <> escape (Text.tail msg) <> "</i>"
-      | otherwise
+      | otherwise =
-      = escape msg
+          escape msg
   specialNick = (`elem` ["-->", "<--", "--", "*"])
-  escape      = replace "<" "&lt;" . replace ">" "&gt;"
+  escape = replace "<" "&lt;" . replace ">" "&gt;"

apps/logfeed/default.nix

@@ -1,3 +1,5 @@
-{ pkgs ? import (import nix/sources.nix).nixpkgs {} }:
+{pkgs ? import (import nix/sources.nix).nixpkgs {}}:
-with pkgs; with haskell.lib; with haskellPackages;
+with pkgs;
-callCabal2nix "logfeed" ./. { purebred-email = doJailbreak (unmarkBroken (dontCheck purebred-email)); }
+with haskell.lib;
+with haskellPackages;
+  callCabal2nix "logfeed" ./. {purebred-email = doJailbreak (unmarkBroken (dontCheck purebred-email));}

apps/logfeed/shell.nix

@@ -1,12 +1,11 @@
-{ pkgs ? import (import nix/sources.nix).nixpkgs {} }:
+{pkgs ? import (import nix/sources.nix).nixpkgs {}}: let
-let
   inherit (pkgs) haskellPackages;
 in
-haskellPackages.shellFor {
+  haskellPackages.shellFor {
-  withHoogle = true;
+    withHoogle = true;
-  packages = p: [ (import ./. { inherit pkgs; }) ];
+    packages = p: [(import ./. {inherit pkgs;})];
-  buildInputs = builtins.attrValues {
+    buildInputs = builtins.attrValues {
-    inherit (haskellPackages) hlint cabal-install notmuch hsemail;
+      inherit (haskellPackages) hlint cabal-install notmuch hsemail;
-    inherit (pkgs) coreutils zlib;
+      inherit (pkgs) coreutils zlib;
-  };
+    };
-}
+  }

apps/nixpkgs-bot/exe/Main.hs

@@ -269,8 +269,12 @@ getMissingAuthorSubscriptions pr_key author = do
   author_subs <- SQL.select $ do
     author_sub <- SQL.from $ SQL.table @AuthorSubscription
     SQL.where_
-      ( author_sub ^. AuthorSubscriptionGithubLogin ==. SQL.val author
+      ( author_sub
-          SQL.&&. author_sub ^. AuthorSubscriptionUser `notIn` SQL.subSelectList users_subscribed_to_this_pr
+          ^. AuthorSubscriptionGithubLogin
+          ==. SQL.val author
+          SQL.&&. author_sub
+          ^. AuthorSubscriptionUser
+          `notIn` SQL.subSelectList users_subscribed_to_this_pr
       )
     pure author_sub
   pure $ fmap (authorSubscriptionUser . Persist.entityVal) author_subs
@@ -461,10 +465,12 @@ deleteUnusedQueries :: App ()
 deleteUnusedQueries = SQL.delete do
   query <- SQL.from $ SQL.table @Query
   SQL.where_ $
-    (query ^. QueryUser) `notIn` SQL.subList_select do
+    (query ^. QueryUser)
-      sub <- SQL.from $ SQL.table @Subscription
+      `notIn` SQL.subList_select do
-      pure (sub ^. SubscriptionUser)
+        sub <- SQL.from $ SQL.table @Subscription
-      &&. (query ^. QueryUser) `notIn` SQL.subList_select do
+        pure (sub ^. SubscriptionUser)
+      &&. (query ^. QueryUser)
+      `notIn` SQL.subList_select do
         sub <- SQL.from $ SQL.table @AuthorSubscription
         pure (sub ^. AuthorSubscriptionUser)
 
@@ -565,8 +571,8 @@ setQueries commands = do
       Just query
         | queryRoom query == coerce (roomId command) -> pass
         | otherwise -> do
-          set_room
+            set_room
-          sendMessageToUser (author command) $ m "Because you sent your most recent message to this room, I will use this room for direct messages to you from now on."
+            sendMessageToUser (author command) $ m "Because you sent your most recent message to this room, I will use this room for direct messages to you from now on."
       _ -> do
         putTextLn $ "Setting Query for user " <> author command <> " to " <> coerce (roomId command)
         set_room
@@ -595,32 +601,32 @@ resultHandler syncResult@Matrix.SyncResult{Matrix.srNextBatch, Matrix.srRooms} =
     (cmd,) <$> catchAll case cmd of
       MkCommand{command, author, args}
         | Text.isPrefixOf command "subscribe"
-          , split_args <- Text.words args
+        , split_args <- Text.words args
-          , fromMaybe False (viaNonEmpty (flip Text.isPrefixOf "user" . head) split_args) -> do
+        , fromMaybe False (viaNonEmpty (flip Text.isPrefixOf "user" . head) split_args) -> do
-          case maybeAt 1 split_args of
+            case maybeAt 1 split_args of
-            Nothing -> pure $ m "Please tell me a user to subscribe to."
+              Nothing -> pure $ m "Please tell me a user to subscribe to."
-            Just user -> do
+              Just user -> do
-              notSubbed <- hasAuthorSub author user
+                notSubbed <- hasAuthorSub author user
-              if notSubbed
+                if notSubbed
-                then do
+                  then do
-                  Persist.insert_ $ AuthorSubscription author user
+                    Persist.insert_ $ AuthorSubscription author user
-                  pure $ m $ "I will now track for you all pull requests by " <> user
+                    pure $ m $ "I will now track for you all pull requests by " <> user
-                else pure $ m $ "Okay, but you were already subscribed to pull requests by user " <> user
+                  else pure $ m $ "Okay, but you were already subscribed to pull requests by user " <> user
       MkCommand{command, author, args}
         | Text.isPrefixOf command "unsubscribe"
-          , split_args <- Text.words args
+        , split_args <- Text.words args
-          , fromMaybe False (viaNonEmpty (flip Text.isPrefixOf "user" . head) split_args) -> do
+        , fromMaybe False (viaNonEmpty (flip Text.isPrefixOf "user" . head) split_args) -> do
-          case maybeAt 1 split_args of
+            case maybeAt 1 split_args of
-            Nothing -> pure $ m "Please tell me a user to unsubscribe from."
+              Nothing -> pure $ m "Please tell me a user to unsubscribe from."
-            Just user -> do
+              Just user -> do
-              notSubbed <- hasAuthorSub author user
+                notSubbed <- hasAuthorSub author user
-              if notSubbed
+                if notSubbed
-                then pure $ m $ "I haven‘t been tracking pull requests by " <> user <> " for you."
+                  then pure $ m $ "I haven‘t been tracking pull requests by " <> user <> " for you."
-                else do
+                  else do
-                  SQL.delete $ do
+                    SQL.delete $ do
-                    author_sub <- SQL.from $ SQL.table @AuthorSubscription
+                      author_sub <- SQL.from $ SQL.table @AuthorSubscription
-                    SQL.where_ (author_sub ^. AuthorSubscriptionUser ==. SQL.val author &&. author_sub ^. AuthorSubscriptionGithubLogin ==. SQL.val user)
+                      SQL.where_ (author_sub ^. AuthorSubscriptionUser ==. SQL.val author &&. author_sub ^. AuthorSubscriptionGithubLogin ==. SQL.val user)
-                  pure $ m $ "I will not subscribe you automatically to new pull requests by user " <> user <> " anymore."
+                    pure $ m $ "I will not subscribe you automatically to new pull requests by user " <> user <> " anymore."
       MkCommand{command, author, args} | Text.isPrefixOf command "subscribe" ->
         case parsePRNumber args of
           Nothing -> pure $ m $ "I could not parse \"" <> args <> "\" as a pull request number. Have you maybe mistyped it?"
@@ -644,7 +650,7 @@ resultHandler syncResult@Matrix.SyncResult{Matrix.srNextBatch, Matrix.srRooms} =
             case pr_msg_may of
               Just prMsg
                 | notSubbed ->
-                  pure $ m "Well, you were not subscribed to pull request " <> prMsg
+                    pure $ m "Well, you were not subscribed to pull request " <> prMsg
               Just prMsg -> do
                 Persist.delete $ SubscriptionKey author pr_key
                 pure $ m "Okay, I will not send you updates about pull request " <> prMsg

apps/nixpkgs-bot/lib/NixpkgsBot/GraphQL/API.hs

@@ -14,7 +14,7 @@ import Data.GraphQL.Bootstrap
 import NixpkgsBot.GraphQL.Scalars
 
 {-----------------------------------------------------------------------------
-* MergingPullRequest
+\* MergingPullRequest
 
 -- result :: Object MergingPullRequestSchema; throws a GraphQL exception on errors
 result <- runQuery MergingPullRequestQuery
@@ -113,7 +113,7 @@ instance GraphQLQuery MergingPullRequestQuery where
       ]
 
 {-----------------------------------------------------------------------------
-* PullRequest
+\* PullRequest
 
 -- result :: Object PullRequestSchema; throws a GraphQL exception on errors
 result <- runQuery PullRequestQuery