yeganesh-1.1: yeganesh.hs

-- boilerplate {{{
module Main where

import Control.Arrow ((&&&))
import Control.Monad (liftM)
import Data.Char (toLower)
import Data.List (sortBy)
import Data.Map (Map, insertWith, fromList, toList, union)
import Data.Ord (comparing)
import System.Directory (createDirectoryIfMissing)
import System.Environment (getEnv)
import System.FilePath ((</>))
import System.IO (hClose, hGetContents, hPutStr, hPutStrLn, stderr, stdout)
import System.Process (runInteractiveProcess, waitForProcess)
import qualified System.IO.Strict as Strict (getContents, readFile)
-- }}}
-- filesystem stuff {{{
type Commands = Map String Double

fileName :: IO FilePath
fileName = do
    home <- flip liftM (getEnv "HOME") (</> ".yeganesh")
    createDirectoryIfMissing True home
    return (home </> "default")

readPossiblyNonExistent :: FilePath -> IO Commands
readPossiblyNonExistent file = fmap read $
    catch (Strict.readFile file) (const . return $ "fromList []")
-- }}}
-- pure {{{
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn f = map snd . sortBy (comparing fst) . map (f &&& id)

descSnd :: Num b => (String, b) -> (b, String)
descSnd = (negate . snd) &&& (map toLower . fst)

showPriority :: Commands -> String
showPriority = unlines . map fst . sortOn descSnd . toList

updatePriority :: String -> Commands -> Commands
updatePriority cmd = if null cmd then id else insertWith (+) cmd 1

parseInput :: String -> Commands
parseInput = fromList . flip zip (repeat 0) . filter (not . null) . lines
-- }}}
-- shell stuff {{{
dmenu :: Commands -> IO Commands
dmenu cmds = do
    (hIn, hOut, hErr, p) <- runInteractiveProcess "dmenu" [] Nothing Nothing
    hPutStrLn hIn (showPriority cmds)
    hClose hIn
    o <- hGetContents hOut
    e <- hGetContents hErr
    waitForProcess p
    hPutStr stdout o
    hPutStr stderr e

    return (updatePriority o cmds)
-- }}}
main :: IO ()
main = do
    file    <- fileName
    cached  <- readPossiblyNonExistent file
    new     <- fmap parseInput Strict.getContents
    updated <- dmenu (cached `union` new)
    writeFile file (show updated)