dwm-win32の代替を作る下地

hwm.hs

module Main where

import FRP.Reactive
import FRP.Reactive.LegacyAdapters
import System.IO
import Control.Concurrent
import Control.Applicative
import Control.Monad
import Data.List

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  hSetBuffering stdin  NoBuffering
  hSetEcho stdin False
  (sink, _keyEvent) <- makeEvent =<< makeClock
  forkIO $ forever $ getChar >>= sink
  let keyEvent   = fmap convKey   _keyEvent
  let shellEvent = fmap convshell _shellEvent
  adaptE $ print <$> windows [6,7,8] (keyEvent `mplus` shellEvent)

convKey 'j' = FOCUS (-1)
convKey 'k' = FOCUS 1
convKey _   = NOP

_shellEvent = listE $ zip [1,6..] (cycle [1,2,3])

convshell 1 = CREATE 1
convshell 2 = FOCUS 1
convshell 3 = DELETE 1
convshell _ = NOP


windows ws e = scanlE aux ws e
aux ws (CREATE n)   = n : ws
aux ws (FOCUS (-1)) = (tail ws) ++ [head ws]
aux ws (FOCUS 1   ) = last ws : init ws
aux ws (DELETE n)   = delete n ws
aux ws _            = error "undefined operation"


data OP a = CREATE a
          | FOCUS a
          | MOVE a
          | DELETE a
          | NOP
  deriving (Show, Eq)

type Operation = OP Int