This is a program that will recursively monitor a directory for changed files. When it detects a changed file, it will use scp to upload that file to a server. This is nice for being able to edit files on your local computer and have them automatically synced to a remove computer as soon as you :w them in vim.

MonitorDirectory.hs

#!/usr/bin/env runhaskell -Wall

import Control.Concurrent (threadDelay, forkIO)
import Control.Concurrent.MVar
import Control.Monad (liftM, filterM)
import Data.List (isPrefixOf, (\\))
import HSH.ShellEquivs (glob)
import System.Directory (canonicalizePath, getCurrentDirectory, doesFileExist)
--import System.Environment (getArgs)
import System.FilePath ((</>))
import System.FilePath.Posix (makeRelative)
import System.IO.HVFS.Utils (SystemFS(..))
import System.KQueue.HighLevel (watchFile, EventType(..), Watcher)
import System.Path (recurseDir)
import System.Process (rawSystem)

data ShouldSync = ShouldSync | ShouldNotSync deriving (Eq)

watch :: MVar (EventType, FilePath) -> FilePath -> IO Watcher
watch chan file =
    let handler ev = putMVar chan (ev, file)
    in watchFile file handler

listen :: MVar (EventType, FilePath) -> IO ()
listen chan = do
    (event, file) <- takeMVar chan
    scpFile "" file event
    listen chan

excludeFiles :: String -> Bool
excludeFiles "." = True
excludeFiles ".." = True
excludeFiles file | ".git" `isPrefixOf` file = True
                  | otherwise = False

getAllFilesToMonitor :: IO [FilePath]
getAllFilesToMonitor = do
        currentDir <- getCurrentDirectory
        files <- recurseDir SystemFS currentDir
        let filteredFiles = filter (not . excludeFiles) $ map (makeRelative currentDir) files
        normalFiles <- filterM doesFileExist filteredFiles
        return normalFiles

updateFilesToMonitor :: MVar (EventType, FilePath) -> [FilePath] -> ShouldSync -> IO ()
updateFilesToMonitor chan oldFiles shouldSync = do
        allFiles <- getAllFilesToMonitor
        let newFiles = allFiles \\ oldFiles
        _ <- mapM (putStrLn . ("new file found: " ++)) newFiles
        _ <- mapM (watch chan) newFiles
        _ <- mapM (\filename -> if shouldSync == ShouldSync then scpFile "" filename Created else putStr "") newFiles
        threadDelay (3 * 1000000)
        updateFilesToMonitor chan allFiles ShouldSync


main :: IO ()
main = do
        --args <- getArgs
        chan <- newEmptyMVar
        _ <- forkIO $ updateFilesToMonitor chan [] ShouldNotSync
        listen chan

scpFile :: FilePath -> FilePath -> EventType -> IO ()
scpFile _ _ Deleted = return ()
scpFile _ filename _ =
    do
        putStrLn ("rsyncing " ++ filename ++ "...")
        sshKey <- (head `liftM` glob "~/.ssh/path/to/ssh/key") >>= canonicalizePath
        _ <- rawSystem "scp" ["-r", "-i", sshKey, "-P", "2222", filename, "user@host:some/path/" </> filename]
        return ()