File: Export.hs

package info (click to toggle)
git-annex 8.20210223-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 68,764 kB
  • sloc: haskell: 70,359; javascript: 9,103; sh: 1,304; makefile: 212; perl: 136; ansic: 44
file content (61 lines) | stat: -rw-r--r-- 1,714 bytes parent folder | download
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
{- git-annex export types
 -
 - Copyright 2017 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE DeriveGeneric #-}

module Types.Export (
	ExportLocation,
	mkExportLocation,
	fromExportLocation,
	ExportDirectory,
	mkExportDirectory,
	fromExportDirectory,
	exportDirectories,
) where

import Git.FilePath
import Utility.Split
import Utility.FileSystemEncoding

import qualified System.FilePath.Posix as Posix
import GHC.Generics
import Control.DeepSeq

-- A location on a remote that a key can be exported to.
-- The RawFilePath will be relative to the top of the remote,
-- and uses unix-style path separators.
newtype ExportLocation = ExportLocation RawFilePath
	deriving (Show, Eq, Generic)

instance NFData ExportLocation

mkExportLocation :: RawFilePath -> ExportLocation
mkExportLocation = ExportLocation . toInternalGitPath

fromExportLocation :: ExportLocation -> RawFilePath
fromExportLocation (ExportLocation f) = f

newtype ExportDirectory = ExportDirectory RawFilePath
	deriving (Show, Eq)

mkExportDirectory :: RawFilePath -> ExportDirectory
mkExportDirectory = ExportDirectory . toInternalGitPath

fromExportDirectory :: ExportDirectory -> RawFilePath
fromExportDirectory (ExportDirectory f) = f

-- | All subdirectories down to the ExportLocation, with the deepest ones
-- last. Does not include the top of the export.
exportDirectories :: ExportLocation -> [ExportDirectory]
exportDirectories (ExportLocation f) =
	map (ExportDirectory . encodeBS . Posix.joinPath . reverse) (subs [] dirs)
  where
	subs _ [] = []
	subs ps (d:ds) = (d:ps) : subs (d:ps) ds

	dirs = map Posix.dropTrailingPathSeparator $
		dropFromEnd 1 $ Posix.splitPath $ decodeBS f