gitson 0.3.0 → 0.4.0

raw patch · 5 files changed

+173/−94 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +14/−9
• gitson.cabal +1/−1
• library/Gitson.hs +99/−51
• library/Gitson/Util.hs +15/−11
• test-suite/GitsonSpec.hs +44/−22

@@ -31,8 +31,8 @@   -- after the block is executed, just like in SQL databases   -- Also, transactions are thread-safe   transaction "./content" $ do-    -- order: (collection) (key        ) (data)-    saveEntry "things"     "first-thing" Thing {val = 1}+    -- order:    (collection) (key        ) (data)+    saveDocument "things"     "first-thing" Thing {val = 1}     -- Collections are created automatically, like in MongoDB     liftIO $ putStrLn "Written first-thing"     -- You have to use liftIO to do IO actions inside of a transaction!@@ -42,14 +42,14 @@   -- (These are normal IO actions, so if you want   --  to read inside of a transaction, liftIO.   --  Note: transaction already includes insideDirectory!-  --  Warning: you can't read what you're writing in a transaction!!!+  --  Warning: you can't read what you've written in the current transaction!!!   --  You can only read what's been written before the transaction began.)   insideDirectory "./content" $ do     colls <- listCollections           -- ["things"]-    keys <- listEntryKeys "things"+    keys <- listDocumentKeys "things"          -- ["first-thing"]-    first-thing <- readEntry "things" "first-thing" :: IO (Maybe Thing)+    first-thing <- readDocument "things" "first-thing" :: IO (Maybe Thing)          -- Just Thing {val = 1}     things <- readEntries "things" :: IO [Thing]            -- [Thing {val = 1}]@@ -57,18 +57,23 @@   -- Note: insideDirectory is just a function that changes   -- the current directory, executes an action and changes it back.   -- You can use reading actions without it, like this:-  keys <- listEntryKeys "./content/things"+  keys <- listDocumentKeys "./content/things"     -- And now, some bells and whistles:   -- Numeric id support   transaction "./content" $ do-    saveNextEntry "things" "hello-world" Thing {val = 1}+    saveNextDocument "things" "hello-world" Thing {val = 1}     -- will save to things/000001-hello-world.json   insideDirectory "./content" $ do-    thing <- readEntryById "things" 1-    same-thing <- readEntryByName "thing" "hello-world"+    thing <- readDocumentById "things" 1+    same-thing <- readDocumentByName "things" "hello-world"     -- both will read from things/000001-hello-world.json+    +    i <- documentIdFromName "things" "hello-world"+      -- 1+    n <- documentNameFromId "things" 1+      -- "hello-world" ```  ## Development

@@ -1,5 +1,5 @@ name:            gitson-version:         0.3.0+version:         0.4.0 synopsis:        A document store library for Git + JSON. description:     A simple document store library for Git + JSON, based on Aeson. Uses command line git, at least for now. No fancy indexes and stuff, but it does what I need right now. Transactions use flock, so it's safe even across completely separate programs! category:        Database, JSON, Git

@@ -1,20 +1,23 @@ -- | Gitson is a simple document store library for Git + JSON. module Gitson (-  TransactionWriter,-  createRepo,-  transaction,-  saveEntry,-  saveNextEntry,-  listCollections,-  listEntryKeys,-  listEntries,-  readEntry,-  readEntryById,-  readEntryByName+  TransactionWriter+, createRepo+, transaction+, saveDocument+, saveNextDocument+, listCollections+, listDocumentKeys+, listEntries+, readDocument+, readDocumentById+, readDocumentByName+, documentIdFromName+, documentNameFromId ) where  import           System.Directory import           System.Lock.FLock+import           Control.Applicative ((<$>)) import           Control.Exception (try, IOException) import           Control.Error.Util (hush) import           Control.Monad.Trans.Writer@@ -29,26 +32,30 @@ -- | A transaction monad. type TransactionWriter = WriterT [IO ()] IO () +type IdAndName = (Int, String)+type FileName = String+type Finder = ([(IdAndName, FileName)] -> Maybe (IdAndName, FileName))+ -- | Creates a git repository under a given path. createRepo :: FilePath -> IO () createRepo path = do   createDirectoryIfMissing True path-  insideDirectory path $ do-    shell "git" ["init"]-    writeFile lockPath ""+  insideDirectory path $ shell "git" ["init"]  -- | Executes a blocking transaction on a repository, committing the results to git. transaction :: FilePath -> TransactionWriter -> IO () transaction repoPath action = do-  insideDirectory repoPath $ withLock lockPath Exclusive Block $ do-    writeActions <- execWriterT action-    shell "git" ["stash"] -- it's totally ok to do this without changes-    sequence_ writeActions-    shell "git" ["add", "--all"]-    shell "git" ["commit", "-m", "Gitson transaction"]-    shell "git" ["stash", "pop"]+  insideDirectory repoPath $ do+    writeFile lockPath ""+    withLock lockPath Exclusive Block $ do+      writeActions <- execWriterT action+      shell "git" ["stash"] -- it's totally ok to do this without changes+      sequence_ writeActions+      shell "git" ["add", "--all"]+      shell "git" ["commit", "-m", "Gitson transaction"]+      shell "git" ["stash", "pop"] -combineKey :: (Int, String) -> String+combineKey :: IdAndName -> FileName combineKey (n, s) = zeroPad n ++ "-" ++ s   where zeroPad :: Int -> String         zeroPad x = printf "%06d" x@@ -56,23 +63,23 @@ prettyConfig :: Config prettyConfig = Config { confIndent = 2, confCompare = compare } -writeEntry :: ToJSON a => FilePath -> String -> a -> IO ()-writeEntry collection key content = BL.writeFile (entryPath collection key) (encodePretty' prettyConfig content)+writeDocument :: ToJSON a => FilePath -> FileName -> a -> IO ()+writeDocument collection key content = BL.writeFile (documentPath collection key) (encodePretty' prettyConfig content)  -- | Adds a write action to a transaction.-saveEntry :: ToJSON a => FilePath -> String -> a -> TransactionWriter-saveEntry collection key content = do+saveDocument :: ToJSON a => FilePath -> FileName -> a -> TransactionWriter+saveDocument collection key content = do   tell [createDirectoryIfMissing True collection,-        writeEntry collection key content]+        writeDocument collection key content]  -- | Adds a write action to a transaction. -- The key will start with a numeric id, incremented from the last id in the collection.-saveNextEntry :: ToJSON a => FilePath -> String -> a -> TransactionWriter-saveNextEntry collection key content = do+saveNextDocument :: ToJSON a => FilePath -> FileName -> a -> TransactionWriter+saveNextDocument collection key content = do   tell [createDirectoryIfMissing True collection,-        listEntryKeys collection >>=+        listDocumentKeys collection >>=         return . nextKeyId >>=-        \nextId -> writeEntry collection (combineKey (nextId, key)) content]+        \nextId -> writeDocument collection (combineKey (nextId, key)) content]  -- | Lists collections in the current repository. listCollections :: IO [FilePath]@@ -80,35 +87,76 @@   contents <- try (getDirectoryContents =<< getCurrentDirectory) :: IO (Either IOException [FilePath])   filterDirs $ fromMaybe [] $ hush contents --- | Lists entry keys in a collection.-listEntryKeys :: FilePath -> IO [String]-listEntryKeys collection = do+-- | Lists document keys in a collection.+listDocumentKeys :: FilePath -> IO [FileName]+listDocumentKeys collection = do   contents <- try (getDirectoryContents collection) :: IO (Either IOException [String])   return $ filterFilenamesAsKeys $ fromMaybe [] $ hush contents  -- | Lists entries in a collection. listEntries :: FromJSON a => FilePath -> IO [a] listEntries collection = do-  ks <- listEntryKeys collection-  maybes <- mapM (readEntry collection) ks+  ks <- listDocumentKeys collection+  maybes <- mapM (readDocument collection) ks   return $ fromMaybe [] $ sequence maybes --- | Reads an entry from a collection by key.-readEntry :: FromJSON a => FilePath -> String -> IO (Maybe a)-readEntry collection key = do-  jsonString <- try (BL.readFile $ entryPath collection key) :: IO (Either IOException BL.ByteString)+-- | Reads a document from a collection by key.+readDocument :: FromJSON a => FilePath -> FileName -> IO (Maybe a)+readDocument collection key = do+  jsonString <- try (BL.readFile $ documentPath collection key) :: IO (Either IOException BL.ByteString)   return $ decode =<< hush jsonString -splitFindAndReadEntry :: FromJSON a => FilePath -> ([((Int, String), String)] -> Maybe ((Int, String), String)) -> IO (Maybe a)-splitFindAndReadEntry collection finder = listEntryKeys collection >>=-  maybeReadEntry . finder . catMaybes . (map $ \x -> intoMaybe (maybeReadIntString x) x)-  where maybeReadEntry (Just x) = readEntry collection $ snd x-        maybeReadEntry Nothing = return Nothing+readDocument' :: FromJSON a => FilePath -> Maybe FileName -> IO (Maybe a)+readDocument' collection key = case key of+  Just key -> readDocument collection key+  Nothing -> return Nothing --- | Reads an entry from a collection by numeric id (for example, key "00001-hello" has id 1)..-readEntryById :: FromJSON a => FilePath -> Int -> IO (Maybe a)-readEntryById collection n = splitFindAndReadEntry collection $ find ((== n) . fst . fst)+splitFindDocument :: FilePath -> Finder -> IO (Maybe (IdAndName, FileName))+splitFindDocument collection finder = listDocumentKeys collection >>=+  return . finder . catMaybes . map (\x -> intoFunctor (maybeReadIntString x) x) --- | Reads an entry from a collection by name (for example, key "00001-hello" has name "hello").-readEntryByName :: FromJSON a => FilePath -> String -> IO (Maybe a)-readEntryByName collection n = splitFindAndReadEntry collection $ find ((isSuffixOf n) . snd . fst)+extractIdAndName :: Maybe (IdAndName, FileName) -> IO (Maybe IdAndName)+extractIdAndName m = case m of+                       Just (ian, _) -> return $ Just ian+                       _ -> return Nothing++extractFilename :: Maybe (IdAndName, FileName) -> IO (Maybe FileName)+extractFilename m = case m of+                     Just (_, fname) -> return $ Just fname+                     _ -> return Nothing++findById :: Int -> Finder+findById i = find $ (== i) . fst . fst++findByName :: String -> Finder+findByName n = find $ (isSuffixOf n) . snd . fst++-- | Reads a document from a collection by numeric id (for example, key "00001-hello" has id 1).+readDocumentById :: FromJSON a => FilePath -> Int -> IO (Maybe a)+readDocumentById collection i =+  splitFindDocument collection (findById i) >>=+  extractFilename >>=+  readDocument' collection++-- | Reads a document from a collection by name (for example, key "00001-hello" has name "hello").+readDocumentByName :: FromJSON a => FilePath -> String -> IO (Maybe a)+readDocumentByName collection n =+  splitFindDocument collection (findByName n) >>=+  extractFilename >>=+  readDocument' collection++-- | Returns a document's id by name (for example, "hello" will return 23 when key "00023-hello" exists).+-- Does not read the document!+documentIdFromName :: FilePath -> String -> IO (Maybe Int)+documentIdFromName collection n =+  splitFindDocument collection (findByName n) >>=+  extractIdAndName >>=+  return . (fst <$>)++-- | Returns a document's name by id (for example, 23 will return "hello" when key "00023-hello" exists).+-- Does not read the document!+documentNameFromId :: FilePath -> Int -> IO (Maybe String)+documentNameFromId collection i =+  splitFindDocument collection (findById i) >>=+  extractIdAndName >>=+  return . (drop 1 . snd <$>)

