gitson 0.1.0 → 0.2.0
raw patch · 6 files changed
+86/−50 lines, 6 filesdep ~doctestPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: doctest
API changes (from Hackage documentation)
- Gitson.Util: findRepoRoot :: FilePath -> IO FilePath
- Gitson.Util: stripWhitespaceRight :: FilePath -> FilePath
+ Gitson: listCollections :: IO [FilePath]
+ Gitson: listEntryKeys :: FilePath -> IO [FilePath]
+ Gitson.Util: filterDirs :: [FilePath] -> IO [FilePath]
- Gitson: listEntries :: FilePath -> IO (Maybe [FilePath])
+ Gitson: listEntries :: FromJSON a => FilePath -> IO [a]
Files
- README.md +20/−13
- gitson.cabal +3/−3
- library/Gitson.hs +17/−5
- library/Gitson/Util.hs +11/−19
- test-suite/DocTest.hs +1/−1
- test-suite/GitsonSpec.hs +34/−9
README.md view
@@ -1,4 +1,4 @@-# gitson [](http://hackage.haskell.org/package/gitson) [](https://travis-ci.org/myfreeweb/gitson) [](https://coveralls.io/r/myfreeweb/gitson) [](https://www.tldrlegal.com/l/apache2)+# gitson [](https://hackage.haskell.org/package/gitson) [](https://travis-ci.org/myfreeweb/gitson) [](https://coveralls.io/r/myfreeweb/gitson) [](https://www.tldrlegal.com/l/apache2) A simple document store library for Git + JSON, based on [Aeson]. Uses command line git, at least for now.@@ -11,13 +11,15 @@ ## Usage ```haskell+{-# LANGUAGE TemplateHaskell #-}+ import Gitson import Gitson.Util (insideDirectory) import Data.Aeson.TH import Control.Monad.IO.Class (liftIO) data Thing = Thing { val :: Int } deriving (Eq, Show)-$(deriveJSON defaultOptions ''Thing)+$(deriveJSON defaultOptions ''Thing) -- there are non-Template ways of doing this, see aeson docs main :: IO () main = do@@ -25,8 +27,9 @@ createRepo "./content" -- Writing data to a "database" happens in transactions- -- A transaction is committed after the block is executed- -- Just like in SQL databases+ -- A transaction is committed (write files & git commit)+ -- after the block is executed, just like in SQL databases+ -- Also, transactions are thread-safe transaction "./content" $ do -- order: (collection) (key ) (data) saveEntry "content" "first-thing" Thing {val = 1}@@ -37,18 +40,22 @@ -- Reading data -- (These are normal IO actions, so if you want- -- to read inside of a transaction, liftIO)- keys <- listEntries "./content/things"- -- Just ["first-thing"]- first-thing <- readEntry "./content/things" "first-thing" :: IO (Maybe Thing)- -- Just Thing {val = 1}-- -- Reading data, avoiding repetition of the repo path+ -- to read inside of a transaction, liftIO.+ -- Note: transaction already includes insideDirectory!) insideDirectory "./content" $ do- keys <- listEntries "things"- -- Just ["first-thing"]+ colls <- listCollections+ -- ["things"]+ keys <- listEntryKeys "things"+ -- ["first-thing"] first-thing <- readEntry "things" "first-thing" :: IO (Maybe Thing) -- Just Thing {val = 1}+ things <- readEntries "things" :: IO [Thing]+ -- [Thing {val = 1}]++ -- 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" ``` ## Development
gitson.cabal view
@@ -1,5 +1,5 @@ name: gitson-version: 0.1.0+version: 0.2.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@@ -54,7 +54,7 @@ build-depends: base >= 4.0.0.0 && < 5 , Glob == 0.*- , doctest == 0.*+ , doctest >= 0.8 default-language: Haskell2010 ghc-options: -threaded -Wall -Werror hs-source-dirs: test-suite@@ -73,7 +73,7 @@ , HUnit , QuickCheck default-language: Haskell2010- ghc-options: -threaded -Wall -Werror+ ghc-options: -threaded -Wall -Werror -fhpc hs-source-dirs: test-suite main-is: Spec.hs other-modules:
library/Gitson.hs view
@@ -1,9 +1,7 @@ -- | Gitson is a simple document store library for Git + JSON. module Gitson (module Gitson) where -import Prelude hiding (catch) import System.Directory-import System.FilePath import System.Lock.FLock import Control.Exception import Control.Applicative@@ -11,6 +9,7 @@ import Control.Monad.Trans.Writer import Control.Monad.IO.Class (liftIO) import Data.Aeson (ToJSON, encode, FromJSON, decode)+import Data.Maybe (fromMaybe) import qualified Data.ByteString.Lazy as BL import Gitson.Util @@ -48,7 +47,20 @@ return $ decode =<< hush jsonString -- | Lists entry keys in a collection.-listEntries :: FilePath -> IO (Maybe [FilePath])-listEntries collection = do+listEntryKeys :: FilePath -> IO [FilePath]+listEntryKeys collection = do contents <- try (getDirectoryContents collection) :: IO (Either IOException [FilePath])- return $ filterFilenamesAsKeys <$> hush contents+ 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+ 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
library/Gitson/Util.hs view
@@ -1,9 +1,8 @@ -- | Various functions used inside Gitson. module Gitson.Util (module Gitson.Util) where -import Data.Char (isSpace)-import Control.Monad (void)-import Control.Applicative+import Control.Monad (void, filterM)+import Data.List (isSuffixOf, isPrefixOf) import System.FilePath import System.Directory import System.Process@@ -23,13 +22,17 @@ lockPath :: FilePath lockPath = ".git" </> "gitson-lock" --- | Turns a list of filenames into a list of keys.+-- | Turns a list of filenames into a list of keys, ignoring non-JSON files. ----- >>> filterFilenamesAsKeys [".", "..", "k1.json"]+-- >>> filterFilenamesAsKeys [".", "..", "k1.json", "unrelated.file"] -- ["k1"] filterFilenamesAsKeys :: [String] -> [String]-filterFilenamesAsKeys = map dropExtension . filter (`notElem` [".", ".."])+filterFilenamesAsKeys = map dropExtension . filter (isSuffixOf ".json") +-- | Filters a list of file paths, leaving only paths to existing non-hidden directories.+filterDirs :: [FilePath] -> IO [FilePath]+filterDirs = (filterM doesDirectoryExist) . filter (not . isPrefixOf ".")+ -- | Returns an IO action that switches the current directory to a given path, -- executes the given IO action and switches the current directory back. insideDirectory :: FilePath -> IO a -> IO a@@ -40,17 +43,6 @@ setCurrentDirectory prevPath return result --- | Removes trailing whitespace like the newline you get from executing commands.------ >>> stripWhitespaceRight "/path/to/thingy \n\n\n"--- "/path/to/thingy"-stripWhitespaceRight :: FilePath -> FilePath-stripWhitespaceRight = reverse . dropWhile isSpace . reverse---- | Finds the path to the git repository a given path belongs to.-findRepoRoot :: FilePath -> IO FilePath-findRepoRoot path = stripWhitespaceRight <$> (insideDirectory path $ readProcess "git" ["rev-parse", "--show-toplevel"] [])- -- | Returns the message of the last git commit in the repo where the current directory is located. lastCommitText :: IO String lastCommitText = readProcess "git" ["log", "--max-count=1", "--pretty=format:%s"] []@@ -62,6 +54,6 @@ -- | Runs a shell command with stdin, stdout and stderr set to /dev/null. shell :: String -> [String] -> IO () shell cmd args = void $ do- null <- devNull- (_, _, _, pid) <- createProcess (proc cmd args){std_in = UseHandle null, std_out = UseHandle null, std_err = UseHandle null}+ dnull <- devNull+ (_, _, _, pid) <- createProcess (proc cmd args){std_in = UseHandle dnull, std_out = UseHandle dnull, std_err = UseHandle dnull} waitForProcess pid
test-suite/DocTest.hs view
@@ -1,7 +1,7 @@ module Main (main) where import System.FilePath.Glob (glob)-import Test.DocTest (doctest)+import Test.DocTest main :: IO () main = glob "library/**/*.hs" >>= doctest
test-suite/GitsonSpec.hs view
@@ -6,14 +6,13 @@ import System.Directory import Data.Aeson.TH import Data.List (sort)-import Control.Applicative import Control.Exception import Control.Monad.IO.Class import Control.Monad (void) import Gitson import Gitson.Util (insideDirectory, lastCommitText) -data Thing = Thing { val :: Int } deriving (Eq, Show)+data Thing = Thing { val :: Int } deriving (Eq, Show, Ord) $(deriveJSON defaultOptions ''Thing) spec :: Spec@@ -44,17 +43,43 @@ content <- readEntry "tmp/repo/things" "totally-not-a-thing" :: IO (Maybe Thing) content `shouldBe` Nothing - describe "listEntries" $ do- it "returns Just a list of entries when listing a collection" $ do+ describe "listEntryKeys" $ do+ it "returns a list of entry 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 <- listEntries "tmp/repo/things"- sort <$> list `shouldBe` Just ["first-thing", "second-thing"]+ list <- listEntryKeys "tmp/repo/things"+ sort list `shouldBe` ["first-thing", "second-thing"] - it "returns Nothing when listing a nonexistent collection" $ do- list <- listEntries "nonsense"- list `shouldBe` Nothing+ it "returns an empty when listing a nonexistent collection" $ do+ list <- listEntryKeys "nonsense"+ list `shouldBe` []++ describe "listEntries" $ do+ it "returns a list of entries when listing a collection" $ do+ createDirectoryIfMissing True "tmp/repo/things"+ _ <- writeFile "tmp/repo/things/first-thing.json" "{\"val\":1}"+ _ <- writeFile "tmp/repo/things/second-thing.json" "{\"val\":2}"+ list <- listEntries "tmp/repo/things" :: IO [Thing]+ sort list `shouldBe` [Thing {val = 1}, Thing {val = 2}]++ it "returns an empty list when listing a nonexistent collection" $ do+ list <- listEntries "nonsense" :: IO [Thing]+ list `shouldBe` []++ describe "listCollections" $ do+ it "returns a list of collections" $ do+ createDirectoryIfMissing True "tmp/repo/bits"+ createDirectoryIfMissing True "tmp/repo/pieces"+ insideDirectory "tmp/repo" $ do+ list <- listCollections+ sort list `shouldBe` ["bits", "pieces"]++ it "returns an empty list when listing an empty repo" $ do+ createDirectoryIfMissing True "tmp/repo"+ insideDirectory "tmp/repo" $ do+ list <- listCollections+ sort list `shouldBe` [] setup :: IO () setup = createRepo "tmp/repo"