gitson 0.2.1 → 0.3.0

raw patch · 5 files changed

+162/−47 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +15/−2
• gitson.cabal +1/−1
• library/Gitson.hs +58/−23
• library/Gitson/Util.hs +40/−7
• test-suite/GitsonSpec.hs +48/−14

@@ -32,7 +32,7 @@   -- Also, transactions are thread-safe   transaction "./content" $ do     -- order: (collection) (key        ) (data)-    saveEntry "content"    "first-thing" Thing {val = 1}+    saveEntry "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!@@ -41,7 +41,9 @@   -- Reading data   -- (These are normal IO actions, so if you want   --  to read inside of a transaction, liftIO.-  --  Note: transaction already includes insideDirectory!)+  --  Note: transaction already includes insideDirectory!+  --  Warning: you can't read what you're writing in a transaction!!!+  --  You can only read what's been written before the transaction began.)   insideDirectory "./content" $ do     colls <- listCollections           -- ["things"]@@ -56,6 +58,17 @@   -- the current directory, executes an action and changes it back.   -- You can use reading actions without it, like this:   keys <- listEntryKeys "./content/things"+++  -- And now, some bells and whistles:+  -- Numeric id support+  transaction "./content" $ do+    saveNextEntry "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"+    -- both will read from things/000001-hello-world.json ```  ## Development

@@ -1,5 +1,5 @@ name:            gitson-version:         0.2.1+version:         0.3.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

