orchestrate 0.2.0.2 → 0.2.0.3

raw patch · 13 files changed

+628/−30 lines, 13 filesdep ~QuickCheckdep ~aesondep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck, aeson, bytestring, case-insensitive, data-default, either, errors, hspec, http-client, http-types, lens, mtl, smallcheck, text, transformers, unordered-containers, wreq

API changes (from Hackage documentation)

Files

• orchestrate.cabal +33/−25
• specs/Specs/Orchestrate/EventSpec.hs +128/−0
• specs/Specs/Orchestrate/GraphSpec.hs +63/−0
• specs/Specs/Orchestrate/KeyValueSpec.hs +64/−0
• specs/Specs/Orchestrate/RefSpec.hs +84/−0
• specs/Specs/Orchestrate/SearchSpec.hs +98/−0
• specs/Specs/Orchestrate/Spec/Types.hs +61/−0
• specs/Specs/Orchestrate/Spec/Utils.hs +29/−0
• specs/Specs/Orchestrate/UtilsSpec.hs +60/−0
• src/Database/Orchestrate/Graph.hs +2/−1
• src/Database/Orchestrate/Network.hs +2/−0
• src/Database/Orchestrate/Types.hs +3/−3
• src/Database/Orchestrate/Utils.hs +1/−1

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                orchestrate-version:             0.2.0.2+version:             0.2.0.3 synopsis:            An API client for http://orchestrate.io/. -- description:          license:             Apache-2.0@@ -34,21 +34,21 @@                      , Database.Orchestrate.Utils   -- other-modules:          -- other-extensions:    -  build-depends:       base >=4.7 && <5-                     , text-                     , wreq-                     , http-client-                     , http-types-                     , aeson-                     , unordered-containers-                     , errors < 2.0-                     , either-                     , mtl-                     , lens-                     , data-default-                     , bytestring-                     , case-insensitive-                     , transformers+  build-depends:       base                 >=4.7 && <5+                     , text                 >=1.2 && <1.3+                     , wreq                 >=0.4 && <0.5+                     , http-client          >=0.4 && <0.5+                     , http-types           >=0.8 && <0.9+                     , aeson                >=0.8 && <0.9+                     , unordered-containers >=0.2 && <0.3+                     , errors               >=2.0 && <2.1+                     , either               >=4.4 && <4.5+                     , mtl                  >=2.2 && <2.3+                     , lens                 >=4.12 && <4.13+                     , data-default         >=0.5 && <0.6+                     , bytestring           >=0.10 && <0.11+                     , case-insensitive     >=1.2 && <1.3+                     , transformers         >=0.4 && <0.5   -- hs-source-dirs:         default-language:    Haskell2010 @@ -57,17 +57,25 @@   ghc-options:         -threaded -rtsopts   hs-source-dirs:      specs   main-is:             Specs.hs+  other-modules:         Specs.Orchestrate.EventSpec+                       , Specs.Orchestrate.GraphSpec+                       , Specs.Orchestrate.KeyValueSpec+                       , Specs.Orchestrate.RefSpec+                       , Specs.Orchestrate.SearchSpec+                       , Specs.Orchestrate.Spec.Types+                       , Specs.Orchestrate.Spec.Utils+                       , Specs.Orchestrate.UtilsSpec   build-depends:         base                        , orchestrate-                       , QuickCheck-                       , smallcheck-                       , hspec-                       , lens-                       , text-                       , aeson-                       , bytestring-                       , wreq-                       , errors < 2.0+                       , QuickCheck >=2.8 && <2.9+                       , smallcheck >=1.1 && <1.2+                       , hspec      >=2.1 && <2.2+                       , lens       >=4.12 && <4.13+                       , text       >=1.2 && <1.3+                       , aeson      >=0.8 && <0.9+                       , bytestring >=0.10 && <0.11+                       , wreq       >=0.4 && <0.5+                       , errors     >=2.0 && <2.1   default-language:    Haskell2010   if flag(network-specs)     cpp-options: -DNETWORK_SPECS

