diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/gitson.cabal b/gitson.cabal --- a/gitson.cabal +++ b/gitson.cabal @@ -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 diff --git a/library/Gitson.hs b/library/Gitson.hs --- a/library/Gitson.hs +++ b/library/Gitson.hs @@ -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 <$>) diff --git a/library/Gitson/Util.hs b/library/Gitson/Util.hs --- a/library/Gitson/Util.hs +++ b/library/Gitson/Util.hs @@ -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. -- diff --git a/test-suite/GitsonSpec.hs b/test-suite/GitsonSpec.hs --- a/test-suite/GitsonSpec.hs +++ b/test-suite/GitsonSpec.hs @@ -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