more prep for hackage

Propellor.hs

@@ -1,4 +1,6 @@
-module Propellor.Common (module X) where
+-- | Pulls in lots of useful modules for building Properties.
+
+module Propellor (module X) where
 
 import Propellor.Types as X
 import Propellor.Property as X
@@ -6,17 +8,18 @@ import Propellor.Property.Cmd as X
 import Propellor.PrivData as X
 
 import Utility.PartialPrelude as X
-import Control.Applicative as X
-import Control.Monad as X
 import Utility.Process as X
-import System.Directory as X
-import System.IO as X
 import Utility.Exception as X
 import Utility.Env as X
 import Utility.Directory as X
 import Utility.Tmp as X
+import Utility.Monad as X
+import Utility.Misc as X
+
+import System.Directory as X
+import System.IO as X
 import System.FilePath as X
 import Data.Maybe as X
 import Data.Either as X
-import Utility.Monad as X
-import Utility.Misc as X
+import Control.Applicative as X
+import Control.Monad as X

Propellor/CmdLine.hs

@@ -4,8 +4,9 @@ import System.Environment
 import Data.List
 import System.Exit
 
-import Propellor.Common
+import Propellor
 import Utility.FileMode
+import Utility.SafeCommand
 
 data CmdLine
 	= Run HostName

Propellor/Property/Apt.hs

@@ -6,7 +6,7 @@ import Data.List
 import System.IO
 import Control.Monad
 
-import Propellor.Common
+import Propellor
 import qualified Propellor.Property.File as File
 import Propellor.Property.File (Line)
 
@@ -51,7 +51,7 @@ stdSourcesList suite = setSourcesList (debCdn suite)
 setSourcesList :: [Line] -> Property
 setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
 
-runApt :: [CommandParam] -> Property
+runApt :: [String] -> Property
 runApt ps = cmdProperty' "apt-get" ps env
   where
 	env =
@@ -60,11 +60,11 @@ runApt ps = cmdProperty' "apt-get" ps env
 		]
 
 update :: Property
-update = runApt [Param "update"]
+update = runApt ["update"]
 	`describe` "apt update"
 
 upgrade :: Property
-upgrade = runApt [Params "-y dist-upgrade"]
+upgrade = runApt ["-y", "dist-upgrade"]
 	`describe` "apt dist-upgrade"
 
 type Package = String
@@ -73,13 +73,13 @@ installed :: [Package] -> Property
 installed ps = check (isInstallable ps) go
 	`describe` (unwords $ "apt installed":ps)
   where
