Protocol.hs

{-# LANGUAGE FlexibleInstances #-}

module Pianola.Protocol (
        ServerError (..),
        ProtocolF,
        Protocol (..),
        call
    ) where

import Prelude hiding (catch,(.),id)
import Data.MessagePack
import Data.Attoparsec.ByteString
import qualified Data.Iteratee as I
import qualified Data.Text as T
import qualified Data.ByteString as B 
import qualified Data.ByteString.Lazy as BL
import Data.Functor.Identity
import Data.Functor.Compose
import Control.Category
import Control.Applicative
import Control.Error
import Control.Monad.Trans
import Control.Monad.Free

-- | A 'Functor' which models a RPC call as a pair in which the first component
-- is a list of bytestrings (the arguments of the call) and the second is a
-- pure 'Iteratee' that consumes the bytes sent from the server and returns the
-- response of the call.
type ProtocolF = Compose ((,) [BL.ByteString]) (I.Iteratee B.ByteString Identity) 

-- | A monad to represent interactions with a remote server. A free monad over
-- a RPC call functor, augmented with some error conditions.
type Protocol = EitherT ServerError (Free ProtocolF)

-- | Constructs a RPC call from a packed list of arguments and a pure
-- 'Iteratee' to consume the response.
call :: [BL.ByteString] -> (I.Iteratee B.ByteString Identity x) -> Protocol x
call bs i = lift . liftF $ Compose (bs,i)

data ServerError = 
                   -- | Client targeted obsolete snapshot. 
                   SnapshotError Int Int
                   -- | Server couldn't perform the requested operation.
                 | ServerError T.Text
                 deriving Show

instance Unpackable (ServerError) where
    get = do
        tag <- get::Parser Int
        case tag of
            1 -> SnapshotError <$> get <*> get 
            2 -> ServerError <$> get