@@ -12,13 +12,13 @@  -- | Combines two paths and adds the .json extension. ----- >>> entryPath "things" "entry"--- "things/entry.json"+-- >>> documentPath "things" "document"+-- "things/document.json" ----- >>> entryPath "things/" "entry"--- "things/entry.json"-entryPath :: FilePath -> String -> FilePath-entryPath collection key = collection </> key <.> "json"+-- >>> documentPath "things/" "document"+-- "things/document.json"+documentPath :: FilePath -> String -> FilePath+documentPath collection key = collection </> key <.> "json"  -- | Path to the transaction lock file, relative to the repo root. lockPath :: FilePath@@ -56,11 +56,15 @@   (_, _, _, pid) <- createProcess (proc cmd args){std_in = UseHandle dnull, std_out = UseHandle dnull, std_err = UseHandle dnull}   waitForProcess pid --- I can't believe there's nothing like this in Data.Maybe--- | Adds a value to a Maybe.-intoMaybe :: Maybe a -> b -> Maybe (a, b)-intoMaybe (Just x) y = Just (x, y)-intoMaybe Nothing y = Nothing+-- | Appends a value to a functor, making the inside a tuple if it's a single value.+--+-- >>> intoFunctor (Just 1) 2+-- Just (1,2)+--+-- >>> intoFunctor Nothing 2+-- Nothing+intoFunctor :: Functor f => f a -> b -> f (a, b)+intoFunctor f x = fmap (flip (,) x) f  -- | Tries to extract the first int out of a string. --

