about summary refs log tree commit diff
path: root/users/Profpatsch/mailbox-org/MailboxOrg.hs
diff options
context:
space:
mode:
authorProfpatsch <mail@profpatsch.de>2023-08-06T10·46+0200
committerclbot <clbot@tvl.fyi>2023-08-06T11·17+0000
commit1fd59f51580244bac8e75b4c08f103daa20674d9 (patch)
tree701df9da2d8ff52f7c881e221b416472b0988be3 /users/Profpatsch/mailbox-org/MailboxOrg.hs
parentce4acc08a53fca8bc00282ca0eb4ca5fc048a222 (diff)
chore(users/Profpatsch): clean up haskell libs a little r/6464
Change-Id: Ia9a6c5a754ca8f2912308feb5a26f5276a08d24c
Reviewed-on: https://cl.tvl.fyi/c/depot/+/9011
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
Diffstat (limited to 'users/Profpatsch/mailbox-org/MailboxOrg.hs')
-rw-r--r--users/Profpatsch/mailbox-org/MailboxOrg.hs85
1 files changed, 40 insertions, 45 deletions
diff --git a/users/Profpatsch/mailbox-org/MailboxOrg.hs b/users/Profpatsch/mailbox-org/MailboxOrg.hs
index c66db49c13c7..6c5820080c76 100644
--- a/users/Profpatsch/mailbox-org/MailboxOrg.hs
+++ b/users/Profpatsch/mailbox-org/MailboxOrg.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GHC2021 #-}
 {-# LANGUAGE LambdaCase #-}
@@ -31,7 +30,6 @@ import Data.List qualified as List
 import Data.Map.Strict qualified as Map
 import Data.Text qualified as Text
 import ExecHelpers
-import GHC.Records (HasField (..))
 import Label
 import Netencode qualified
 import Netencode.Parse qualified as NetParse
@@ -117,9 +115,7 @@ listFilterConfig session = do
     >>= printPretty
 
 applyFilterRule ::
-  ( HasField "folderId" dat Text,
-    HasField "rulename" dat Text
-  ) =>
+  (HasField "folderId" dat Text) =>
   dat ->
   Session ->
   IO ()
@@ -209,48 +205,47 @@ applyFilters session = do
             <&> mapFromListOn (\dat -> getLabel @"rulename" dat.parsed)
       )
       ([] :: [()])
-  let goal = Map.fromList [(label @"rulename" "another", 32), (label @"rulename" "xyz", 23)]
+  let goal = Map.fromList [(label @"rulename" "another", 32 :: Integer), (label @"rulename" "xyz", 23)]
   let actions = declarativeUpdate goal filters
   log [fmt|To * create: {actions.toCreate & Map.keys & show}, * update: {actions.toUpdate & Map.keys & show}, * delete: {actions.toDelete & Map.keys & show}|]
-  where
-    -- filters
-    --   & Map.elems
-    --   & traverse_
-    --     ( updateIfDifferent
-    --         session
-    --         ( \el ->
-    --             pure $
-    --               el.original.mailfilter
-    --                 & KeyMap.insert "active" (Json.Bool False)
-    --         )
-    --         (pure ())
-    --     )
-
-    mapFromListOn :: Ord k => (a -> k) -> [a] -> Map k a
-    mapFromListOn on xs = xs <&> (\x -> (on x, x)) & Map.fromList
-    updateIfDifferent ::
-      forall label parsed.
-      ( HasField "id_" parsed Json.Value,
-        HasField "rulename" parsed Text
-      ) =>
-      Session ->
-      (Dat label Json.Object parsed -> IO Json.Object) ->
-      Json.Parse Error () ->
-      Dat label Json.Object parsed ->
-      IO ()
-    updateIfDifferent session switcheroo parser dat = do
-      new <- switcheroo dat
-      if new /= getField @label dat.original
-        then do
-          log [fmt|Updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value})|]
-          mailfilter
-            session
-            "update"
-            mempty
-            parser
-            new
-        else do
-          log [fmt|Skipping updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value}) because nothing changed.|]
+
+-- where
+-- filters
+--   & Map.elems
+--   & traverse_
+--     ( updateIfDifferent
+--         session
+--         ( \el ->
+--             pure $
+--               el.original.mailfilter
+--                 & KeyMap.insert "active" (Json.Bool False)
+--         )
+--         (pure ())
+--     )
+
+-- updateIfDifferent ::
+--   forall label parsed.
+--   ( HasField "id_" parsed Json.Value,
+--     HasField "rulename" parsed Text
+--   ) =>
+--   Session ->
+--   (Dat label Json.Object parsed -> IO Json.Object) ->
+--   Json.Parse Error () ->
+--   Dat label Json.Object parsed ->
+--   IO ()
+-- updateIfDifferent session switcheroo parser dat = do
+--   new <- switcheroo dat
+--   if new /= getField @label dat.original
+--     then do
+--       log [fmt|Updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value})|]
+--       mailfilter
+--         session
+--         "update"
+--         mempty
+--         parser
+--         new
+--     else do
+--       log [fmt|Skipping updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value}) because nothing changed.|]
 
 -- | https://oxpedia.org/wiki/index.php?title=HTTP_API_MailFilter
 mailfilter ::