{-# LANGUAGE ScopedTypeVariables, CPP #-}
module Data.FileStore.Generic
( modify
, create
, Diff
, PolyDiff(..)
, diff
, searchRevisions
, smartRetrieve
, richDirectory
)
where
import Data.FileStore.Types
import Control.Exception as E
import Data.FileStore.Utils
import Data.List (isInfixOf)
import Data.Algorithm.Diff (Diff, PolyDiff (..), getGroupedDiff)
import System.FilePath ((</>))
handleUnknownError :: E.SomeException -> IO a
handleUnknownError :: forall a. SomeException -> IO a
handleUnknownError = FileStoreError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (FileStoreError -> IO a)
-> (SomeException -> FileStoreError) -> SomeException -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FileStoreError
UnknownError (String -> FileStoreError)
-> (SomeException -> String) -> SomeException -> FileStoreError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show
create :: Contents a
=> FileStore
-> FilePath
-> Author
-> Description
-> a
-> IO ()
create :: forall a.
Contents a =>
FileStore -> String -> Author -> String -> a -> IO ()
create FileStore
fs String
name Author
author String
logMsg a
contents = IO () -> (FileStoreError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (FileStore -> String -> IO String
latest FileStore
fs String
name IO String -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO FileStoreError
ResourceExists)
(\FileStoreError
e -> if FileStoreError
e FileStoreError -> FileStoreError -> Bool
forall a. Eq a => a -> a -> Bool
== FileStoreError
NotFound
then FileStore
-> forall a. Contents a => String -> Author -> String -> a -> IO ()
save FileStore
fs String
name Author
author String
logMsg a
contents
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO FileStoreError
e)
modify :: Contents a
=> FileStore
-> FilePath
-> RevisionId
-> Author
-> Description
-> a
-> IO (Either MergeInfo ())
modify :: forall a.
Contents a =>
FileStore
-> String
-> String
-> Author
-> String
-> a
-> IO (Either MergeInfo ())
modify FileStore
fs String
name String
originalRevId Author
author String
msg a
contents = do
String
latestRevId <- FileStore -> String -> IO String
latest FileStore
fs String
name
Revision
latestRev <- FileStore -> String -> IO Revision
revision FileStore
fs String
latestRevId
if FileStore -> String -> String -> Bool
idsMatch FileStore
fs String
originalRevId String
latestRevId
then FileStore
-> forall a. Contents a => String -> Author -> String -> a -> IO ()
save FileStore
fs String
name Author
author String
msg a
contents IO () -> IO (Either MergeInfo ()) -> IO (Either MergeInfo ())
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either MergeInfo () -> IO (Either MergeInfo ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either MergeInfo ()
forall a b. b -> Either a b
Right ())
else do
ByteString
latestContents <- FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
name (String -> Maybe String
forall a. a -> Maybe a
Just String
latestRevId)
ByteString
originalContents <- FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
name (String -> Maybe String
forall a. a -> Maybe a
Just String
originalRevId)
(Bool
conflicts, String
mergedText) <- IO (Bool, String)
-> (SomeException -> IO (Bool, String)) -> IO (Bool, String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
((String, ByteString)
-> (String, ByteString)
-> (String, ByteString)
-> IO (Bool, String)
mergeContents (String
"edited", a -> ByteString
forall a. Contents a => a -> ByteString
toByteString a
contents) (String
originalRevId, ByteString
originalContents) (String
latestRevId, ByteString
latestContents))
SomeException -> IO (Bool, String)
forall a. SomeException -> IO a
handleUnknownError
Either MergeInfo () -> IO (Either MergeInfo ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MergeInfo () -> IO (Either MergeInfo ()))
-> Either MergeInfo () -> IO (Either MergeInfo ())
forall a b. (a -> b) -> a -> b
$ MergeInfo -> Either MergeInfo ()
forall a b. a -> Either a b
Left (Revision -> Bool -> String -> MergeInfo
MergeInfo Revision
latestRev Bool
conflicts String
mergedText)
diff :: FileStore
-> FilePath
-> Maybe RevisionId
-> Maybe RevisionId
-> IO [Diff [String]]
diff :: FileStore
-> String -> Maybe String -> Maybe String -> IO [Diff [String]]
diff FileStore
fs String
name Maybe String
Nothing Maybe String
id2 = do
String
contents2 <- FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
name Maybe String
id2
[Diff [String]] -> IO [Diff [String]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[String] -> Diff [String]
forall a b. b -> PolyDiff a b
Second (String -> [String]
lines String
contents2) ]
diff FileStore
fs String
name Maybe String
id1 Maybe String
id2 = do
String
contents1 <- FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
name Maybe String
id1
String
contents2 <- FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
name Maybe String
id2
[Diff [String]] -> IO [Diff [String]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Diff [String]] -> IO [Diff [String]])
-> [Diff [String]] -> IO [Diff [String]]
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [Diff [String]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff (String -> [String]
lines String
contents1) (String -> [String]
lines String
contents2)
searchRevisions :: FileStore
-> Bool
-> FilePath
-> Description
-> IO [Revision]
searchRevisions :: FileStore -> Bool -> String -> String -> IO [Revision]
searchRevisions FileStore
repo Bool
exact String
name String
desc = do
let matcher :: String -> Bool
matcher = if Bool
exact
then (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
desc)
else (String
desc String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`)
[Revision]
revs <- FileStore -> [String] -> TimeRange -> Maybe Int -> IO [Revision]
history FileStore
repo [String
name] (Maybe UTCTime -> Maybe UTCTime -> TimeRange
TimeRange Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing) Maybe Int
forall a. Maybe a
Nothing
[Revision] -> IO [Revision]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Revision] -> IO [Revision]) -> [Revision] -> IO [Revision]
forall a b. (a -> b) -> a -> b
$ (Revision -> Bool) -> [Revision] -> [Revision]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (String -> Bool
matcher (String -> Bool) -> (Revision -> String) -> Revision -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Revision -> String
revDescription) [Revision]
revs
smartRetrieve
:: Contents a
=> FileStore
-> Bool
-> FilePath
-> Maybe String
-> IO a
smartRetrieve :: forall a.
Contents a =>
FileStore -> Bool -> String -> Maybe String -> IO a
smartRetrieve FileStore
fs Bool
exact String
name Maybe String
mrev = do
Either FileStoreError a
edoc <- IO a -> IO (Either FileStoreError a)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
name Maybe String
mrev)
case (Either FileStoreError a
edoc, Maybe String
mrev) of
(Right a
doc, Maybe String
_) -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
doc
(Left FileStoreError
e, Maybe String
Nothing) -> FileStoreError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (FileStoreError
e :: FileStoreError)
(Left FileStoreError
_, Just String
rev) -> do
[Revision]
revs <- FileStore -> Bool -> String -> String -> IO [Revision]
searchRevisions FileStore
fs Bool
exact String
name String
rev
if [Revision] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Revision]
revs
then FileStoreError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO FileStoreError
NotFound
else FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
name (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Revision -> String
revId (Revision -> String) -> Revision -> String
forall a b. (a -> b) -> a -> b
$ [Revision] -> Revision
forall a. HasCallStack => [a] -> a
Prelude.head [Revision]
revs)
richDirectory :: FileStore -> FilePath -> IO [(Resource, Either String Revision)]
richDirectory :: FileStore -> String -> IO [(Resource, Either String Revision)]
richDirectory FileStore
fs String
fp = FileStore -> String -> IO [Resource]
directory FileStore
fs String
fp IO [Resource]
-> ([Resource] -> IO [(Resource, Either String Revision)])
-> IO [(Resource, Either String Revision)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Resource -> IO (Resource, Either String Revision))
-> [Resource] -> IO [(Resource, Either String Revision)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Resource -> IO (Resource, Either String Revision)
f
where f :: Resource -> IO (Resource, Either String Revision)
f Resource
r = IO (Resource, Either String Revision)
-> (FileStoreError -> IO (Resource, Either String Revision))
-> IO (Resource, Either String Revision)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Resource -> IO (Resource, Either String Revision)
g Resource
r) (\(FileStoreError
e :: FileStoreError)-> (Resource, Either String Revision)
-> IO (Resource, Either String Revision)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Resource
r, String -> Either String Revision
forall a b. a -> Either a b
Left (String -> Either String Revision)
-> (FileStoreError -> String)
-> FileStoreError
-> Either String Revision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStoreError -> String
forall a. Show a => a -> String
show (FileStoreError -> Either String Revision)
-> FileStoreError -> Either String Revision
forall a b. (a -> b) -> a -> b
$ FileStoreError
e ) )
g :: Resource -> IO (Resource, Either String Revision)
g r :: Resource
r@(FSDirectory String
_dir) = (Resource, Either String Revision)
-> IO (Resource, Either String Revision)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Resource
r,String -> Either String Revision
forall a b. a -> Either a b
Left String
"richDirectory, we don't care about revision info for directories")
g res :: Resource
res@(FSFile String
file) = do Revision
rev <- FileStore -> String -> IO Revision
revision FileStore
fs (String -> IO Revision) -> IO String -> IO Revision
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FileStore -> String -> IO String
latest FileStore
fs ( String
fp String -> String -> String
</> String
file )
(Resource, Either String Revision)
-> IO (Resource, Either String Revision)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Resource
res,Revision -> Either String Revision
forall a b. b -> Either a b
Right Revision
rev)