{-# 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. (HasCallStack, 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. (HasCallStack, 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. (HasCallStack, 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
  latestRevId <- FileStore -> String -> IO String
latest FileStore
fs String
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) <- E.catch
                                  (mergeContents ("edited", toByteString contents) (originalRevId, originalContents) (latestRevId, latestContents))
                                  handleUnknownError
       return $ Left (MergeInfo latestRev conflicts 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
  contents2 <- FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
name Maybe String
id2
  return [Second (lines contents2) ]   -- no need to run getGroupedDiff here - diff vs empty document 
diff FileStore
fs String
name Maybe String
id1 Maybe String
id2 = do
  contents1 <- FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
name Maybe String
id1
  contents2 <- retrieve fs name id2
  return $ getGroupedDiff (lines contents1) (lines 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`)
  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
  return $ Prelude.filter (matcher . revDescription) 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
  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 (edoc, 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. (HasCallStack, 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
      revs <- FileStore -> Bool -> String -> String -> IO [Revision]
searchRevisions FileStore
fs Bool
exact String
name String
rev
      if Prelude.null revs

        -- No revisions containing this description.
        then E.throwIO NotFound

        -- Retrieve resource for latest matching revision.
        else retrieve fs name (Just $ revId $ Prelude.head 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 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 )
                                 return (res,Right rev)