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
type TransactionWriter = WriterT [IO ()] IO ()
createRepo :: FilePath -> IO ()
createRepo path = do
createDirectoryIfMissing True path
insideDirectory path $ do
shell "git" ["init"]
writeFile lockPath ""
transaction :: FilePath -> TransactionWriter -> IO ()
transaction repoPath action = do
insideDirectory repoPath $ withLock lockPath Exclusive Block $ do
writeActions <- execWriterT action
shell "git" ["stash"]
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)
saveEntry :: ToJSON a => FilePath -> String -> a -> TransactionWriter
saveEntry collection key content = do
tell [createDirectoryIfMissing True collection,
writeEntry collection key content]
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]
listCollections :: IO [FilePath]
listCollections = do
contents <- try (getDirectoryContents =<< getCurrentDirectory) :: IO (Either IOException [FilePath])
filterDirs $ fromMaybe [] $ hush contents
listEntryKeys :: FilePath -> IO [String]
listEntryKeys collection = do
contents <- try (getDirectoryContents collection) :: IO (Either IOException [String])
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
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
readEntryById :: FromJSON a => FilePath -> Int -> IO (Maybe a)
readEntryById collection n = splitFindAndReadEntry collection $ find ((== n) . fst . fst)
readEntryByName :: FromJSON a => FilePath -> String -> IO (Maybe a)
readEntryByName collection n = splitFindAndReadEntry collection $ find ((isSuffixOf n) . snd . fst)