module Propellor.Property.Rsync where

import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Pacman as Pacman

type Src = FilePath
type Dest = FilePath

class RsyncParam p where
	toRsync :: p -> String

-- | A pattern that matches all files under a directory, but does not
-- match the directory itself.
filesUnder :: FilePath -> Pattern
filesUnder :: FilePath -> Pattern
filesUnder FilePath
d = FilePath -> Pattern
Pattern (FilePath
d forall a. [a] -> [a] -> [a]
++ FilePath
"/*")

-- | Ensures that the Dest directory exists and has identical contents as
-- the Src directory.
syncDir :: Src -> Dest -> Property (DebianLike + ArchLinux)
syncDir :: FilePath -> FilePath -> Property (DebianLike + ArchLinux)
syncDir = [Filter]
-> FilePath -> FilePath -> Property (DebianLike + ArchLinux)
syncDirFiltered []

data Filter 
	= Include Pattern
	| Exclude Pattern
	| Protect Pattern

instance RsyncParam Filter where
	toRsync :: Filter -> FilePath
toRsync (Include (Pattern FilePath
p)) = FilePath
"--include=" forall a. [a] -> [a] -> [a]
++ FilePath
p
	toRsync (Exclude (Pattern FilePath
p)) = FilePath
"--exclude=" forall a. [a] -> [a] -> [a]
++ FilePath
p
	toRsync (Protect (Pattern FilePath
p)) = FilePath
"--filter=P " forall a. [a] -> [a] -> [a]
++ FilePath
p

-- | A pattern to match against files that rsync is going to transfer.
--
-- See "INCLUDE/EXCLUDE PATTERN RULES" in the rsync(1) man page.
--
-- For example, Pattern "/foo/*" matches all files under the "foo"
-- directory, relative to the 'Src' that rsync is acting on.
newtype Pattern = Pattern String

-- | Like syncDir, but avoids copying anything that the filter list
-- excludes. Anything that's filtered out will be deleted from Dest.
--
-- Rsync checks each name to be transferred against its list of Filter
-- rules, and the first matching one is acted on. If no matching rule
-- is found, the file is processed.
syncDirFiltered :: [Filter] -> Src -> Dest -> Property (DebianLike + ArchLinux)
syncDirFiltered :: [Filter]
-> FilePath -> FilePath -> Property (DebianLike + ArchLinux)
syncDirFiltered [Filter]
filters FilePath
src FilePath
dest = [FilePath] -> Property (DebianLike + ArchLinux)
rsync forall a b. (a -> b) -> a -> b
$
	[ FilePath
"-a"
	-- Add trailing '/' to get rsync to sync the Dest directory,
	-- rather than a subdir inside it, which it will do without a
	-- trailing '/'.
	, FilePath -> FilePath
addTrailingPathSeparator FilePath
src
	, FilePath -> FilePath
addTrailingPathSeparator FilePath
dest
	, FilePath
"--delete"
	, FilePath
"--delete-excluded"
	, FilePath
"--info=progress2"
	] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall p. RsyncParam p => p -> FilePath
toRsync [Filter]
filters

rsync :: [String] -> Property (DebianLike + ArchLinux)
rsync :: [FilePath] -> Property (DebianLike + ArchLinux)
rsync [FilePath]
ps = FilePath -> [FilePath] -> UncheckedProperty UnixLike
cmdProperty FilePath
"rsync" [FilePath]
ps
	forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property (DebianLike + ArchLinux)
installed

installed :: Property (DebianLike + ArchLinux)
installed :: Property (DebianLike + ArchLinux)
installed = [FilePath] -> Property DebianLike
Apt.installed [FilePath
"rsync"] forall {k} ka kb (c :: k) (a :: ka) (b :: kb).
(HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
 DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
 SingI c) =>
Property (MetaTypes a)
-> Property (MetaTypes b) -> Property (MetaTypes c)
`pickOS` [FilePath] -> Property ArchLinux
Pacman.installed [FilePath
"rsync"]