Utils.hs

module BaseXClient.Utils where

import Control.Applicative
import Data.Char
import System.IO

exec :: Handle -> Int -> [String] -> IO String
exec h code strs = do
  writeCode h code
  writeStrings h strs
  info <- readString h
  ok h <$$> \b -> if b
    then info
    else error info

readString :: Handle -> IO String
readString h = do
  c <- hGetChar h
  if c /= '\0'
    then (:) <$> (if c == '\255' then hGetChar h else return c) <*> readString h
    else return []

writeCode :: Handle -> Int -> IO ()
writeCode h code = hPutChar h $ chr code

writeString :: Handle -> String -> IO ()
writeString h str = do
  writeString' h str
  hFlush h

writeStrings :: Handle -> [String] -> IO ()
writeStrings h strs = do
  mapM_ (writeString' h) strs
  hFlush h

writeString' :: Handle -> String -> IO ()
writeString' h str = do
  hPutStr h $ foldr (\c cs ->
    if c == '\0' || c == '\255' then '\255' : c : cs else c : cs) [] str
  hPutChar h '\0'

ok :: Handle -> IO Bool
ok h = ('\0' ==) <$> hGetChar h

untilM :: IO Bool -> IO a -> IO [a]
untilM test = whileM (not <$> test)

whileM :: IO Bool -> IO a -> IO [a]
whileM test body = test >>= \succeeds -> if succeeds
    then (:) <$> body <*> whileM test body
    else return []

infixl 4 <$$>
(<$$>) :: Functor f => f a -> (a -> b) -> f b
(<$$>) = flip fmap