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
|
{- filenames (not paths) used in views
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.View.ViewedFile (
ViewedFile,
MkViewedFile,
viewedFileFromReference,
viewedFileReuse,
dirFromViewedFile,
prop_viewedFile_roundtrips,
) where
import Common.Annex
type FileName = String
type ViewedFile = FileName
type MkViewedFile = FilePath -> ViewedFile
{- Converts a filepath used in a reference branch to the
- filename that will be used in the view.
-
- No two filepaths from the same branch should yeild the same result,
- so all directory structure needs to be included in the output filename
- in some way.
-
- So, from dir/subdir/file.foo, generate file_%dir%subdir%.foo
-}
viewedFileFromReference :: MkViewedFile
viewedFileFromReference f = concat
[ escape base
, if null dirs then "" else "_%" ++ intercalate "%" (map escape dirs) ++ "%"
, escape $ concat extensions
]
where
(path, basefile) = splitFileName f
dirs = filter (/= ".") $ map dropTrailingPathSeparator (splitPath path)
(base, extensions) = splitShortExtensions basefile
{- To avoid collisions with filenames or directories that contain
- '%', and to allow the original directories to be extracted
- from the ViewedFile, '%' is escaped to '\%' (and '\' to '\\').
-}
escape :: String -> String
escape = replace "%" "\\%" . replace "\\" "\\\\"
{- For use when operating already within a view, so whatever filepath
- is present in the work tree is already a ViewedFile. -}
viewedFileReuse :: MkViewedFile
viewedFileReuse = takeFileName
{- Extracts from a ViewedFile the directory where the file is located on
- in the reference branch. -}
dirFromViewedFile :: ViewedFile -> FilePath
dirFromViewedFile = joinPath . drop 1 . sep [] ""
where
sep l _ [] = reverse l
sep l curr (c:cs)
| c == '%' = sep (reverse curr:l) "" cs
| c == '\\' = case cs of
(c':cs') -> sep l (c':curr) cs'
[] -> sep l curr cs
| otherwise = sep l (c:curr) cs
prop_viewedFile_roundtrips :: FilePath -> Bool
prop_viewedFile_roundtrips f
-- Relative filenames wanted, not directories.
| any (isPathSeparator) (end f ++ beginning f) = True
| otherwise = dir == dirFromViewedFile (viewedFileFromReference f)
where
dir = joinPath $ beginning $ splitDirectories f
|
