1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
{-# 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 = E.throwIO . UnknownError . 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 fs name author logMsg contents = E.catch (latest fs name >> E.throwIO ResourceExists)
(\e -> if e == NotFound
then save fs name author logMsg contents
else E.throwIO 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 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) <- 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 fs name Nothing id2 = do
contents2 <- retrieve fs name id2
return [Second (lines contents2) ] -- no need to run getGroupedDiff here - diff vs empty document
diff fs name id1 id2 = do
contents1 <- retrieve fs name 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 repo exact name desc = do
let matcher = if exact
then (== desc)
else (desc `isInfixOf`)
revs <- history repo [name] (TimeRange Nothing Nothing) 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 fs exact name mrev = do
edoc <- E.try (retrieve fs name mrev)
case (edoc, mrev) of
-- Regular retrieval using revision identifier succeeded, use this doc.
(Right doc, _) -> return doc
-- Retrieval of latest revision failed, nothing we can do about this.
(Left e, Nothing) -> E.throwIO (e :: FileStoreError)
-- Retrieval failed, we can try fetching a revision by the description.
(Left _, Just rev) -> do
revs <- searchRevisions fs exact name 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 fs fp = directory fs fp >>= mapM f
where f r = E.catch (g r) (\(e :: FileStoreError)-> return ( r, Left . show $ e ) )
g r@(FSDirectory _dir) = return (r,Left "richDirectory, we don't care about revision info for directories")
g res@(FSFile file) = do rev <- revision fs =<< latest fs ( fp </> file )
return (res,Right rev)
|