@@ -0,0 +1,128 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE NamedFieldPuns    #-}+{-# LANGUAGE OverloadedStrings #-}+++module Specs.Orchestrate.EventSpec where+++import           Control.Applicative+import           Control.Error+import           Control.Exception+import           Control.Lens+import           Control.Monad+import qualified Data.Text                     as T+import           Network.Wreq++import           Test.Hspec++import           Database.Orchestrate.Events+import           Database.Orchestrate.KeyValue+import           Database.Orchestrate.Types+import           Database.Orchestrate.Utils++import           Specs.Orchestrate.Spec.Types+import           Specs.Orchestrate.Spec.Utils+++type GetEvent = IO (Either SomeException (Maybe (EventItem Event Person)))++fixtures :: [Person]+fixtures = [ Person "joe" 42+           , Person "ella" 13+           ]++events :: [(Event, Timestamp)]+events = [ (Event "birth"    0.0, 784111777000)+         , (Event "marriage" 0.5, 784111777100)+         , (Event "child"    0.6, 784111777200)+         , (Event "divorce"  0.8, 784111777300)+         , (Event "death"    1.0, 784111777400)+         ]++deleteLocs :: [Location] -> IO ()+deleteLocs locs = do+    Session{_sessionOptions,_sessionURL} <- envSession+    let url = T.unpack _sessionURL+    mapM_ (deleteWith _sessionOptions . (++ "?purge=true") . (url ++) . T.unpack) locs++withEvents :: Person -> EventType -> [(Event, Timestamp)] -> IO () -> IO ()+withEvents p et evs = withEvents' p et evs . const++withEvents' :: Person -> EventType -> [(Event, Timestamp)]+            -> (Either SomeException [Location] -> IO ())+            -> IO ()+withEvents' p et evs action =+    bracket (run . mapM (uncurry (createEvent p et)) $ map (fmap Just) evs)+            (either (const $ return ()) deleteLocs)+            action++callLoc :: Location -> (Timestamp -> Int -> OrchestrateIO a)+        -> IO (Either SomeException a)+callLoc loc f = run . join $ f <$> eithererr loc (loc ^? locationTimestamp)+                               <*> eithererr loc (loc ^? locationOrdinal)++eithererr :: Monad m => Location -> Maybe a -> OrchestrateT m a+eithererr loc = orchestrateEither+              . note (SomeException+                        (ErrorCall $ "Invalid location: " ++ T.unpack loc))++#if NETWORK_SPECS+spec :: Spec+spec = describe "Database.Orchestrate.Events" $ around_ (withFixtures fixtures) $ do+    describe "createEvent" $+        it "should create events." $+            withEvents' (fixtures !! 1) "create" events $ \locs -> do+                length (locs ^.. _Right . traverse) `shouldBe` 5+                locs ^.. _Right . traverse . locationKey  `shouldBe` replicate 5 "ella"+                locs ^.. _Right . traverse . locationType `shouldBe` replicate 5 "create"+                length (locs ^.. _Right . traverse . locationTimestamp) `shouldBe` 5+                length (locs ^.. _Right . traverse . locationOrdinal)   `shouldBe` 5++    describe "getEvent" $+        it "should retrieve the stored data for an event." $+            let p = head fixtures+            in  withEvents' p "get" events $ \(Right locs) -> do+                let events' = map fst events+                    items   = zip events'+                            $ zipWith locationEventItem locs events'+                forM_ items $ \(event, Just evtItem) -> do+                    e <- run $ getEvent p "get" (evtItem ^. eventTime) (evtItem ^. eventOrd)+                    e ^? _Right . _Just . eventItem . itemValue `shouldBe` Just event++    describe "updateEvent" $+        it "should update the data in the event." $+            let ev@(e, _) = head events+                p         = fixtures !! 1+            in  withEvents' p "life" [ev] $ \(Right [loc]) -> do+                let e' = e & eventScale .~ 3.1415+                r <- callLoc loc $ \t o -> updateEvent p "life" e' t o Nothing+                r `shouldSatisfy` isRight+                mNewE <- callLoc loc $ getEvent p "life"+                mNewE ^? _Right . _Just . eventItem . itemValue . eventScale+                    `shouldBe` Just 3.1415++    describe "deleteEvent" $+        it "should remove the event" $ do+            let (e, ts) = head events+                p       = fixtures !! 1+            Right loc <- run $ createEvent p "test" e (Just ts)+            r <- callLoc loc $ \t o -> deleteEvent p "test" t o Nothing+            r `shouldSatisfy` isRight+            Right e' <- (run $   eithererr loc (loc ^? locationOrdinal)+                             >>= getEvent p "test" ts) :: GetEvent+            e' `shouldSatisfy` isNothing++    describe "listEvents" $ around_ (withEvents (head fixtures) "list" events) $ do+        it "should return all events" $ do+            elist <- run $ listEvents (head fixtures) "list" Nothing (Open, Open)+            elist ^? _Right . resultCount `shouldBe` Just (length events)+            elist ^.. _Right . resultList . traverse . eventItem . itemValue . eventTitle+                `shouldMatchList` ["birth", "marriage", "child", "divorce", "death"]++#else+spec :: Spec+spec = describe "Database.Orchestrate.Events" $+    it "should contain tests." $+        pendingWith "configure with \"--enable-tests -fnetwork-specs\"."+#endif

