module Gitson (module Gitson) where
import System.Directory
import System.Lock.FLock
import Control.Exception
import Control.Applicative
import Control.Error.Util
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
createRepo :: FilePath -> IO ()
createRepo path = do
createDirectoryIfMissing True path
insideDirectory path $ do
shell "git" ["init"]
writeFile lockPath ""
type TransactionWriter = WriterT [IO ()] IO ()
saveEntry :: ToJSON a => FilePath -> FilePath -> a -> TransactionWriter
saveEntry collection key content = do
liftIO $ createDirectoryIfMissing True collection
tell [BL.writeFile (entryPath collection key) (encode content)]
transaction :: FilePath -> TransactionWriter -> IO ()
transaction repoPath action = do
insideDirectory repoPath $ withLock lockPath Exclusive Block $ do
shell "git" ["reset", "--hard", "HEAD"]
writeActions <- execWriterT action
sequence_ writeActions
shell "git" ["add", "--all"]
shell "git" ["commit", "-m", "Gitson transaction"]
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
listEntryKeys :: FilePath -> IO [FilePath]
listEntryKeys collection = do
contents <- try (getDirectoryContents collection) :: IO (Either IOException [FilePath])
return $ filterFilenamesAsKeys $ fromMaybe [] $ hush contents
listEntries :: FromJSON a => FilePath -> IO [a]
listEntries collection = do
ks <- listEntryKeys collection
maybes <- mapM (readEntry collection) ks
return $ fromMaybe [] $ sequence maybes
listCollections :: IO [FilePath]
listCollections = do
contents <- try (getDirectoryContents =<< getCurrentDirectory) :: IO (Either IOException [FilePath])
filterDirs $ fromMaybe [] $ hush contents