gitson-0.3.0: library/Gitson.hs

-- | Gitson is a simple document store library for Git + JSON.
module Gitson (
  TransactionWriter,
  createRepo,
  transaction,
  saveEntry,
  saveNextEntry,
  listCollections,
  listEntryKeys,
  listEntries,
  readEntry,
  readEntryById,
  readEntryByName
) where

import           System.Directory
import           System.Lock.FLock
import           Control.Exception (try, IOException)
import           Control.Error.Util (hush)
import           Control.Monad.Trans.Writer
import           Data.Aeson (ToJSON, FromJSON, decode)
import           Data.Aeson.Encode.Pretty
import           Data.Maybe (fromMaybe, catMaybes)
import           Data.List (find, isSuffixOf)
import           Text.Printf (printf)
import qualified Data.ByteString.Lazy as BL
import           Gitson.Util

-- | A transaction monad.
type TransactionWriter = WriterT [IO ()] IO ()

-- | 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 ""

-- | 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"]

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 -> String -> a -> TransactionWriter
saveEntry collection key content = do
  tell [createDirectoryIfMissing True collection,
        writeEntry 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
  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 [String]
listEntryKeys 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
  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)
  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)