@@ -0,0 +1,63 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+++module Specs.Orchestrate.GraphSpec where+++import           Control.Error+import           Control.Exception+import           Control.Lens+import           Control.Monad++import           Test.Hspec++import           Database.Orchestrate.Graph+import           Database.Orchestrate.KeyValue+import           Database.Orchestrate.Types+import           Database.Orchestrate.Utils++import           Specs.Orchestrate.Spec.Types+import           Specs.Orchestrate.Spec.Utils+++-- Names for 2014 tropical cyclones (from NOAA).+fixtures :: [Person]+fixtures = [ Person "Bertha"    1    -- 0+           , Person "Fay"       9    -- 1+           , Person "Laura"     8    -- 2+           , Person "Rene"      2    -- 3+           ]+++#if NETWORK_SPECS+spec :: Spec+spec = describe "Database.Orchestrate.Graph" $ around_ (withFixtures fixtures) $ do+    describe "createRel and getRel" $+        it "should create relationships that getRel can retrieve." $ do+            let bertha = fixtures !! 0+                rene   = fixtures !! 3++            r' <- run $ createRel bertha "brother" rene+            r' `shouldSatisfy` isRight++            r <- run $ getRel bertha "brother" []+            r ^? _Right . resultCount `shouldBe` Just 1+            r ^.. _Right . resultList . traverse . itemValue . personName+                `shouldBe` ["Rene"]++    describe "deleteRel" $+        it "should have tests" $ do+            let fay   = fixtures !! 1+                laura = fixtures !! 2+            void . run' $ createRel fay "sister" laura+            void . run' $ deleteRel fay "sister" laura+            r <- (run $ getRel fay "sister" []) :: IO (Either SomeException (RelList Person Person))+            r ^? _Right . resultCount `shouldBe` Just 0++#else+spec :: Spec+spec = describe "Database.Orchestrate.Graph" $+    it "should contain tests." $+        pendingWith "configure with \"--enable-tests -fnetwork-specs\"."+#endif

