1 files changed, 104 insertions, 0 deletions
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 ()