-	go = runApt $ [Param "-y", Param "install"] ++ map Param ps
+	go = runApt $ ["-y", "install"] ++ ps
 
 removed :: [Package] -> Property
 removed ps = check (or <$> isInstalled' ps) go
 	`describe` (unwords $ "apt removed":ps)
   where
-	go = runApt $ [Param "-y", Param "remove"] ++ map Param ps
+	go = runApt $ ["-y", "remove"] ++ ps
 
 isInstallable :: [Package] -> IO Bool
 isInstallable ps = do
@@ -89,10 +89,10 @@ isInstallable ps = do
 isInstalled :: Package -> IO Bool
 isInstalled p = (== [True]) <$> isInstalled' [p]
 
-{- | Note that the order of the returned list will not always
- - correspond to the order of the input list. The number of items may
- - even vary. If apt does not know about a package at all, it will not
- - be included in the result list. -}
+-- | Note that the order of the returned list will not always
+-- correspond to the order of the input list. The number of items may
+-- even vary. If apt does not know about a package at all, it will not
+-- be included in the result list.
 isInstalled' :: [Package] -> IO [Bool]
 isInstalled' ps = catMaybes . map parse . lines
 	<$> readProcess "apt-cache" ("policy":ps)
@@ -103,7 +103,7 @@ isInstalled' ps = catMaybes . map parse . lines
 		| otherwise = Nothing
 
 autoRemove :: Property
-autoRemove = runApt [Param "-y", Param "autoremove"]
+autoRemove = runApt ["-y", "autoremove"]
 	`describe` "apt autoremove"
 
 unattendedUpgrades :: Bool -> Property
@@ -117,8 +117,8 @@ unattendedUpgrades enabled =
 		| enabled = "true"
 		| otherwise = "false"
 
-{- | Preseeds debconf values and reconfigures the package so it takes
- - effect. -}
+-- | Preseeds debconf values and reconfigures the package so it takes
+-- effect.
 reConfigure :: Package -> [(String, String, String)] -> Property
 reConfigure package vals = reconfigure `requires` setselections
 	`describe` ("reconfigure " ++ package)
@@ -129,4 +129,4 @@ reConfigure package vals = reconfigure `requires` setselections
 				forM_ vals $ \(template, tmpltype, value) ->
 					hPutStrLn h $ unwords [package, template, tmpltype, value]
 				hClose h
-	reconfigure = cmdProperty "dpkg-reconfigure" [Param "-fnone", Param package]
+	reconfigure = cmdProperty "dpkg-reconfigure" ["-fnone", package]

Propellor/Property/Cmd.hs

@@ -1,8 +1,7 @@
 module Propellor.Property.Cmd (
 	cmdProperty,
 	cmdProperty',
-	scriptProperty,
-	module Utility.SafeCommand
+	scriptProperty
 ) where
 
 import Control.Applicative
@@ -13,23 +12,26 @@ import Utility.Monad
 import Utility.SafeCommand
 import Utility.Env
 
-cmdProperty :: String -> [CommandParam] -> Property
+-- | A property that can be satisfied by running a command.
+--
+-- The command must exit 0 on success.
+cmdProperty :: String -> [String] -> Property
 cmdProperty cmd params = cmdProperty' cmd params []
 
-cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property
+-- | A property that can be satisfied by running a command,
+-- with added environment.
+cmdProperty' :: String -> [String] -> [(String, String)] -> Property
 cmdProperty' cmd params env = Property desc $ do
 	env' <- addEntries env <$> getEnvironment
-	ifM (boolSystemEnv cmd params (Just env'))
+	ifM (boolSystemEnv cmd (map Param params) (Just env'))
 		( return MadeChange
 		, return FailedChange
 		)
   where
-  	desc = unwords $ cmd : map showp params
-	showp (Params s) = s
-	showp (Param s) = s
-	showp (File s) = s
+  	desc = unwords $ cmd : params
 
+-- | A property that can be satisfied by running a series of shell commands.
 scriptProperty :: [String] -> Property
-scriptProperty script = cmdProperty "sh" [Param "-c", Param shellcmd]
+scriptProperty script = cmdProperty "sh" ["-c", shellcmd]
   where
 	shellcmd = intercalate " ; " ("set -e" : script)

Propellor/Property/Docker.hs

@@ -1,6 +1,6 @@
 module Propellor.Property.Docker where
 
-import Propellor.Common
+import Propellor
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 

Propellor/Property/File.hs

@@ -1,6 +1,6 @@
 module Propellor.Property.File where
 
-import Propellor.Common
+import Propellor
 
 type Line = String
 

Propellor/Property/GitHome.hs

@@ -1,8 +1,9 @@
 module Propellor.Property.GitHome where
 
-import Propellor.Common
+import Propellor
 import qualified Propellor.Property.Apt as Apt
 import Propellor.Property.User
+import Utility.SafeCommand
 
 {- | Clones Joey Hess's git home directory, and runs its fixups script. -}
 installedFor :: UserName -> Property

Propellor/Property/Hostname.hs

@@ -1,9 +1,9 @@
 module Propellor.Property.Hostname where
 
-import Propellor.Common
+import Propellor
 import qualified Propellor.Property.File as File
 
 set :: HostName -> Property
 set hostname = "/etc/hostname" `File.hasContent` [hostname]
-	`onChange` cmdProperty "hostname" [Param hostname]
+	`onChange` cmdProperty "hostname" [hostname]
 	`describe` ("hostname " ++ hostname)

Propellor/Property/JoeySites.hs

@@ -3,7 +3,7 @@
 
 module Propellor.Property.JoeySites where
 
-import Propellor.Common
+import Propellor
 import qualified Propellor.Property.Apt as Apt
 
 oldUseNetshellBox :: Property

Propellor/Property/Network.hs

@@ -1,6 +1,6 @@
 module Propellor.Property.Network where
 
-import Propellor.Common
+import Propellor
 import Propellor.Property.File
 
 interfaces :: FilePath
@@ -24,4 +24,4 @@ ipv6to4 = fileProperty "ipv6to4" go interfaces
 		]
 
 ifUp :: String -> Property
-ifUp iface = cmdProperty "ifup" [Param iface]
+ifUp iface = cmdProperty "ifup" [iface]

Propellor/Property/Reboot.hs

@@ -1,6 +1,6 @@
 module Propellor.Property.Reboot where
 
-import Propellor.Common
+import Propellor
 
 now :: Property
 now = cmdProperty "reboot" []

Propellor/Property/Ssh.hs

@@ -1,8 +1,9 @@
 module Propellor.Property.Ssh where
 
-import Propellor.Common
+import Propellor
 import qualified Propellor.Property.File as File
 import Propellor.Property.User
+import Utility.SafeCommand
 
 sshBool :: Bool -> String
 sshBool True = "yes"
@@ -35,7 +36,7 @@ hasAuthorizedKeys = go <=< homedir
 		(readFile $ home </> ".ssh" </> "authorized_keys")
 
 restartSshd :: Property
-restartSshd = cmdProperty "service" [Param "ssh", Param "restart"]
+restartSshd = cmdProperty "service" ["ssh", "restart"]
 
 {- | Blow away existing host keys and make new ones. Use a flag
  - file to prevent doing this more than once. -}
@@ -50,4 +51,4 @@ uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
 			]
 		ensureProperty $
 			cmdProperty "/var/lib/dpkg/info/openssh-server.postinst"
-				[Param "configure"]
+				["configure"]

Propellor/Property/Sudo.hs

@@ -2,7 +2,7 @@ module Propellor.Property.Sudo where
 
 import Data.List
 
-import Propellor.Common
+import Propellor
 import Propellor.Property.File
 import qualified Propellor.Property.Apt as Apt
 import Propellor.Property.User

Propellor/Property/Tor.hs

@@ -1,6 +1,6 @@
 module Propellor.Property.Tor where
 
-import Propellor.Common
+import Propellor
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 
@@ -16,4 +16,4 @@ isBridge = setup `requires` Apt.installed ["tor"]
 		] `onChange` restartTor
 
 restartTor :: Property
-restartTor = cmdProperty "service" [Param "tor", Param "restart"]
+restartTor = cmdProperty "service" ["tor", "restart"]

Propellor/Property/User.hs

@@ -2,23 +2,23 @@ module Propellor.Property.User where
 
 import System.Posix
 
-import Propellor.Common
+import Propellor
 
 data Eep = YesReallyDeleteHome
 
 sshAccountFor :: UserName -> Property
 sshAccountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
-	[ Param "--disabled-password"
-	, Param "--gecos", Param ""
-	, Param user
+	[ "--disabled-password"
+	, "--gecos", ""
+	, user
 	]
 	`describe` ("ssh account " ++ user)
 
 {- | Removes user home directory!! Use with caution. -}
 nuked :: UserName -> Eep -> Property
 nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel"
-	[ Param "-r"
-	, Param user
+	[ "-r"
+	, user
 	]
 	`describe` ("nuked user " ++ user)
 
@@ -38,8 +38,8 @@ hasPassword user = Property (user ++ " has password") $
 
 lockedPassword :: UserName -> Property
 lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
-	[ Param "--lock"
-	, Param user
+	[ "--lock"
+	, user
 	]
 	`describe` ("locked " ++ user ++ " password")
 

propellor.cabal

@@ -43,6 +43,7 @@ Library
     Build-Depends: unix
 
   Exposed-Modules:
+    Propellor
     Propellor.Property
     Propellor.Property.Apt
     Propellor.Property.Cmd
@@ -58,7 +59,6 @@ Library
     Propellor.Property.Tor
     Propellor.Property.User
     Propellor.CmdLine
-    Propellor.Common
     Propellor.PrivData
     Propellor.Types
   Other-Modules:

propellor.hs

@@ -1,4 +1,4 @@
-import Propellor.Common
+import Propellor
 import Propellor.CmdLine
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
@@ -71,7 +71,7 @@ cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"
 	, "worked around grub/lvm boot bug #743126" ==>
 		"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
 		`onChange` cmdProperty "update-grub" []
-		`onChange` cmdProperty "update-initramfs" [Param "-u"]
+		`onChange` cmdProperty "update-initramfs" ["-u"]
 	, "nuked cloudatcost cruft" ==> combineProperties
 		[ File.notPresent "/etc/rc.local"
 		, File.notPresent "/etc/init.d/S97-setup.sh"