blob: 5810c92c6ba1518847523ecc6e03fd20adc75fcf (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
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 ()
|
