1{- git-annex export types
2 -
3 - Copyright 2017 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE DeriveGeneric #-}
9
10module Types.Export (
11	ExportLocation,
12	mkExportLocation,
13	fromExportLocation,
14	ExportDirectory,
15	mkExportDirectory,
16	fromExportDirectory,
17	exportDirectories,
18) where
19
20import Git.FilePath
21import Utility.Split
22import Utility.FileSystemEncoding
23
24import qualified System.FilePath.Posix as Posix
25import GHC.Generics
26import Control.DeepSeq
27
28-- A location on a remote that a key can be exported to.
29-- The RawFilePath will be relative to the top of the remote,
30-- and uses unix-style path separators.
31newtype ExportLocation = ExportLocation RawFilePath
32	deriving (Show, Eq, Generic)
33
34instance NFData ExportLocation
35
36mkExportLocation :: RawFilePath -> ExportLocation
37mkExportLocation = ExportLocation . toInternalGitPath
38
39fromExportLocation :: ExportLocation -> RawFilePath
40fromExportLocation (ExportLocation f) = f
41
42newtype ExportDirectory = ExportDirectory RawFilePath
43	deriving (Show, Eq)
44
45mkExportDirectory :: RawFilePath -> ExportDirectory
46mkExportDirectory = ExportDirectory . toInternalGitPath
47
48fromExportDirectory :: ExportDirectory -> RawFilePath
49fromExportDirectory (ExportDirectory f) = f
50
51-- | All subdirectories down to the ExportLocation, with the deepest ones
52-- last. Does not include the top of the export.
53exportDirectories :: ExportLocation -> [ExportDirectory]
54exportDirectories (ExportLocation f) =
55	map (ExportDirectory . encodeBS . Posix.joinPath . reverse) (subs [] dirs)
56  where
57	subs _ [] = []
58	subs ps (d:ds) = (d:ps) : subs (d:ps) ds
59
60	dirs = map Posix.dropTrailingPathSeparator $
61		dropFromEnd 1 $ Posix.splitPath $ decodeBS f
62