@@ -0,0 +1,64 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+++module Specs.Orchestrate.KeyValueSpec where+++import           Control.Lens                  hiding ((.=))+import           Data.Either+import qualified Data.List                     as L++import           Test.Hspec++import           Database.Orchestrate.KeyValue+import           Database.Orchestrate.Types++import           Specs.Orchestrate.Spec.Types+import           Specs.Orchestrate.Spec.Utils+++#if NETWORK_SPECS+spec :: Spec+spec = describe "Database.Orchestrate.KeyValue" $ do+    describe "getV" $+        it "should return Nothing if the key isn't there." $ do+            r <- getPerson "name"+            r `shouldSatisfy` isn't (_Right . _Just)+    describe "putV" $+        it "should insert a value into the database." $ do+            r <- run $ putV (Person "eric" 44) NoMatch+            r `shouldSatisfy` isRight+            r' <- getPerson "eric"+            r' ^? _Right . _Just `shouldBe` Just (Person "eric" 44)+    describe "postV" $+        it "should insert a value and get back a key." $ do+            let elsa = Person "elsa" 10+            Right (_, Just k) <- run (postV elsa)+            e <- getPerson k+            e ^? _Right . _Just `shouldBe` Just (Person "elsa" 10)+            run' $ purgeKV k (Person "elsa" undefined) Nothing+    describe "deleteV" $+        it "should remove a value from the database." $ do+            r <- run $ deleteV (Person "eric" undefined) Nothing+            r `shouldSatisfy` isRight+            r' <- getPerson "eric"+            r' `shouldSatisfy` isn't (_Right . _Just)+    describe "listVals" $+        it "should retrieve values from the database." $ do+            let names = ["abbie", "bob", "carol"]+            r <- run . mapM_ ((`putV` NoMatch) . uncurry Person) $ zip names [1..]+            r `shouldSatisfy` isRight+            r' <- run $ listVals "test-coll" Nothing (Open, Open)+            r' `shouldSatisfy` isRight+            let Right kvl = r'+            _resultCount kvl `shouldBe` 3+            L.sort (map (name . _itemValue) (_resultList kvl)) `shouldBe` names+            run' $ mapM_ ((`purgeV` Nothing) . (`Person` undefined)) names++#else+spec :: Spec+spec = describe "Database.Orchestrate.KeyValue" $ do+    it "should contain tests." $+        pendingWith "configure with \"--enable-tests -fnetwork-specs\"."+#endif

@@ -0,0 +1,84 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+++module Specs.Orchestrate.RefSpec where+++import           Control.Applicative+import           Control.Exception             (SomeException, bracket_)+import           Control.Lens+import           Data.Aeson+import qualified Data.ByteString.Lazy          as BS+import           Data.Either+import           Data.Maybe++import           Test.Hspec++import           Database.Orchestrate.KeyValue+import           Database.Orchestrate.Ref+import           Database.Orchestrate.Types+import           Database.Orchestrate.Utils++import           Specs.Orchestrate.Spec.Types+import           Specs.Orchestrate.Spec.Utils++runRefList :: OrchestrateIO (ResultList (TombstoneItem Person))+           -> IO (Either SomeException (ResultList (TombstoneItem Person)))+runRefList = run++cats :: [Person]+cats = map (uncurry Person) . (`zip` [1..]) . take 7 $ repeat "elsa"++withCats :: IO () -> IO ()+withCats = withFixtures cats++#if NETWORK_SPECS+spec :: Spec+spec = describe "Database.Orchestrate.Ref" $ do+    describe "getRef" $+        it "can return old version of objects." $ do+            r <- run $ putV (Person "eric" 42) NoMatch+            let ref = r ^? _Right . locationRef+            ref `shouldSatisfy` isn't _Nothing++            run' $ putV (Person "eric" 44) NoMatch+            eric <- run . getRef "test-coll" "eric" $ fromJust ref+            eric ^? _Right . _Just . personAge `shouldBe` Just 42++            run' $ purgeV (Person "eric" undefined) Nothing++    describe "decoding ResultList (TombstoneItem Person)." $ do+        it "should work." $ do+            r <- (eitherDecode <$> BS.readFile "specs/data.json") :: IO (Either String (ResultList (TombstoneItem Person)))+            r `shouldSatisfy` isRight++    describe "listRefs" $ around_ withCats $ do+        it "returns a list of references for an object." $ do+            refs <- runRefList $ listRefs "test-coll" "elsa" Nothing Nothing False+            refs ^? _Right . resultCount `shouldBe` Just 7+        it "returns a list of empty live values." $ do+            refs <- runRefList $ listRefs "test-coll" "elsa" Nothing Nothing False+            length (refs ^.. _Right . resultList . traverse . _LiveItem . liveValue . _Nothing)+                `shouldBe` 7+        it "returns a list of values if requested." $ do+            refs <- runRefList $ listRefs "test-coll" "elsa" Nothing Nothing True+            length (refs ^.. _Right . resultList . traverse . _LiveItem . liveValue . _Just)+                `shouldBe` 7+        it "limits the number of items requested." $ do+            refs <- runRefList $ listRefs "test-coll" "elsa" (Just 3) Nothing True+            refs ^.. _Right . resultList . to length `shouldBe` [3]+            refs ^.. _Right . resultList . traverse . _LiveItem . liveValue . _Just . personAge+                `shouldBe` [7, 6, 5]+        it "offsets the items returned." $ do+            refs <- runRefList $ listRefs "test-coll" "elsa" (Just 3) (Just 2) True+            refs ^.. _Right . resultList . to length `shouldBe` [3]+            refs ^.. _Right . resultList . traverse . _LiveItem . liveValue . _Just . personAge+                `shouldBe` [5, 4, 3]++#else+spec :: Spec+spec = describe "Database.Orchestrate.Ref" $ do+    it "should contain tests." $+        pendingWith "configure with \"--enable-tests -fnetwork-specs\"."+#endif

