summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--much.cabal5
-rw-r--r--src/Much/API.hs104
-rw-r--r--src/Much/Core.hs5
-rw-r--r--src/Much/Event.hs4
-rw-r--r--src/Much/State.hs4
5 files changed, 121 insertions, 1 deletions
diff --git a/much.cabal b/much.cabal
index b0cdec9..935f148 100644
--- a/much.cabal
+++ b/much.cabal
@@ -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 "λ"