change directory encoding in ViewedFile such that the original directory can be extracted from it

Annex/View/ViewedFile.hs

@@ -5,7 +5,14 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Annex.View.ViewedFile where
+module Annex.View.ViewedFile (
+	ViewedFile,
+	MkViewedFile,
+	viewedFileFromReference,
+	viewedFileReuse,
+	dirFromViewedFile,
+	prop_viewedFile_roundtrips,
+) where
 
 import Common.Annex
 import Types.View
@@ -41,27 +48,49 @@ type MkViewedFile = FilePath -> ViewedFile
  - 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 file
+ - so all directory structure needs to be included in the output filename
- - in some way. However, the branch's directory structure is not replicated
+ - in some way.
- - in the view.
  -
- - So, from dir/subdir/file.foo, generate file_{dir;subdir}.foo
+ - So, from dir/subdir/file.foo, generate file_%dir%subdir%.foo
- -
- - (To avoid collisions with a filename that already contains {foo},
- - that is doubled to {{foo}}.)
  -}
 viewedFileFromReference :: MkViewedFile
 viewedFileFromReference f = concat
-	[ double base
+	[ escape base
-	, if null dirs then "" else "_{" ++ double (intercalate ";" dirs) ++ "}"
+	, if null dirs then "" else "_%" ++ intercalate "%" (map escape dirs) ++ "%"
-	, double $ concat extensions
+	, escape $ concat extensions
 	]
   where
 	(path, basefile) = splitFileName f
 	dirs = filter (/= ".") $ map dropTrailingPathSeparator (splitPath path)
 	(base, extensions) = splitShortExtensions basefile
 
-	double = replace "{" "{{" . replace "}" "}}"
+	{- 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 "\\" "\\\\"
 
 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
+	| isAbsolute f = True -- Only relative paths are encoded.
+	| any (isPathSeparator) (end f) = True -- Filenames wanted, not directories.
+	| otherwise = dir == dirFromViewedFile (viewedFileFromReference f)
+  where
+	dir = joinPath $ beginning $ splitDirectories f

Test.hs

@@ -55,6 +55,7 @@ import qualified Crypto
 import qualified Annex.Init
 import qualified Annex.CatFile
 import qualified Annex.View
+import qualified Annex.View.ViewedFile
 import qualified Logs.View
 import qualified Utility.Path
 import qualified Utility.FileMode
@@ -151,6 +152,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
 	, testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize
 	, testProperty "prop_branchView_legal" Logs.View.prop_branchView_legal
 	, testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips
+	, testProperty "prop_viewedFile_rountrips" Annex.View.ViewedFile.prop_viewedFile_roundtrips
 	]
 
 {- These tests set up the test environment, but also test some basic parts