@@ -4,22 +4,25 @@   createRepo,   transaction,   saveEntry,-  readEntry,+  saveNextEntry,+  listCollections,   listEntryKeys,   listEntries,-  listCollections+  readEntry,+  readEntryById,+  readEntryByName ) where  import           System.Directory import           System.Lock.FLock-import           Control.Exception-import           Control.Applicative-import           Control.Error.Util+import           Control.Exception (try, IOException)+import           Control.Error.Util (hush) import           Control.Monad.Trans.Writer-import           Control.Monad.IO.Class (liftIO) import           Data.Aeson (ToJSON, FromJSON, decode) import           Data.Aeson.Encode.Pretty-import           Data.Maybe (fromMaybe)+import           Data.Maybe (fromMaybe, catMaybes)+import           Data.List (find, isSuffixOf)+import           Text.Printf (printf) import qualified Data.ByteString.Lazy as BL import           Gitson.Util @@ -38,31 +41,49 @@ transaction :: FilePath -> TransactionWriter -> IO () transaction repoPath action = do   insideDirectory repoPath $ withLock lockPath Exclusive Block $ do-    shell "git" ["reset", "--hard", "HEAD"] -- Reset working tree just in case     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 (n, s) = zeroPad n ++ "-" ++ s+  where zeroPad :: Int -> String+        zeroPad x = printf "%06d" x+ 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)+ -- | Adds a write action to a transaction.-saveEntry :: ToJSON a => FilePath -> FilePath -> a -> TransactionWriter+saveEntry :: ToJSON a => FilePath -> String -> a -> TransactionWriter saveEntry collection key content = do-  liftIO $ createDirectoryIfMissing True collection-  tell [BL.writeFile (entryPath collection key) (encodePretty' prettyConfig content)]+  tell [createDirectoryIfMissing True collection,+        writeEntry collection key content] --- | Reads an entry from a collection by key.-readEntry :: FromJSON a => FilePath -> FilePath -> IO (Maybe a)-readEntry collection key = do-  jsonString <- try (BL.readFile $ entryPath collection key) :: IO (Either IOException BL.ByteString)-  return $ decode =<< hush jsonString+-- | 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+  tell [createDirectoryIfMissing True collection,+        listEntryKeys collection >>=+        return . nextKeyId >>=+        \nextId -> writeEntry collection (combineKey (nextId, key)) content] +-- | Lists collections in the current repository.+listCollections :: IO [FilePath]+listCollections = do+  contents <- try (getDirectoryContents =<< getCurrentDirectory) :: IO (Either IOException [FilePath])+  filterDirs $ fromMaybe [] $ hush contents+ -- | Lists entry keys in a collection.-listEntryKeys :: FilePath -> IO [FilePath]+listEntryKeys :: FilePath -> IO [String] listEntryKeys collection = do-  contents <- try (getDirectoryContents collection) :: IO (Either IOException [FilePath])+  contents <- try (getDirectoryContents collection) :: IO (Either IOException [String])   return $ filterFilenamesAsKeys $ fromMaybe [] $ hush contents  -- | Lists entries in a collection.@@ -72,8 +93,22 @@   maybes <- mapM (readEntry collection) ks   return $ fromMaybe [] $ sequence maybes --- | Lists collections in the current repository.-listCollections :: IO [FilePath]-listCollections = do-  contents <- try (getDirectoryContents =<< getCurrentDirectory) :: IO (Either IOException [FilePath])-  filterDirs $ fromMaybe [] $ hush contents+-- | 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)+  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++-- | 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)++-- | 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)

@@ -2,7 +2,9 @@ module Gitson.Util (module Gitson.Util) where  import           Control.Monad (void, filterM)+import           Control.Applicative import           Data.List (isSuffixOf, isPrefixOf)+import           Data.Maybe import           System.FilePath import           System.Directory import           System.Process@@ -15,7 +17,7 @@ -- -- >>> entryPath "things/" "entry" -- "things/entry.json"-entryPath :: FilePath -> FilePath -> FilePath+entryPath :: FilePath -> String -> FilePath entryPath collection key = collection </> key <.> "json"  -- | Path to the transaction lock file, relative to the repo root.@@ -26,7 +28,7 @@ -- -- >>> filterFilenamesAsKeys [".", "..", "k1.json", "unrelated.file"] -- ["k1"]-filterFilenamesAsKeys :: [String] -> [String]+filterFilenamesAsKeys :: [FilePath] -> [String] filterFilenamesAsKeys = map dropExtension . filter (isSuffixOf ".json")  -- | Filters a list of file paths, leaving only paths to existing non-hidden directories.@@ -47,13 +49,44 @@ lastCommitText :: IO String lastCommitText = readProcess "git" ["log", "--max-count=1", "--pretty=format:%s"] [] --- | A \/dev/null handle.-devNull :: IO Handle-devNull = openFile "/dev/null" ReadWriteMode- -- | Runs a shell command with stdin, stdout and stderr set to /dev/null. shell :: String -> [String] -> IO () shell cmd args = void $ do-  dnull <- devNull+  dnull <- openFile "/dev/null" ReadWriteMode   (_, _, _, 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++-- | Tries to extract the first int out of a string.+--+-- >>> maybeReadIntString "0123-hell0w0rld"+-- Just (123,"-hell0w0rld")+--+-- >>> maybeReadIntString "1"+-- Just (1,"")+--+-- >>> maybeReadIntString "hello"+-- Nothing+maybeReadIntString :: String -> Maybe (Int, String)+maybeReadIntString x = listToMaybe (reads x :: [(Int, String)])++-- | Returns the next numeric id in a sequence of keys.+--+-- >>> nextKeyId []+-- 1+--+-- >>> nextKeyId ["aaaaarrrrrrrrrrr"]+-- 1+--+-- >>> nextKeyId ["1-hell0-w0rld-123456.json", "002-my-second-post.json"]+-- 3+nextKeyId :: [String] -> Int+nextKeyId = (+1) . maxOrZero . catMaybes . map maybeReadInt+  where maybeReadInt x = fst <$> maybeReadIntString x+        maxOrZero [] = 0+        maxOrZero xs = maximum xs

@@ -17,21 +17,33 @@  spec :: Spec spec = before setup $ after cleanup $ do-  describe "transaction" $ 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}-        liftIO $ (readFile "things/first-thing.json") `shouldThrow` anyIOException-        liftIO $ (readFile "things/second-thing.json") `shouldThrow` anyIOException-      insideDirectory "tmp/repo" $ do-        first <- readFile "things/first-thing.json"-        first `shouldBe` "{\n  \"val\": 1\n}"-        second <- readFile "things/second-thing.json"-        second `shouldBe` "{\n  \"val\": 2\n}"-        commitMsg <- lastCommitText-        commitMsg `shouldBe` "Gitson transaction"+  context "transaction" $ do+    describe "saveEntry" $ 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}+          liftIO $ (readFile "things/first-thing.json") `shouldThrow` anyIOException+          liftIO $ (readFile "things/second-thing.json") `shouldThrow` anyIOException+        insideDirectory "tmp/repo" $ do+          first <- readFile "things/first-thing.json"+          first `shouldBe` "{\n  \"val\": 1\n}"+          second <- readFile "things/second-thing.json"+          second `shouldBe` "{\n  \"val\": 2\n}"+          commitMsg <- lastCommitText+          commitMsg `shouldBe` "Gitson transaction" +    describe "saveNextEntry" $ 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}+        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       createDirectoryIfMissing True "tmp/repo/things"@@ -41,6 +53,28 @@      it "returns Nothing when reading by a nonexistent key" $ do       content <- readEntry "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+      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 `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 `shouldBe` Nothing++  describe "readEntryByName" $ do+    it "returns Just the entry when reading an entry 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 `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 `shouldBe` Nothing    describe "listEntryKeys" $ do