run `notmuch new` whenever mail is delivered to your maildir

notmuch_watcher.hs

-- Copyright 2018 Google LLC
--
-- Licensed under the Apache License, Version 2.0 (the "License"); you may not
-- use this file except in compliance with the License. You may obtain a copy of
-- the License at
--
--     https://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-- License for the specific language governing permissions and limitations under
-- the License.

import Control.Concurrent.STM (STM)
import qualified Control.Concurrent.STM as STM
import Control.Monad (forever, void)
import Control.Monad.Loops (unfoldM)
import System.Environment (getEnv)
import System.FilePath ((</>))
import System.INotify (EventVariety(Create), addWatch, withINotify)
import System.Process (callProcess)

main =
  withINotify $ \inotify -> do
    home <- getEnv "HOME"
    let maildir = home </> "Maildir"
    events <- STM.atomically STM.newTChan
    void $
      addWatch
        inotify
        [Create]
        (maildir </> "new")
        (STM.atomically . STM.writeTChan events)
    -- Now that the watch has been established and is recording events, invoke
    -- @notmuch new@ once to pick up any mail that arrived before we established
    -- the watch.
    notmuchNew
    -- Now we can handle all the events as they arrive.
    handleEvents events

handleEvents events =
  forever $ do
    void $ STM.atomically (readAllAvailable events)
    notmuchNew

readAllAvailable :: STM.TChan a -> STM [a]
readAllAvailable c = do
  h <- STM.readTChan c
  t <- tryReadAllAvailable c
  return (h : t)

tryReadAllAvailable :: STM.TChan a -> STM [a]
tryReadAllAvailable = unfoldM . STM.tryReadTChan

notmuchNew = callProcess "notmuch" ["new"]