@@ -0,0 +1,98 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}+++module Specs.Orchestrate.SearchSpec where+++import           Control.Exception             (SomeException, bracket_)+import           Control.Lens+import qualified Data.List                     as L+import           Data.Monoid+import qualified Data.Text                     as T++import           Test.Hspec++import           Database.Orchestrate.KeyValue+import           Database.Orchestrate.Search+import           Database.Orchestrate.Types++import           Specs.Orchestrate.Spec.Types+import           Specs.Orchestrate.Spec.Utils+++-- From http://www.empireonline.com/features/30-star-wars-characters+fixtures :: [Person]+fixtures = map (uncurry Person)+         $ (`zip` [(1::Int)..])+         [ "Han Solo"+         , "Darth Vader"+         , "Boba Fett"+         , "R2-D2"+         , "Chewbacca"+         , "Yoda"+         , "Luke Skywalker"+         , "Darth Maul"+         , "Stormtrooper"+         , "Princess Leia"+         , "Jabba the Hut"+         , "Ben Kenobi"+         , "Darth Sidious"+         , "Jawa"+         , "Lando Calrissian"+         , "Anakin Skywalker"+         , "Scout Trooper"+         , "Tuskan Raiders"+         , "Greedo"+         , "Tie Fighter Pilot"+         , "Obi-Wan Kenobi"+         , "Imperial Guards"+         , "Qui-Gin Jinn"+         , "C-3PO"+         , "Gamorrean Guards"+         , "Padme Amidala"+         , "Admiral Ackbar"+         , "Count Dooku"+         , "Mace Windu"+         , "Wicket"+         ]++runSearch :: OrchestrateIO (SearchList Person)+          -> IO (Either SomeException (SearchList Person))+runSearch = run++allNames :: forall c. (T.Text -> Const (Endo [T.Text]) T.Text)+         -> Either c (SearchList Person)+         -> Const (Endo [T.Text]) (Either c (SearchList Person))+allNames = _Right . searchResults . resultList . traverse . searchItem . itemValue . personName++#if NETWORK_SPECS+spec :: Spec+spec = describe "Database.Orchestrate.Search" $ around_ (withFixtures fixtures) $+    describe "query" $ do+        it "should search for all fields." $ do+            s <- runSearch $ query "test-coll" "darth" Nothing Nothing+            s ^?  _Right . searchTotal `shouldBe` Just 3+            L.sort (s ^.. allNames)+                `shouldBe` ["Darth Maul", "Darth Sidious", "Darth Vader"]+        it "should search in a specific field." $ do+            s <- runSearch $ query "test-coll" "name=guards" Nothing Nothing+            s ^?  _Right . searchTotal `shouldBe` Just 2+            L.sort (s ^.. allNames)+                `shouldBe` ["Gamorrean Guards", "Imperial Guards"]+        it "should limit the number of results returned." $ do+            s <- runSearch $ query "test-coll" "darth" (Just 1) Nothing+            s ^?  _Right . searchTotal `shouldBe` Just 3+            s ^?  _Right . searchResults . resultCount `shouldBe` Just 1+        it "should offset the results returned." $ do+            s <- runSearch $ query "test-coll" "darth" Nothing (Just 2)+            s ^?  _Right . searchTotal `shouldBe` Just 3+            s ^?  _Right . searchResults . resultCount `shouldBe` Just 1++#else+spec :: Spec+spec = describe "Database.Orchestrate.Search" $+    it "should contain tests." $+        pendingWith "configure with \"--enable-tests -fnetwork-specs\"."+#endif

