diff --git a/Deadpan-DDP.cabal b/Deadpan-DDP.cabal --- a/Deadpan-DDP.cabal +++ b/Deadpan-DDP.cabal @@ -1,5 +1,5 @@ name: Deadpan-DDP -version: 0.8.0.0 +version: 0.9.0.0 synopsis: Write clients for Meteor's DDP Protocol description: The Deadpan-DDP project includes a debugging-tool, as well as a general purpose library. . diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Deadpan-DDP Change Log +## 0.9.0.0 + +* Fixed the exit error + ## 0.8.0.0 * Made GUID newtype abstract to prevent abuse diff --git a/src/Data/EJson.hs b/src/Data/EJson.hs --- a/src/Data/EJson.hs +++ b/src/Data/EJson.hs @@ -36,6 +36,10 @@ module Exports, + decodeText, + decodeString, + decodeByteString, + matches, getInPath, @@ -66,9 +70,22 @@ import Data.Monoid as Exports import Control.Lens as Exports import Control.Monad.State (execState) -import Data.Text (Text()) +import Data.Text (Text()) +import Data.Aeson (decode) +import Data.EJson.Aeson() import qualified Data.HashMap.Strict as HM +import qualified Data.ByteString.Lazy.Char8 as C8 +import qualified Data.Text as T + +decodeText :: Text -> Maybe EJsonValue +decodeText = decodeString . T.unpack + +decodeString :: String -> Maybe EJsonValue +decodeString = decode . C8.pack + +decodeByteString :: C8.ByteString -> Maybe EJsonValue +decodeByteString = decode -- $setup -- >>> :set -XOverloadedStrings diff --git a/src/Data/EJson/Aeson.hs b/src/Data/EJson/Aeson.hs --- a/src/Data/EJson/Aeson.hs +++ b/src/Data/EJson/Aeson.hs @@ -30,4 +30,4 @@ -- take advantage of the Aeson functionality. -- -- This is not used internally. -instance ToJSON EJsonValue where toJSON = ejson2value +instance ToJSON EJsonValue where toJSON = ejson2value diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -8,11 +8,8 @@ import System.Exit import Web.DDP.Deadpan import System.Environment -import Data.Aeson import Data.Maybe import Control.Concurrent.Chan -import Data.EJson.Aeson() -import qualified Data.ByteString.Lazy.Char8 as C8 import qualified System.Console.Haskeline as R main :: IO () @@ -53,7 +50,7 @@ sendPossibleMessage :: String -> DeadpanApp () sendPossibleMessage msgStr = do - let decoded = decode $ C8.pack msgStr + let decoded = decodeString msgStr case decoded of Just m -> sendData m Nothing -> liftIO $ putStrLn "Invalid Message" diff --git a/src/Web/DDP/Deadpan.hs b/src/Web/DDP/Deadpan.hs --- a/src/Web/DDP/Deadpan.hs +++ b/src/Web/DDP/Deadpan.hs @@ -53,12 +53,12 @@ -- Does not respond to ping! -- runConnectClient :: Params -> DeadpanApp a -> IO a -runConnectClient params app = runBareClient params (fetchMessages >> connect >> app) +runConnectClient params app = runBareClient params (fetchMessagesThenExit $ connect >> app) -- Same as runConnectClient above but allows specifying version -- runConnectClientVersion :: Params -> Version -> DeadpanApp a -> IO a -runConnectClientVersion params v app = runBareClient params (fetchMessages >> connectVersion v >> app) +runConnectClientVersion params v app = runBareClient params (fetchMessagesThenExit $ connectVersion v >> app) -- | Run a DeadpanApp after registering a ping handler, then establishing a server conncetion. -- diff --git a/src/Web/DDP/Deadpan/Callbacks.hs b/src/Web/DDP/Deadpan/Callbacks.hs --- a/src/Web/DDP/Deadpan/Callbacks.hs +++ b/src/Web/DDP/Deadpan/Callbacks.hs @@ -137,41 +137,6 @@ -- Server -->> Client --- Server Data Subscriptions - --- TODO --- serverDataNosub :: Callback --- serverDataNosub = undefined --- TODO --- serverDataAdded :: Callback --- serverDataAdded = undefined --- TODO --- serverDataChanged :: Callback --- serverDataChanged = undefined --- TODO --- serverDataRemoved :: Callback --- serverDataRemoved = undefined --- TODO --- serverDataReady :: Callback --- serverDataReady = undefined --- TODO --- serverDataAddedBefore :: Callback --- serverDataAddedBefore = undefined --- TODO --- serverDataMovedBefore :: Callback --- serverDataMovedBefore = undefined - - --- Server RPC - --- TODO --- serverRPCResult :: Callback --- serverRPCResult = undefined --- TODO --- serverRPCUpdated :: Callback --- serverRPCUpdated = undefined - - -- Server Errors -- TODO diff --git a/src/Web/DDP/Deadpan/DSL.hs b/src/Web/DDP/Deadpan/DSL.hs --- a/src/Web/DDP/Deadpan/DSL.hs +++ b/src/Web/DDP/Deadpan/DSL.hs @@ -222,17 +222,33 @@ , ("support", ejarray reverseVersions) ] -- | Provides a way to fork a background thread running the app provided +-- fork :: DeadpanApp a -> DeadpanApp ThreadId fork app = do st <- DeadpanApp ask liftIO $ forkIO $ void $ runDeadpan app st -fetchMessages :: DeadpanApp () -fetchMessages = void $ - fork $ - forever $ do message <- getServerMessage - as <- getAppState - respondToMessage (_callbackSet as) message +-- | Runs fetchMessages and kills the thread when the supplied app finishes. +-- +-- Note: Any DeadpanApp calls made after this one will not be able to +-- interact with server-sent messages. +-- +fetchMessagesThenExit :: DeadpanApp a -> DeadpanApp a +fetchMessagesThenExit app = do tid <- fetchMessages + result <- app + liftIO $ killThread tid + return result + +-- | Continuously pull down messages from the server in a background thread and +-- respond to each message with the callback set. +-- Returns a ThreadId so that this can be killed explicitly before the program +-- exits in order to avoid the "recv: invalid argument (Bad file descriptor)" +-- error. +-- +fetchMessages :: DeadpanApp ThreadId +fetchMessages = fork $ forever $ do message <- getServerMessage + as <- getAppState + respondToMessage (_callbackSet as) message getServerMessage :: DeadpanApp (Maybe EJsonValue) getServerMessage = getAppState >>= liftIO . getEJ . _connection