diff options
Diffstat (limited to 'examples/dht.hs')
-rw-r--r-- | examples/dht.hs | 90 |
1 files changed, 0 insertions, 90 deletions
diff --git a/examples/dht.hs b/examples/dht.hs deleted file mode 100644 index 3e1b1656..00000000 --- a/examples/dht.hs +++ /dev/null | |||
@@ -1,90 +0,0 @@ | |||
1 | {-# LANGUAGE NondecreasingIndentation #-} | ||
2 | import Control.Applicative | ||
3 | import Control.Monad | ||
4 | import Data.Function | ||
5 | import Control.Monad.IO.Class | ||
6 | import Data.Char | ||
7 | import Data.List | ||
8 | import Network.Socket as Socket | ||
9 | import System.Console.Haskeline | ||
10 | import System.Environment | ||
11 | import System.Exit | ||
12 | import System.IO | ||
13 | import System.IO.Unsafe | ||
14 | import qualified Data.ByteString as B | ||
15 | |||
16 | -- | Reads one character. If it is not a digit, | ||
17 | -- then it is discarded and 'Nothing' is returned. | ||
18 | hReadDigit :: Handle -> IO (Maybe Char) | ||
19 | hReadDigit h = do c <- hGetChar h | ||
20 | return $ guard (isDigit c) >> pure c | ||
21 | |||
22 | -- | Expected input: "nnn:..." | ||
23 | -- Here we read the digit sequence "nnn" and drop the colon | ||
24 | -- as it is the first non-digit. | ||
25 | hReadInt :: Handle -> IO Int | ||
26 | hReadInt h = do | ||
27 | nstr <- fix $ \readDigits -> | ||
28 | maybe (return []) -- dropped non-digit character | ||
29 | (($ unsafeInterleaveIO readDigits) . fmap . (:)) | ||
30 | =<< hReadDigit h | ||
31 | readIO nstr :: IO Int | ||
32 | |||
33 | |||
34 | -- | Read a length prefixed string from a handle. | ||
35 | -- The format is "nnn:..." where /nnn/ is an ascii-encoded character count | ||
36 | -- and /.../ is the sequence of characters | ||
37 | -- | ||
38 | -- Note: The first byte after the count is ignored and discarded. | ||
39 | readResponse :: Handle -> IO (Char, String) | ||
40 | readResponse h = do | ||
41 | c <- hGetChar h | ||
42 | n <- hReadInt h | ||
43 | s <- sequence $ replicate n (hGetChar h) | ||
44 | return (c,s) | ||
45 | |||
46 | -- | Send a command to the dhtd daemon and then print the response. | ||
47 | sendCommand :: Handle -> String -> InputT IO () | ||
48 | sendCommand h cmd = do liftIO $ hPutStrLn h cmd | ||
49 | fix $ \again -> do | ||
50 | (c, resp) <- liftIO $ readResponse h | ||
51 | if c /= '.' | ||
52 | then outputStr resp >> again | ||
53 | else outputStrLn resp | ||
54 | |||
55 | -- | Get one line of input and send it to the daemon, then run the | ||
56 | -- passed continuation if it wasn't "quit". | ||
57 | interactiveMode :: Handle -> InputT IO () -> InputT IO () | ||
58 | interactiveMode h repl = do | ||
59 | minput <- getInputLine "dht> " | ||
60 | case minput of | ||
61 | Nothing -> return () | ||
62 | Just "quit" -> sendCommand h "quit" >> return () | ||
63 | Just cmd -> sendCommand h cmd >> repl | ||
64 | |||
65 | main :: IO () | ||
66 | main = do | ||
67 | -- Open the control socket to the daemon. | ||
68 | h <- liftIO $ handle (\e -> do hPutStrLn stderr (show (e ::IOError)) | ||
69 | exitFailure) | ||
70 | $ do sock <- socket AF_UNIX Stream defaultProtocol | ||
71 | connect sock (SockAddrUnix "dht.sock") | ||
72 | socketToHandle sock ReadWriteMode | ||
73 | |||
74 | -- Haskeline's default looks only at our stdin and not our stdout. | ||
75 | -- That's a bad idea because we can take input from the command line. | ||
76 | behavior <- do | ||
77 | useTerminal <- and <$> mapM hIsTerminalDevice [stdin,stdout] | ||
78 | return $ if useTerminal then preferTerm else useFileHandle stdin | ||
79 | |||
80 | runInputTBehaviorWithPrefs behavior defaultPrefs defaultSettings $ do | ||
81 | |||
82 | -- A command may be specified on the command line | ||
83 | -- or else we enter an interactive shell. | ||
84 | args <- dropWhile isSpace . unwords <$> liftIO getArgs | ||
85 | case args of | ||
86 | (_:_) -> do | ||
87 | let cs = filter (not . null) $ map (drop 1) $ groupBy (\_ c -> (c/=';')) (';':args) | ||
88 | forM_ cs $ \cmd -> sendCommand h cmd | ||
89 | sendCommand h "quit" | ||
90 | _ -> fix $ interactiveMode h | ||