@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}+++module Specs.Orchestrate.Spec.Types where+++import           Control.Applicative+import           Control.Monad+import           Data.Aeson+import qualified Data.Text                  as T++import           Database.Orchestrate.Types+++data Person = Person+            { name :: T.Text+            , age  :: Int+            } deriving (Eq, Show)++instance FromJSON Person where+    parseJSON (Object o) =   Person+                         <$> o .: "name"+                         <*> o .: "age"+    parseJSON _          = mzero++instance ToJSON Person where+    toJSON (Person n a) = object [ "name" .= n+                                 , "age"  .= a+                                 ]++instance OrchestrateData Person where+    tableName _          = "test-coll"+    dataKey (Person n _) = n++personName :: Functor f => (T.Text -> f T.Text) -> Person -> f Person+personName f (Person n a) = fmap (`Person` a) (f n)++personAge :: Functor f => (Int -> f Int) -> Person -> f Person+personAge f (Person n a) = fmap (Person n) (f a)++data Event = Event+           { title :: T.Text+           , scale :: Double+           } deriving (Eq, Show)++instance FromJSON Event where+    parseJSON (Object o) =   Event+                         <$> o .: "title"+                         <*> o .: "scale"+    parseJSON _          = mzero++instance ToJSON Event where+    toJSON (Event t s) = object [ "title" .= t+                                , "scale" .= s+                                ]++eventTitle :: Functor f => (T.Text -> f T.Text) -> Event -> f Event+eventTitle f (Event t s) = fmap (`Event` s) (f t)++eventScale :: Functor f => (Double -> f Double) -> Event -> f Event+eventScale f (Event t s) = fmap (Event t) (f s)

@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}+++module Specs.Orchestrate.Spec.Utils where+++import qualified Control.Exception             as Ex+import           Prelude                       hiding (lookup)++import           Database.Orchestrate.KeyValue (lookup, purgeV, putV)+import           Database.Orchestrate.Types+import           Database.Orchestrate.Utils++import           Specs.Orchestrate.Spec.Types+++run :: OrchestrateIO m -> IO (Either Ex.SomeException m)+run m = envSession >>= runO' m++run' :: OrchestrateIO m -> IO ()+run' m = envSession >>= runO' m >> return ()++getPerson :: Key -> IO (Either Ex.SomeException (Maybe Person))+getPerson = run . lookup "test-coll"++withFixtures :: OrchestrateData a => [a] -> IO () -> IO ()+withFixtures fixtures =+    Ex.bracket_ (run' $ mapM_ (`putV` NoMatch) fixtures)+                (run' $ mapM_ (`purgeV` Nothing) fixtures)

