{-# LANGUAGE ScopedTypeVariables, CPP #-}
{- |
   Module      : Data.FileStore.Generic
   Copyright   : Copyright (C) 2009 John MacFarlane, Gwern Branwen, Sebastiaan Visser
   License     : BSD 3

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : GHC 6.10 required

   Generic utility functions for working with filestores.
-}

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

-- | Like save, but first verify that the resource name is new.  If not, throws a 'ResourceExists'
-- error.
create :: Contents a
       => FileStore
       -> FilePath          -- ^ Resource to create.
       -> Author            -- ^ Author of change.
       -> Description       -- ^ Description of change.
       -> a                 -- ^ Contents of resource.
       -> 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 a named resource in the filestore.  Like save, except that a revision ID
-- must be specified.  If the resource has been modified since the specified revision,
-- @Left@ merge information is returned.  Otherwise, @Right@ the new contents are saved.  
modify  :: Contents a
        => FileStore
        -> FilePath          -- ^ Resource to create.
        -> RevisionId        -- ^ ID of previous revision that is being modified.
        -> Author            -- ^ Author of change.
        -> Description       -- ^ Description of change.
        -> a                 -- ^ Contents of resource.
        -> 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)

-- | Return a unified diff of two revisions of a named resource.
-- Format of the diff is a list @[(Diff, [String])]@, where
-- @DI@ is @F@ (in first document only), @S@ (in second only),
-- or @B@ (in both), and the list is a list of lines (without
-- newlines at the end).
diff :: FileStore
     -> FilePath      -- ^ Resource name to get diff for.
     -> Maybe RevisionId  -- ^ @Just@ old revision ID, or @Nothing@ for empty.
     -> Maybe RevisionId  -- ^ @Just@ oew revision ID, or @Nothing@ for latest.
     -> 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) ]   -- no need to run getGroupedDiff here - diff vs empty document 
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)

-- | Return a list of all revisions that are saved with the given
-- description or with a part of this description.
searchRevisions :: FileStore
                -> Bool              -- ^ When true the description must
                                     --   match exactly, when false partial
                                     --   hits are allowed.
                -> FilePath          -- ^ The resource to search history for.
                -> Description       -- ^ Revision description to search for.
                -> 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

-- | Try to retrieve a resource from the repository by name and possibly a
-- revision identifier. When retrieving a resource by revision identifier fails
-- this function will try to fetch the latest revision for which the
-- description matches the given string.
smartRetrieve
  :: Contents a
  => FileStore
  -> Bool            -- ^ @True@ for exact description match, @False@ for partial match.
  -> FilePath        -- ^ Resource name to retrieve.
  -> Maybe String    -- ^ @Just@ revision ID or description, or @Nothing@ for empty.
  -> 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
    
    -- Regular retrieval using revision identifier succeeded, use this doc.
    (Right a
doc, Maybe String
_) -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
doc

    -- Retrieval of latest revision failed, nothing we can do about this.
    (Left FileStoreError
e, Maybe String
Nothing) -> FileStoreError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (FileStoreError
e :: FileStoreError)

    -- Retrieval failed, we can try fetching a revision by the description.
    (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

        -- No revisions containing this description.
        then FileStoreError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO FileStoreError
NotFound

        -- Retrieve resource for latest matching revision.
        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)

-- | Like 'directory', but returns information about the latest revision.
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)