~haskell-guy/ssb-haskell

ref: 41cde99ec6189dbecca6803a5aa4f6f18142e8ba ssb-haskell/src/Ssb/Aux.hs -rw-r--r-- 2.2 KiB
41cde99e — Haskell Guy initial commit 10 months ago
                                                                                
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
module Ssb.Aux where

import           Protolude

import           Data.Aeson                    as Aeson
import           Data.ByteString.Lazy          as BS (toStrict)
import           Data.Default
import           Data.Serialize                as Serialize
import           Data.Either.Combinators        ( mapLeft
                                                , mapRight
                                                )
import           Control.Concurrent.STM
import           System.IO                      ( hFlush
                                                , hGetLine
                                                , hSetBinaryMode
                                                )
import           System.Process


-- | Convertible  describes instances where types can be easily converted.
class Convertible a b where
  convert :: a -> b

-- | decodeJSON deserializes the JSON bytestring.
-- It is a reimplementation Aeson's eitherDecodeStrict which returns Text
-- instead of String.
decodeJSON :: (FromJSON a) => ByteString -> Either Text a
decodeJSON = mapLeft toS . Aeson.eitherDecodeStrict

encodeJSON :: (ToJSON a) => a -> ByteString
encodeJSON = BS.toStrict . Aeson.encode

encodeByteString :: Serialize.Serialize a => a -> ByteString
encodeByteString = Serialize.encode

decodeByteString :: Serialize.Serialize a => ByteString -> Either Text a
decodeByteString a = mapLeft toS $ Serialize.decode a

withErr :: Text -> Maybe a -> Either Text a
withErr = maybeToRight

error :: Text -> Either Text a
error = Left

maybeWord8 :: Int -> Either Text Word8
maybeWord8 arg = if arg >= min && arg <= max
  then return $ fromIntegral arg
  else Left "out of bounds"
 where
  min = fromIntegral (minBound :: Word8)
  max = fromIntegral (maxBound :: Word8)

-- | TODO: kill command forked by forkCommand
command :: Text -> TMVar ByteString -> TMVar ByteString -> IO ()
command cmd input output = do
  (hIn, hOut, hErr, hProc) <- runInteractiveCommand (toS cmd)
  hSetBinaryMode hIn  False
  hSetBinaryMode hOut False
  hSetBinaryMode hErr False
  let loop = do
        v <- atomically $ takeTMVar input
        hPutStr hIn (toS v :: [Char])
        hFlush hIn
        v' <- hGetLine hOut
        atomically $ putTMVar output (toS v')
        loop
  loop