@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+++module Specs.Orchestrate.UtilsSpec where+++import           Control.Lens++import           Test.Hspec++import           Database.Orchestrate.Utils+++spec :: Spec+spec = describe "Database.Orchestrate.Utils" $ do+    describe "locationCollection" $ do+        it "should extract the collection from a location URL." $ do+            shouldBe ("/v0/collection/035ab997adffe604/refs/82eafab14dc84ed3" ^? locationCollection)+                     (Just "collection")+            shouldBe ("/v0/collection/key/events/type/1398286518286/6" ^? locationCollection)+                     (Just "collection")+        it "should return Nothing if the URL is invalid." $ do+            "/v0" ^? locationCollection `shouldBe` Nothing++    describe "locationKey" $ do+        it "should extract the key from a location URL." $ do+            shouldBe ("/v0/collection/035ab997adffe604/refs/82eafab14dc84ed3" ^? locationKey)+                     (Just "035ab997adffe604")+            shouldBe ("/v0/collection/key/events/type/1398286518286/6" ^? locationKey)+                     (Just "key")+        it "should return Nothing if the URL is too short." $ do+            "/v0/collection" ^? locationKey `shouldBe` Nothing++    describe "locationRef" $ do+        it "should extract the ref from a location URL." $ do+            shouldBe ("/v0/collection/035ab997adffe604/refs/82eafab14dc84ed3" ^? locationRef)+                     (Just "82eafab14dc84ed3")+        it "should return Nothing if the URL is too short." $ do+            "/v0/collection" ^? locationRef `shouldBe` Nothing++    describe "locationType" $ do+        it "should extract the type of event from the location URL." $ do+            shouldBe ("/v0/collection/key/events/type/1398286518286/6" ^? locationType)+                     (Just "type")+        it "should return Nothing if the URL is too short." $ do+            "/v0/collection/key/events" ^? locationType `shouldBe` Nothing++    describe "locationTimestamp" $ do+        it "should extract the event timesteamp from the location URL." $ do+            shouldBe ("/v0/collection/key/events/type/1398286518286/6" ^? locationTimestamp)+                     (Just 1398286518286)+        it "should return Nothing if the URL is too short." $ do+            "/v0/collection/key/events" ^? locationTimestamp `shouldBe` Nothing++    describe "locationOrdinal" $ do+        it "should extract the event ordinal from the location URL." $ do+            shouldBe ("/v0/collection/key/events/type/1398286518286/6" ^? locationOrdinal)+                     (Just 6)+        it "should return Nothing if the URL is too short." $ do+            "/v0/collection/key/events" ^? locationOrdinal `shouldBe` Nothing

@@ -13,6 +13,7 @@  import           Control.Monad import           Data.Aeson+import qualified Data.HashMap.Strict        as M import qualified Data.Text                  as T import           Network.Wreq @@ -49,7 +50,7 @@           -> RelKind            -- ^ The label for the edge.           -> b                  -- ^ The target, destination node.           -> OrchestrateIO ()-createRel from rel to = void $ apiCheck [] url [] $ \o s -> putWith o s Null+createRel from rel to = void $ apiCheck [] url [] $ \o s -> putWith o s (Object M.empty)     where url = [ tableName from , dataKey from                 , "relation", rel                 , tableName to, dataKey to

@@ -29,6 +29,8 @@ -- else is bad. Bad codes throw an exception in 'OrchestrateT'. checkStatusCode :: Monad m => Int -> OrchestrateT m () checkStatusCode 200 = return ()+checkStatusCode 201 = return ()+checkStatusCode 202 = return () checkStatusCode 204 = return () checkStatusCode rc  = throwError                     . Ex.SomeException

@@ -196,7 +196,7 @@ -- 'Session' data with error handling using 'EitherT' 'Ex.SomeException'. newtype OrchestrateT m a     = OrchestrateT-    { runOrchestrate :: EitherT Ex.SomeException (ReaderT Session m) a }+    { runOrchestrate :: ExceptT Ex.SomeException (ReaderT Session m) a }     deriving (Functor, Applicative, Monad)  instance MonadTrans OrchestrateT where@@ -212,11 +212,11 @@ -- TODO: Need to define this for other monad classes.  instance Monad m => MonadError Ex.SomeException (OrchestrateT m) where-    throwError = OrchestrateT . EitherT . return . Left+    throwError = OrchestrateT . ExceptT . return . Left     catchError a handler =   join                          .   fmap (handler' handler)                          .   lift-                         .   runReaderT (runEitherT $ runOrchestrate a)+                         .   runReaderT (runExceptT $ runOrchestrate a)                          =<< ask  handler' :: Monad m

@@ -99,7 +99,7 @@ -- -- This is the most minimal handler. runO' :: Monad m => OrchestrateT m a -> Session -> m (Either Ex.SomeException a)-runO' m = runReaderT (runEitherT $ runOrchestrate m)+runO' m = runReaderT (runExceptT $ runOrchestrate m)  -- | Lifts an IO action into the 'OrchestrateT' monad. io :: MonadIO m => IO a -> OrchestrateT m a