module Propellor.Property.SiteSpecific.GitHome where

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

-- | Clones Joey Hess's git home directory, and runs its fixups script.
installedFor :: User -> Property DebianLike
installedFor :: User -> Property DebianLike
installedFor user :: User
user@(User UserName
u) = IO Bool -> Property DebianLike -> Property DebianLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> IO Bool
hasGitDir User
user) (Property DebianLike -> Property DebianLike)
-> Property DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ 
	Property DebianLike
go Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [UserName] -> Property DebianLike
Apt.installed [UserName
"git"]
  where
	go :: Property DebianLike
	go :: Property DebianLike
go = UserName
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
UserName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (UserName
"githome " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
u) ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
  -> Propellor Result)
 -> Property DebianLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
		home <- IO UserName -> Propellor UserName
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (User -> IO UserName
homedir User
user)
		let tmpdir = UserName
home UserName -> UserName -> UserName
</> UserName
"githome"
		ensureProperty w $ combineProperties "githome setup" $ toProps
			[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
				`assume` MadeChange
			, property "moveout" $ makeChange $ void $
				moveout tmpdir home
			, property "rmdir" $ makeChange $ void $
				catchMaybeIO $ removeDirectory tmpdir
			, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile"]
				`assume` MadeChange
			-- Set HOSTNAME so that this sees the right
			-- hostname when run in a chroot with a different
			-- hostname than the current one.
			, userScriptProperty user ["HOSTNAME=$(cat /etc/hostname) bin/mr checkout"]
				`assume` MadeChange
			, userScriptProperty user ["bin/fixups"]
				`assume` MadeChange
			]
	moveout :: UserName -> UserName -> IO [Bool]
moveout UserName
tmpdir UserName
home = do
		fs <- UserName -> IO [UserName]
dirContents UserName
tmpdir
		forM fs $ \UserName
f -> UserName -> [CommandParam] -> IO Bool
boolSystem UserName
"mv" [UserName -> CommandParam
File UserName
f, UserName -> CommandParam
File UserName
home]

url :: String
url :: UserName
url = UserName
"git://git.kitenet.net/joey/home"

hasGitDir :: User -> IO Bool
hasGitDir :: User -> IO Bool
hasGitDir User
user = UserName -> IO Bool
go (UserName -> IO Bool) -> IO UserName -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< User -> IO UserName
homedir User
user
  where
	go :: UserName -> IO Bool
go UserName
home = UserName -> IO Bool
doesDirectoryExist (UserName
home UserName -> UserName -> UserName
</> UserName
".git")