@@ -18,11 +18,11 @@ spec :: Spec spec = before setup $ after cleanup $ do   context "transaction" $ do-    describe "saveEntry" $ do+    describe "saveDocument" $ do       it "saves entries only after it's done" $ do         transaction "tmp/repo" $ do-          saveEntry "things" "first-thing" Thing {val = 1}-          saveEntry "things" "second-thing" Thing {val = 2}+          saveDocument "things" "first-thing" Thing {val = 1}+          saveDocument "things" "second-thing" Thing {val = 2}           liftIO $ (readFile "things/first-thing.json") `shouldThrow` anyIOException           liftIO $ (readFile "things/second-thing.json") `shouldThrow` anyIOException         insideDirectory "tmp/repo" $ do@@ -33,60 +33,82 @@           commitMsg <- lastCommitText           commitMsg `shouldBe` "Gitson transaction" -    describe "saveNextEntry" $ do+    describe "saveNextDocument" $ do       it "saves entries with next numeric ids" $ do         transaction "tmp/repo" $ do-          saveNextEntry "things" "hello" Thing {val = 1}-          saveNextEntry "things" "world" Thing {val = 2}+          saveNextDocument "things" "hello" Thing {val = 1}+          saveNextDocument "things" "world" Thing {val = 2}         insideDirectory "tmp/repo" $ do           first <- readFile "things/000001-hello.json"           first `shouldBe` "{\n  \"val\": 1\n}"           second <- readFile "things/000002-world.json"           second `shouldBe` "{\n  \"val\": 2\n}" -  describe "readEntry" $ do-    it "returns Just the entry when reading an entry by key" $ do+  describe "readDocument" $ do+    it "returns Just the document when reading an document by key" $ do       createDirectoryIfMissing True "tmp/repo/things"       _ <- writeFile "tmp/repo/things/second-thing.json" "{\"val\":2}"-      content <- readEntry "tmp/repo/things" "second-thing" :: IO (Maybe Thing)+      content <- readDocument "tmp/repo/things" "second-thing" :: IO (Maybe Thing)       content `shouldBe` Just Thing {val = 2}      it "returns Nothing when reading by a nonexistent key" $ do-      content <- readEntry "tmp/repo/things" "totally-not-a-thing" :: IO (Maybe Thing)+      content <- readDocument "tmp/repo/things" "totally-not-a-thing" :: IO (Maybe Thing)       content `shouldBe` Nothing -  describe "readEntryById" $ do-    it "returns Just the entry when reading an entry by id" $ do+  describe "readDocumentById" $ do+    it "returns Just the document when reading an document by id" $ do       createDirectoryIfMissing True "tmp/repo/things"       _ <- writeFile "tmp/repo/things/000004-second-thing.json" "{\"val\":1}"-      content <- readEntryById "tmp/repo/things" 4 :: IO (Maybe Thing)+      content <- readDocumentById "tmp/repo/things" 4 :: IO (Maybe Thing)       content `shouldBe` Just Thing {val = 1}      it "returns Nothing when reading by a nonexistent id" $ do-      content <- readEntryById "tmp/repo/things" 1 :: IO (Maybe Thing)+      content <- readDocumentById "tmp/repo/things" 1 :: IO (Maybe Thing)       content `shouldBe` Nothing -  describe "readEntryByName" $ do-    it "returns Just the entry when reading an entry by name" $ do+  describe "readDocumentByName" $ do+    it "returns Just the document when reading an document by name" $ do       createDirectoryIfMissing True "tmp/repo/things"       _ <- writeFile "tmp/repo/things/000098-second-thing.json" "{\"val\":1}"-      content <- readEntryByName "tmp/repo/things" "second-thing" :: IO (Maybe Thing)+      content <- readDocumentByName "tmp/repo/things" "second-thing" :: IO (Maybe Thing)       content `shouldBe` Just Thing {val = 1}      it "returns Nothing when reading by a nonexistent name" $ do-      content <- readEntryByName "tmp/repo/things" "yolo" :: IO (Maybe Thing)+      content <- readDocumentByName "tmp/repo/things" "yolo" :: IO (Maybe Thing)       content `shouldBe` Nothing -  describe "listEntryKeys" $ do-    it "returns a list of entry keys when listing a collection" $ do+  describe "documentIdFromName" $ do+    it "returns Just the document id from the document's name" $ do       createDirectoryIfMissing True "tmp/repo/things"+      _ <- writeFile "tmp/repo/things/000098-some-thing.json" "THIS SHOULD NOT BE READ"+      i <- documentIdFromName "tmp/repo/things" "some-thing"+      i `shouldBe` Just 98++    it "returns Nothing when run with a nonexistent name" $ do+      i <- documentIdFromName "tmp/repo/things" "yolo"+      i `shouldBe` Nothing++  describe "documentNameFromId" $ do+    it "returns Just the document name from the document's id" $ do+      createDirectoryIfMissing True "tmp/repo/things"+      _ <- writeFile "tmp/repo/things/000098-some-thing.json" "THIS SHOULD NOT BE READ"+      i <- documentNameFromId "tmp/repo/things" 98+      i `shouldBe` Just "some-thing"++    it "returns Nothing when run with a nonexistent id" $ do+      i <- documentNameFromId "tmp/repo/things" 123+      i `shouldBe` Nothing++  describe "listDocumentKeys" $ do+    it "returns a list of document keys when listing a collection" $ do+      createDirectoryIfMissing True "tmp/repo/things"       _ <- writeFile "tmp/repo/things/first-thing.json" "{}"       _ <- writeFile "tmp/repo/things/second-thing.json" "{}"-      list <- listEntryKeys "tmp/repo/things"+      list <- listDocumentKeys "tmp/repo/things"       sort list `shouldBe` ["first-thing", "second-thing"]      it "returns an empty when listing a nonexistent collection" $ do-      list <- listEntryKeys "nonsense"+      list <- listDocumentKeys "nonsense"       list `shouldBe` []    describe "listEntries" $ do