module Data.FileStore.Generic
( modify
, create
, DI(..)
, diff
, searchRevisions
, smartRetrieve
)
where
import Data.FileStore.Types
import Control.Exception (throwIO, catch, SomeException, try)
import Data.FileStore.Utils
import Data.Maybe (isNothing)
import Data.List (isInfixOf)
import qualified Data.List.Split as S (whenElt, split)
import Data.Char (isSpace)
import Data.Algorithm.Diff (DI(..), getGroupedDiff)
import Prelude hiding (catch)
handleUnknownError :: SomeException -> IO a
handleUnknownError = throwIO . UnknownError . show
create :: Contents a
=> FileStore
-> ResourceName
-> Author
-> Description
-> a
-> IO ()
create fs name author logMsg contents = catch (latest fs name >> throwIO ResourceExists)
(\e -> if e == NotFound
then save fs name author logMsg contents
else throwIO e)
modify :: Contents a
=> FileStore
-> ResourceName
-> RevisionId
-> Author
-> Description
-> a
-> IO (Either MergeInfo ())
modify fs name originalRevId author msg contents = do
latestRevId <- latest fs name
latestRev <- revision fs latestRevId
if idsMatch fs originalRevId latestRevId
then save fs name author msg contents >> return (Right ())
else do
latestContents <- retrieve fs name (Just latestRevId)
originalContents <- retrieve fs name (Just originalRevId)
(conflicts, mergedText) <- catch
(mergeContents ("edited", toByteString contents) (originalRevId, originalContents) (latestRevId, latestContents))
handleUnknownError
return $ Left (MergeInfo latestRev conflicts mergedText)
splitOnSpaces :: String -> [String]
splitOnSpaces = S.split (S.whenElt isSpace)
diff :: FileStore
-> ResourceName
-> Maybe RevisionId
-> Maybe RevisionId
-> IO [(DI, [String])]
diff fs name id1 id2 = do
contents1 <- if isNothing id1
then return ""
else retrieve fs name id1
contents2 <- retrieve fs name id2
let words1 = splitOnSpaces contents1
let words2 = splitOnSpaces contents2
return $ getGroupedDiff words1 words2
searchRevisions :: FileStore
-> Bool
-> ResourceName
-> Description
-> IO [Revision]
searchRevisions repo exact name desc = do
let matcher = if exact
then (== desc)
else (desc `isInfixOf`)
revs <- (history repo) [name] (TimeRange Nothing Nothing)
return $ Prelude.filter (matcher . revDescription) revs
smartRetrieve
:: Contents a
=> FileStore
-> Bool
-> ResourceName
-> Maybe String
-> IO a
smartRetrieve fs exact name mrev = do
edoc <- try (retrieve fs name mrev)
case (edoc, mrev) of
(Right doc, _) -> return doc
(Left e, Nothing) -> throwIO (e :: FileStoreError)
(Left _, Just rev) -> do
revs <- searchRevisions fs exact name rev
if Prelude.null revs
then throwIO NotFound
else retrieve fs name (Just $ revId $ Prelude.head revs)