Formatting

.hlint.yaml

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

apps/kassandra/default.nix

@@ -1,18 +1,22 @@
-{ obelisk ? import ./.obelisk/impl {
+{
+  obelisk ?
+    import ./.obelisk/impl {
       system = builtins.currentSystem;
       config.android_sdk.accept_license = true;
-  }
+    },
 }:
 with obelisk;
   project ./. (
-  { pkgs, ... }:
-  let
-    inherit (pkgs.haskell.lib)
-      markUnbroken dontCheck addBuildDepend doJailbreak
+    {pkgs, ...}: let
+      inherit
+        (pkgs.haskell.lib)
+        markUnbroken
+        dontCheck
+        addBuildDepend
+        doJailbreak
         overrideCabal
         ;
-  in
-  {
+    in {
       android = {
         applicationId = "de.maralorn.kassandra";
         displayName = "Kassandra";
@@ -33,28 +37,32 @@ project ./. (
         relude = dontCheck super.relude;
         stm-containers = markUnbroken super.stm-containers;
         stm-hamt = markUnbroken (doJailbreak super.stm-hamt);
-      streamly-bytestring = self.callHackageDirect
+        streamly-bytestring =
+          self.callHackageDirect
           {
             pkg = "streamly-bytestring";
             ver = "0.1.2";
             sha256 = "08xhp8zgf5n1j4v1br1dz9ih8j05vk92swp3nz9in5xajllkc7qv";
           }
           {};
-      streamly = self.callHackageDirect
+        streamly =
+          self.callHackageDirect
           {
             pkg = "streamly";
             ver = "0.7.0";
             sha256 = "0hr2cz14w6nnbvhnq1fvr8v4rzyqcj3b9khf2rszyji00fmp27l1";
           }
           {};
-      nonempty-vector = self.callHackageDirect
+        nonempty-vector =
+          self.callHackageDirect
           {
             pkg = "nonempty-vector";
             ver = "0.1.0.0";
             sha256 = "06abdmdy9z0w6ishiibir3qfjpqxmb4mrkhgyc4j58hd14s8rj0x";
           }
           {};
-      nonempty-containers = self.callHackageDirect
+        nonempty-containers =
+          self.callHackageDirect
           {
             pkg = "nonempty-containers";
             ver = "0.3.4.1";
@@ -64,70 +72,80 @@ project ./. (
         iCalendar = overrideCabal (doJailbreak (markUnbroken super.iCalendar)) {
           preConfigure = ''substituteInPlace iCalendar.cabal --replace "network >=2.6 && <2.7" "network -any"'';
         };
-      prettyprinter = self.callHackageDirect
+        prettyprinter =
+          self.callHackageDirect
           {
             pkg = "prettyprinter";
             ver = "1.5.1";
             sha256 = "0wx01rvgwnnmg10sh9x2whif5z12058w5djh7m5swz94wvkg5cg3";
           }
           {};
-      cborg-json = self.callHackageDirect
+        cborg-json =
+          self.callHackageDirect
           {
             pkg = "cborg-json";
             ver = "0.2.2.0";
             sha256 = "1s7pv3jz8s1qb0ydcc5nra9f63jp4ay4d0vncv919bakf8snj4vw";
           }
           {};
-      generic-random = self.callHackageDirect
+        generic-random =
+          self.callHackageDirect
           {
             pkg = "generic-random";
             ver = "1.3.0.0";
             sha256 = "0m7lb40wgmyszv8l6qmarkfgs8r0idgl9agwsi72236hpvp353ad";
           }
           {};
-      atomic-write = self.callHackageDirect
+        atomic-write =
+          self.callHackageDirect
           {
             pkg = "atomic-write";
             ver = "0.2.0.7";
             sha256 = "1r9ckwljdbw3mi8rmzmsnh89z8nhw2qnds9n271gkjgavb6hxxf3";
           }
           {};
-      taskwarrior = self.callHackageDirect
+        taskwarrior =
+          self.callHackageDirect
           {
             pkg = "taskwarrior";
             ver = "0.5.0.0";
             sha256 = "sha256-elDUtz0NSG4WHxkyCQ1CunYXWIVRj6EqkKSchPy+c3E=";
           }
           {};
-      base64 = self.callHackageDirect
+        base64 =
+          self.callHackageDirect
           {
             pkg = "base64";
             ver = "0.4.1";
             sha256 = "1pz9s8bmnkrrr3v5mhkwv8vaf251vmxs87zzc5nsjsa027j9lr22";
           }
           {};
-      password = self.callHackageDirect
+        password =
+          self.callHackageDirect
           {
             pkg = "password";
             ver = "2.0.1.0";
             sha256 = "1q99v7w6bdfpnw245aa3zaj3x7mhl9i2y7f2rzlc30g066p9jhaz";
           }
           {};
-      indexed-profunctors = self.callHackageDirect
+        indexed-profunctors =
+          self.callHackageDirect
           {
             pkg = "indexed-profunctors";
             ver = "0.1";
             sha256 = "0vpgbymfhnvip90jwvyniqi34lhz5n3ni1f21g81n5rap0q140za";
           }
           {};
-      generic-lens-core = self.callHackageDirect
+        generic-lens-core =
+          self.callHackageDirect
           {
             pkg = "generic-lens-core";
             ver = "2.0.0.0";
             sha256 = "07parw0frqxxkjbbas9m9xb3pmpqrx9wz63m35wa6xqng9vlcscm";
           }
           {};
-      generic-optics = self.callHackageDirect
+        generic-optics =
+          self.callHackageDirect
           {
             pkg = "generic-optics";
             ver = "2.0.0.0";

apps/kassandra/frontend/src/Frontend.hs

@@ -28,7 +28,8 @@ frontend =
     }
 
 frontendBody :: WidgetJSM t m => m ()
-frontendBody = D.dyn_ . fmap (maybe pass mainWidget)
+frontendBody =
+  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

@@ -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

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

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

@@ -31,7 +31,8 @@ css fontPath = do
     fontFace $ do
       fontFamily [fontName] []
       fontFaceSrc [FontFaceSrcUrl fontSrc (Just OpenType)]
-  let --darkBlue      = rgb 0 0 33
+  let
+    -- darkBlue      = rgb 0 0 33
     lightBlue = rgb 200 200 255
     noMargin = margin (px 0) (px 0) (px 0) (px 0)
     noPadding = padding (px 0) (px 0) (px 0) (px 0)
@@ -162,5 +163,6 @@ css fontPath = do
       ".grey" & color (grayish 160)
       ".show" & color black
       ".showable" & display none
-    active & i ? do
+    active
+      & 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,10 +183,13 @@ 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.el "p" $
+          do
             D.text "Process this task from the inbox:" *> br
             D.text "1. Does it need to be done?" *> br
             D.text "2. Can you do it in under 2 minutes?" *> br

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

@@ -10,6 +10,7 @@ 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.Sequence as Seq
 import qualified Reflex as R
@@ -31,6 +32,7 @@ smartSimpleList widget listElements = do
   void $ R.simpleList (toList <$> listElements) \vDyn -> do
     u <- R.holdUniqDyn vDyn
     D.dyn_ . fmap widget $ u
+
 -- postBuild <- R.getPostBuild
 -- keyMap <- R.holdUniqDyn $ Seq.foldMapWithIndex (curry one) <$> listElements
 -- let keyMapChange =
@@ -42,14 +44,14 @@ smartSimpleList widget listElements = do
 -- 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
-
+{- | 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 ()) ->

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)))

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)

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,8 +208,8 @@ dropChildWidget = do
     (icon "dropHere plusOne" "block")
     $ fmap
       ( \dependencies ->
-          one $
-            #depends
+          one
+            $ #depends
               %~ Set.union (Set.fromList $ toList $ (^. #uuid) <$> dependencies)
             $ taskInfos
               ^. #task
@@ -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.Witherable ( mapMaybe, (<$?>), (<&?>), filter )
+import Data.These (These (..), partitionEithersNE)
 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)

apps/kassandra/release.nix

@@ -1,5 +1,4 @@
-{ pkgs ? import (import nix/sources.nix).nixpkgs { } }:
-let
+{pkgs ? import (import nix/sources.nix).nixpkgs {}}: let
   haskellPackages = pkgs.haskellPackages.extend (
     self: super: {
       kassandra = self.callCabal2nix "kassandra" ./kassandra {};
@@ -7,8 +6,7 @@ let
     }
   );
   reflex-platform = import ./. {};
-in
-{
+in {
   lib = haskellPackages.kassandra;
   app = haskellPackages.standalone;
   server = reflex-platform.exe;

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,8 +121,8 @@ 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 $
-      S.fold (FS.writeChunks handle)
+    liftIO
+      $ S.fold (FS.writeChunks handle)
         . asyncly
         . S.intersperse (Mem.fromList [10])
         . fmap (toArray . toStrict . encode)
@@ -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

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           Relude
-import qualified Notmuch
-import           Say
-import           Data.String.Interpolate
-import qualified Data.MIME                     as MIME
-import           Data.MIME.Charset
+import Control.Error (
+  throwE,
+  tryJust,
+  tryRight,
+  withExceptT,
+ )
 import Control.Lens hiding (argument)
-import           Control.Error                  ( withExceptT
-                                                , throwE
-                                                , tryJust, tryRight
+import Control.Monad.Catch (
+  MonadCatch,
+  handleIOError,
  )
-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
@@ -62,7 +65,9 @@ data Message = Message
 
 main :: IO ()
 main = do
-  Options { dbPath, folder } <- O.execParser $ O.info
+  Options{dbPath, folder} <-
+    O.execParser $
+      O.info
         ( Options
             <$> O.argument
               O.str
@@ -87,18 +92,25 @@ main = do
     msgsByThread <- forM msgs \msg -> Notmuch.threadId msg <&> (,Right msg)
     thrdsByThread <- forM thrds \thrd -> Notmuch.threadId thrd <&> (,Left thrd)
     result <-
-      mapM (runExceptT . processThread) . Map.toList $ fmap snd <$> groupBy
+      mapM (runExceptT . processThread) . Map.toList $
+        fmap snd
+          <$> 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 =
+          nullFeed
+            [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
-      { feedEntries = (if null errors then id else (errorsToEntry now errors :))
+    feedText <-
+      tryJust [i|Failed to generate feed.|] . textFeed $
+        feed
+          { feedEntries =
+              (if null errors then id else (errorsToEntry now errors :))
                 entries
           }
     say $ toStrict feedText
@@ -110,8 +122,8 @@ main = do
     res
 
 threadToEntry :: Thread -> Entry
-threadToEntry Thread { subject, messages, threadid, totalCount, date, authors }
-  = (nullEntry threadUrl threadTitle (timestamp date))
+threadToEntry Thread{subject, messages, threadid, totalCount, date, authors} =
+  (nullEntry threadUrl threadTitle (timestamp date))
     { entryContent = Just . HTMLContent $ content
     , entryAuthors = (\x -> nullPerson{personName = x}) <$> authors
     }
@@ -121,11 +133,14 @@ threadToEntry Thread { subject, messages, threadid, totalCount, date, authors }
   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 =
+  ( nullEntry
+      [i|mailerrors - #{timestamp now}|]
       (TextString [i|Mail processing Errors|])
       (timestamp now)
   )
-  { entryContent = Just
+    { entryContent =
+        Just
           . HTMLContent
           . T.intercalate "<br>\n"
           . T.splitOn "\n"
@@ -136,12 +151,12 @@ errorsToEntry now er = (nullEntry [i|mailerrors - #{timestamp now}|]
 timestamp :: UTCTime -> Text
 timestamp = toText . formatTime defaultTimeLocale "%Y-%m-%d %H:%M"
 
-processThread
-  :: (MonadIO m, MonadCatch m)
-  => ( Notmuch.ThreadId
+processThread ::
+  (MonadIO m, MonadCatch m) =>
+  ( Notmuch.ThreadId
   , 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 <-
@@ -158,16 +173,16 @@ processThread (threadid, toList -> thrdAndMsgs) =
     date <- Notmuch.threadNewestDate thread
     pure (Thread{subject, threadid, messages, totalCount, authors, date})
 
-
 messageToHtml :: Message -> Text
 messageToHtml Message{headers, body} =
-  T.intercalate "<br>\n"
-    $  ((\(name, content) -> [i|<b>#{name}:</b> #{content}|]) <$> headers)
+  T.intercalate "<br>\n" $
+    ((\(name, content) -> [i|<b>#{name}:</b> #{content}|]) <$> headers)
       <> 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
@@ -179,7 +194,8 @@ processMessage msg = do
   toField <- tryHdr "to" msg
   cc <- tryHdr "cc" msg
   unsub <- tryHdr "list-unsubscribe" msg
-  let hdrs = mapMaybe
+  let hdrs =
+        mapMaybe
           (\(x, a) -> (x,) <$> a)
           [ ("Subject", subject)
           , ("From", fromField)
@@ -191,12 +207,17 @@ processMessage msg = do
   msgEither <- runExceptT $ withExceptT
     (\er -> [i|Failed to read msg\nFilename:#{fileName}\nerror: #{er}|])
     do
-      msgContent <- handleIOError (\er -> throwE [i|IOError: #{er}|])
-        $ readFileBS fileName
-      parseResult <- hoistEither . first toText $ MIME.parse
+      msgContent <-
+        handleIOError (\er -> throwE [i|IOError: #{er}|]) $
+          readFileBS fileName
+      parseResult <-
+        hoistEither . first toText $
+          MIME.parse
             (MIME.message MIME.mime)
             msgContent
-      textPart <- tryJust [i|No text or html part in message|] $ firstOf
+      textPart <-
+        tryJust [i|No text or html part in message|] $
+          firstOf
             ( MIME.entities . filtered isHtml <> MIME.entities . filtered isTextPlain
             )
             parseResult

apps/logfeed/Main.hs

@@ -1,20 +1,31 @@
-{-# 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           Data.List.NonEmpty             ( groupBy
-                                                , zip
+import Data.List.NonEmpty (
+  groupBy,
+  zip,
  )
 import Data.String.Interpolate (i)
-import           Data.Text                      ( intercalate
-                                                , replace
+import Data.Text (
+  intercalate,
+  replace,
  )
 import qualified Data.Text as Text
 import qualified Data.Time.Calendar as T
 import qualified Data.Time.Clock as T
 import qualified Data.Time.Format as T
-import           Relude                  hiding ( intercalate
-                                                , zip
+import Relude hiding (
+  intercalate,
+  zip,
  )
 import System.Environment ()
 import System.FilePattern.Directory (getDirectoryFiles)
@@ -24,6 +35,7 @@ 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]
@@ -34,6 +46,7 @@ data WeechatLine = WeechatLine
   , wlMsg :: Text
   }
   deriving (Show, Eq, Ord)
+
 -- TODO: specific handling of join/part/network messages
 
 data LogFile = LogFile
@@ -101,7 +114,8 @@ 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 =
+        L.groupSortOn (\x -> (channel x, server x))
           . mapMaybe ((\x -> MP.parseMaybe (p x) x) . toText)
           <$> getDirectoryFiles
             (toString logFolder)
@@ -112,12 +126,14 @@ main = do
   ircFiles <- getFiles "%Y/irc:*/#*/%Y-%m-%d.weechatlog" ircParser
   logs <- mapM readLogFiles $ mapMaybe nonEmpty $ matrixFiles <> ircFiles
   let entries = logs & mapMaybe (logToFeedEntry now)
-      feed    = nullFeed [i|weechat-logs-#{timestamp now}|]
+      feed =
+        nullFeed
+          [i|weechat-logs-#{timestamp now}|]
           (TextString "Weechat Logs")
           (timestamp now)
   [pathToWrite] <- getArgs
-  whenJust (textFeed feed { feedEntries = entries })
-    $ \file -> writeFileLText pathToWrite file
+  whenJust (textFeed feed{feedEntries = entries}) $
+    \file -> writeFileLText pathToWrite file
 
 today :: T.UTCTime -> T.Day
 today = T.utctDay
@@ -131,7 +147,10 @@ logToFeedEntry :: T.UTCTime -> Log -> Maybe Entry
 logToFeedEntry now =
   \Log{logchannel, logserver, messages = filter msgFilter -> messages} ->
     if not (null messages)
-      then Just (nullEntry [i|#{logserver}-#{logchannel}-#{timestamp now}|]
+      then
+        Just
+          ( nullEntry
+              [i|#{logserver}-#{logchannel}-#{timestamp now}|]
               (TextString [i|#{logchannel} - (#{logserver})|])
               (timestamp now)
           )
@@ -155,15 +174,15 @@ 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 =
+  Log
     { logchannel = channel
     , logserver = server
-  , messages   = L.sortOn (\x -> (wlDate x, wlTime x))
-                 .   concat
-                 $   parseWeechatLog
-                 <$> contents
+    , messages =
+        L.sortOn (\x -> (wlDate x, wlTime x))
+          . concatMap parseWeechatLog
+          $ contents
     }
 
 parseWeechatLine :: Parser WeechatLine
@@ -186,7 +205,9 @@ 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" $
+      ["<h3>" <> wlDate (head ls) <> "</h3>"]
+        <> toList
           (printRow <$> zip (WeechatLine "" "" "" "" :| toList ls) ls)
   printRow :: (WeechatLine, WeechatLine) -> Text
   printRow (prevRow, curRow) =
@@ -196,17 +217,19 @@ printHTML log = intercalate "\n" $ map printDay days
     curTime = Text.take 5 $ wlTime curRow
     prevNick = wlNick prevRow
     curNick = wlNick curRow
-    time | prevTime == curTime = ""
+    time
+      | prevTime == curTime = ""
       | otherwise = curTime
-    nick | specialNick curNick = curNick
+    nick
+      | specialNick curNick = curNick
       | prevNick == curNick = ""
       | otherwise = curNick
     printNick = Text.dropWhile (`elem` ['&', '@']) nick
     msg = wlMsg curRow
     message
-      | not (Text.null msg) && Text.head msg == '>'
-      = "|<i style='color: grey'>" <> escape (Text.tail msg) <> "</i>"
-      | otherwise
-      = escape msg
+      | not (Text.null msg) && Text.head msg == '>' =
+          "|<i style='color: grey'>" <> escape (Text.tail msg) <> "</i>"
+      | otherwise =
+          escape msg
   specialNick = (`elem` ["-->", "<--", "--", "*"])
   escape = replace "<" "&lt;" . replace ">" "&gt;"

apps/logfeed/default.nix

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

apps/logfeed/shell.nix

@@ -1,5 +1,4 @@
-{ pkgs ? import (import nix/sources.nix).nixpkgs {} }:
-let
+{pkgs ? import (import nix/sources.nix).nixpkgs {}}: let
   inherit (pkgs) haskellPackages;
 in
   haskellPackages.shellFor {

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
-          SQL.&&. author_sub ^. AuthorSubscriptionUser `notIn` SQL.subSelectList users_subscribed_to_this_pr
+      ( author_sub
+          ^. 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)
+      `notIn` SQL.subList_select do
         sub <- SQL.from $ SQL.table @Subscription
         pure (sub ^. SubscriptionUser)
-      &&. (query ^. QueryUser) `notIn` SQL.subList_select do
+      &&. (query ^. QueryUser)
+      `notIn` SQL.subList_select do
         sub <- SQL.from $ SQL.table @AuthorSubscription
         pure (sub ^. AuthorSubscriptionUser)
 

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