diff options
author | 2014-02-22 14:54:53 -0400 | |
---|---|---|
committer | 2014-02-22 14:54:53 -0400 | |
commit | 0430ac2a21a7e1fefb959d2b370e39252b27da01 (patch) | |
tree | 29caeebdfddcc9960ae725026e3e03a2dbebc70b | |
parent | 8e609f7a026795a106a819916e7d6756544b528e (diff) |
change directory encoding in ViewedFile such that the original directory can be extracted from it
-rw-r--r-- | Annex/View/ViewedFile.hs | 53 | ||||
-rw-r--r-- | Test.hs | 2 |
2 files changed, 43 insertions, 12 deletions
diff --git a/Annex/View/ViewedFile.hs b/Annex/View/ViewedFile.hs index b773e728d..9f6a3748b 100644 --- a/Annex/View/ViewedFile.hs +++ b/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 - - in some way. However, the branch's directory structure is not replicated - - in the view. + - 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 - - - - (To avoid collisions with a filename that already contains {foo}, - - that is doubled to {{foo}}.) + - So, from dir/subdir/file.foo, generate file_%dir%subdir%.foo -} viewedFileFromReference :: MkViewedFile viewedFileFromReference f = concat - [ double base - , if null dirs then "" else "_{" ++ double (intercalate ";" dirs) ++ "}" - , double $ concat extensions + [ 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 - 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 @@ -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 |