module Propellor.Property.Laptop where

import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Systemd as Systemd

-- | Makes powertop auto-tune the system for optimal power consumption on
-- boot.
powertopAutoTuneOnBoot :: RevertableProperty DebianLike DebianLike
powertopAutoTuneOnBoot :: RevertableProperty DebianLike DebianLike
powertopAutoTuneOnBoot = Property DebianLike
setup Property DebianLike
-> Property DebianLike -> RevertableProperty DebianLike DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
undo
	RevertableProperty DebianLike DebianLike
-> Desc -> RevertableProperty DebianLike DebianLike
forall p. IsProp p => p -> Desc -> p
`describe` Desc
"powertop auto-tune on boot"
  where
	setup :: CombinedType (Property DebianLike) (Property UnixLike)
setup = Desc -> Property Linux
Systemd.enabled Desc
"powertop"
		Property Linux
-> Property DebianLike
-> CombinedType (Property Linux) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Desc] -> Property DebianLike
Apt.installed [Desc
"powertop"]
		Property DebianLike
-> Property UnixLike
-> CombinedType (Property DebianLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Desc -> [Desc] -> Property UnixLike
File.hasContent Desc
servicefile
			[ Desc
"[Unit]"
			, Desc
"Description=Powertop tunings"
			, Desc
"[Service]"
			, Desc
"ExecStart=/usr/sbin/powertop --auto-tune"
			, Desc
"RemainAfterExit=true"
			, Desc
"[Install]"
			, Desc
"WantedBy=multi-user.target"
			]
	undo :: Property DebianLike
undo = Property Linux -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property Linux -> Property DebianLike)
-> Property Linux -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Desc -> Property UnixLike
File.notPresent Desc
servicefile
		Property UnixLike
-> Property Linux
-> CombinedType (Property UnixLike) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` IO Bool -> Property Linux -> Property Linux
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Desc -> IO Bool
doesFileExist Desc
servicefile)
			(Desc -> Property Linux
Systemd.disabled Desc
"powertop")
	servicefile :: Desc
servicefile = Desc
"/etc/systemd/system/powertop.service"

-- | Enables weekly TRIM for SSDs, using systemd's fstrim.timer,
trimSSD :: Property Linux
trimSSD :: Property Linux
trimSSD = Desc -> Property Linux
Systemd.enabled Desc
"fstrim.timer"