Deadpan-DDP 0.6.0.0 → 0.6.0.1
raw patch · 5 files changed
+55/−49 lines, 5 filesdep +hashabledep +randomdep −uuid
Dependencies added: hashable, random
Dependencies removed: uuid
Files
- Deadpan-DDP.cabal +5/−5
- changelog.md +1/−0
- src/Data/EJson.hs +17/−11
- src/Web/DDP/Deadpan/Callbacks.hs +30/−27
- src/Web/DDP/Deadpan/DSL.hs +2/−6
Deadpan-DDP.cabal view
@@ -1,5 +1,5 @@ name: Deadpan-DDP-version: 0.6.0.0+version: 0.6.0.1 synopsis: Write clients for Meteor's DDP Protocol description: The Deadpan-DDP project includes a debugging-tool, as well as a general purpose library. .@@ -48,24 +48,24 @@ exposed-modules: Data.EJson, Data.EJson.EJson, Data.EJson.Aeson, Web.DDP.Deadpan, Web.DDP.Deadpan.Callbacks, Web.DDP.Deadpan.Comms, Web.DDP.Deadpan.DSL, Web.DDP.Deadpan.Websockets- build-depends: base >= 4 && < 5, websockets, network, uuid,+ build-depends: base >= 4 && < 5, websockets, network, text, unordered-containers, base64-bytestring, aeson, scientific, bytestring, vector, lens, network-uri, safe, mtl,- containers, stm, transformers, time >= 1.4+ containers, stm, transformers, time >= 1.4, random, hashable hs-source-dirs: src default-language: Haskell2010 executable deadpan main-is: Main.hs- build-depends: base >= 4 && < 5, websockets, network, uuid,+ build-depends: base >= 4 && < 5, websockets, network, text, unordered-containers, base64-bytestring, aeson, scientific, bytestring, vector, lens, network-uri, safe, mtl, containers, stm, transformers, time >= 1.4,- haskeline >= 0.7+ haskeline >= 0.7, random, hashable hs-source-dirs: src default-language: Haskell2010
changelog.md view
@@ -5,6 +5,7 @@ * Subscription capabilities have begun to be added * Add Data * Remove Data+* Modify Data (Simplistic) * Wait on subscription ## 0.4.1.0
src/Data/EJson.hs view
@@ -132,7 +132,7 @@ putInPath (h:t) payload target@(EJObject _) = let l = _EJObjectKey h in case target ^. l- of Nothing -> Right $ set l (Just (expandPayload t payload)) target+ of Nothing -> Right $ set l (Just (expand t payload)) target Just v -> do r <- putInPath t payload v Right $ set l (Just r) target @@ -173,7 +173,7 @@ -- modifyInPath :: [Text] -> EJsonValue -> EJsonValue -> Either String EJsonValue modifyInPath path modifications target =- case (Just target & pathToPrism path <<%~ fmap (simpleMerge modifications))+ case Just target & pathToTraversal' path <<%~ fmap (simpleMerge modifications) of (Just _, Just r) -> Right r _ -> Left (concat ["Path ", show path, " not present in object ", show target]) @@ -218,15 +218,19 @@ -- Left "Path [\"a\",\"q\",\"r\"] not present in object {\"x\":\"y\"}" -- removeFromPath :: [Text] -> EJsonValue -> Either String EJsonValue-removeFromPath path target = case (Just target & pathToPrism path <<.~ Nothing)+removeFromPath path target = case (Just target & pathToTraversal' path <<.~ Nothing) of (Just _, Just r) -> Right r _ -> Left (concat ["Path ", show path, " not present in object ", show target]) -pathToPrism :: [Text] -> Traversal' (Maybe EJsonValue) (Maybe EJsonValue)-pathToPrism path = foldl (.) id (map textToPrism path)--textToPrism :: Text -> Traversal' (Maybe EJsonValue) (Maybe EJsonValue)-textToPrism x = _Just . _EJObject . at x+-- | Constructs a Traversal' along a path of EJObject keys.+--+-- Both ends of the traversal are maybes in order to allow self-composition,+-- and to allow the insertion/deletion of values at a point in the path.+--+pathToTraversal' :: [Text] -> Traversal' (Maybe EJsonValue) (Maybe EJsonValue)+pathToTraversal' path = foldl (.) id (map pathSegmentToTraversal' path)+ where+ pathSegmentToTraversal' x = _Just . _EJObject . at x -- | A variatnt of removeFromPath that leaves the EJsonValue unchanged if the update is not sensible --@@ -243,9 +247,11 @@ removeFromPath' :: [Text] -> EJsonValue -> EJsonValue removeFromPath' p v = either (const v) id (removeFromPath p v) --expandPayload :: [Text] -> EJsonValue -> EJsonValue-expandPayload path payload = foldr ($) payload (map f path) where f x y = ejobject [(x,y)]+-- | Takes a path and an EJsonValue and wraps the EJsonValue in+-- successive EJObjects for each item in the path.+--+expand :: [Text] -> EJsonValue -> EJsonValue+expand path payload = foldr f payload path where f x y = ejobject [(x,y)] -- | Construct a simple message object with no data. --
src/Web/DDP/Deadpan/Callbacks.hs view
@@ -140,38 +140,41 @@ -- Server Data Subscriptions -serverDataNosub :: Callback-serverDataNosub = undefined--serverDataAdded :: Callback-serverDataAdded = undefined--serverDataChanged :: Callback-serverDataChanged = undefined--serverDataRemoved :: Callback-serverDataRemoved = undefined--serverDataReady :: Callback-serverDataReady = undefined--serverDataAddedBefore :: Callback-serverDataAddedBefore = undefined--serverDataMovedBefore :: Callback-serverDataMovedBefore = undefined+-- 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 -serverRPCResult :: Callback-serverRPCResult = undefined--serverRPCUpdated :: Callback-serverRPCUpdated = undefined+-- TODO+-- serverRPCResult :: Callback+-- serverRPCResult = undefined+-- TODO+-- serverRPCUpdated :: Callback+-- serverRPCUpdated = undefined -- Server Errors -serverError :: Callback-serverError = undefined+-- TODO+-- serverError :: Callback+-- serverError = undefined
src/Web/DDP/Deadpan/DSL.hs view
@@ -66,12 +66,11 @@ import Control.Lens import Data.Monoid import Data.Text hiding (reverse, map)-import Data.UUID.V4 (nextRandom)-import Data.UUID (toString) -- Internal Imports import Web.DDP.Deadpan.Comms+import Web.DDP.Deadpan.GUID import Data.EJson @@ -140,10 +139,7 @@ -- IDs -- newID :: DeadpanApp Text-newID = do guid <- liftIO nextRandom- let str = toString guid- text = pack str- return text+newID = liftIO newGuidText -- Handlers