diff options
| -rw-r--r-- | much.cabal | 5 | ||||
| -rw-r--r-- | src/Much/API.hs | 104 | ||||
| -rw-r--r-- | src/Much/Core.hs | 5 | ||||
| -rw-r--r-- | src/Much/Event.hs | 4 | ||||
| -rw-r--r-- | src/Much/State.hs | 4 |
5 files changed, 121 insertions, 1 deletions
@@ -87,13 +87,16 @@ library , filepath , friendly-time , hyphenation + , http-types , linebreak + , network , old-locale , process , random , rosezipper , safe , scanner + , servent-server , split , terminal-size , text @@ -102,5 +105,7 @@ library , transformers-compat , unix , vector + , wai + , warp default-language: Haskell2010 ghc-options: -O2 -Wall -threaded diff --git a/src/Much/API.hs b/src/Much/API.hs new file mode 100644 index 0000000..5810c92 --- /dev/null +++ b/src/Much/API.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Much.API where + +import Control.Concurrent +import Control.Exception (catch, finally, throwIO) +import Control.Monad.IO.Class +import Data.Function ((&)) +import Data.Proxy (Proxy) +import Much.Event +import Much.State +import Much.TreeView +import Network.Socket +import Network.Wai +import Network.Wai.Handler.Warp +import Notmuch.Class +import Notmuch.Message +import Servant +import System.IO.Error (isDoesNotExistError) +import System.Posix.Files (removeLink) +import qualified Data.Tree.Zipper as Z + + +type API = + "current" :> ( + "part" :> Get '[PlainText] String + :<|> + "query" :> Get '[PlainText] String + ) + +api :: Proxy API +api = Proxy + +main :: (Event -> IO ()) -> IO () +main putEvent = do + sock <- socket AF_UNIX Stream defaultProtocol + let sockFile = "/home/tv/tmp/much/warp.sock" -- PID? + removeIfExists sockFile + bind sock $ SockAddrUnix sockFile + listen sock maxListenQueue + let settings = defaultSettings + & setPort 0 + runSettingsSocket settings sock app `finally` closeSocket sock + where + app :: Application + app = serve api server + + server :: Server API + server = + servePart + :<|> + serveQuery + + servePart :: Handler String + servePart = do + q <- liftIO getState + case searchPart (Z.label (cursor q)) of + Just i -> return (show i <> "\n") + Nothing -> throwError err404 + + serveQuery :: Handler String + serveQuery = do + q <- liftIO getState + return $ (searchQuery $ Z.label $ cursor q) <> "\n" + + getState :: IO State + getState = do + v <- newEmptyMVar + putEvent $ EStateGet $ putMVar v + takeMVar v + + searchPart :: TreeView -> Maybe Int + searchPart = \case + TVMessagePart _ i -> Just (partID i) + _ -> Nothing + + searchQuery :: TreeView -> String + searchQuery = \case + TVMessage m -> notmuchId m + TVMessageHeaderField m _ -> notmuchId m + TVMessagePart m _ -> notmuchId m + TVMessageQuoteLine m _ _ _ -> notmuchId m + TVMessageLine m _ _ _ -> notmuchId m + TVSearch s -> s + TVSearchResult r -> notmuchId r + + +removeIfExists :: FilePath -> IO () +removeIfExists fileName = removeLink fileName `catch` handleExists + where handleExists e + | isDoesNotExistError e = return () + | otherwise = throwIO e + + +closeSocket :: Socket -> IO () +closeSocket sock = do + name <- getSocketName sock + close sock + case name of + SockAddrUnix path -> removeIfExists path + _ -> return () diff --git a/src/Much/Core.hs b/src/Much/Core.hs index 353f248..e6dec8a 100644 --- a/src/Much/Core.hs +++ b/src/Much/Core.hs @@ -5,9 +5,11 @@ module Much.Core where import Much.Action +import Much.API import Blessings.String (Blessings(Plain,SGR),pp) import Control.Concurrent import Control.Monad +import Data.Functor import Data.Time import Much.Event import Much.RenderTreeView (renderTreeView) @@ -123,6 +125,7 @@ runState q0 = do threadIds <- mapM forkIO [ forever $ scan stdin >>= putEvent . EScan + , Much.API.main putEvent ] winchHandler putEvent @@ -173,6 +176,8 @@ processEvent q = \case { screenWidth = w, screenHeight = h , flashMessage = Plain $ "resize " <> show (w,h) } + EStateGet f -> + forkIO (f q) $> Right q ev -> return $ Right q { flashMessage = SGR [31,1] $ Plain $ "unhandled event: " <> show ev diff --git a/src/Much/Event.hs b/src/Much/Event.hs index 9842327..5edb5d2 100644 --- a/src/Much/Event.hs +++ b/src/Much/Event.hs @@ -1,6 +1,7 @@ module Much.Event where import Blessings +import Much.State import Scanner data Event = @@ -8,5 +9,6 @@ data Event = EScan Scan | EShutdown | EReload | - EResize Int Int + EResize Int Int | + EStateGet (State -> IO ()) deriving Show diff --git a/src/Much/State.hs b/src/Much/State.hs index a522e99..b09d544 100644 --- a/src/Much/State.hs +++ b/src/Much/State.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} module Much.State where import Blessings.String (Blessings) @@ -40,3 +41,6 @@ data ColorConfig = ColorConfig , boringMessage :: Blessings String -> Blessings String , tagMap :: [(T.Text, Blessings String -> Blessings String)] } + +instance Show (State -> IO ()) where + show = const "λ" |