refactor

Common.hs

@@ -0,0 +1,18 @@
+module Common (module X) where
+
+import Property as X
+import Property.Cmd 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 System.FilePath as X
+import Data.Maybe as X
+import Data.Either as X
+import Utility.Monad as X

Propellor.hs

@@ -1,6 +1,5 @@
-import Property
+import Common
 import HostName
-import Utility.SafeCommand
 import qualified Property.File as File
 import qualified Property.Apt as Apt
 import qualified Property.Ssh as Ssh

Property.hs

@@ -1,7 +1,6 @@
 module Property where
 
 import System.Directory
-import Control.Applicative
 import Control.Monad
 import System.Console.ANSI
 import System.Exit
@@ -9,23 +8,18 @@ import System.IO
 
 import Utility.Monad
 import Utility.Exception
-import Utility.SafeCommand
-import Utility.Tmp
-import Utility.Env
 
--- Ensures that the system has some property. 
--- Actions must be idempotent; will be run repeatedly.
-data Property
-	= FileProperty Desc FilePath ([Line] -> [Line])
-	| CmdProperty Desc String [CommandParam] [(String, String)]
-	| IOProperty Desc (IO Result)
+data Property = Property
+	{ propertyDesc :: Desc
+	-- must be idempotent; may run repeatedly
+	, propertySatisfy :: IO Result
+	}
+
+type Desc = String
 
 data Result = NoChange | MadeChange | FailedChange
 	deriving (Show, Eq)
 
-type Line = String
-type Desc = String
-
 combineResult :: Result -> Result -> Result
 combineResult FailedChange _ = FailedChange
 combineResult _ FailedChange = FailedChange
@@ -33,10 +27,11 @@ combineResult MadeChange _ = MadeChange
 combineResult _ MadeChange = MadeChange
 combineResult NoChange NoChange = NoChange
 
-propertyDesc :: Property -> Desc
-propertyDesc (FileProperty d _ _) = d
-propertyDesc (CmdProperty d _ _ _) = d
-propertyDesc (IOProperty d _) = d
+makeChange :: IO () -> IO Result
+makeChange a = a >> return MadeChange
+
+noChange :: IO Result
+noChange = return NoChange
 
 {- Combines a list of properties, resulting in a single property
  - that when run will run each property in the list in turn,
@@ -44,12 +39,12 @@ propertyDesc (IOProperty d _) = d
  - on failure; does propigate overall success/failure.
  -}
 propertyList :: Desc -> [Property] -> Property
-propertyList desc ps = IOProperty desc $ ensureProperties' ps
+propertyList desc ps = Property desc $ ensureProperties' ps
 
 {- Combines a list of properties, resulting in one property that
  - ensures each in turn, stopping on failure. -}
 combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = IOProperty desc $ go ps NoChange
+combineProperties desc ps = Property desc $ go ps NoChange
   where
   	go [] rs = return rs
 	go (l:ls) rs = do
@@ -58,26 +53,45 @@ combineProperties desc ps = IOProperty desc $ go ps NoChange
 			FailedChange -> return FailedChange
 			_ -> go ls (combineResult r rs)
 
-ensureProperty :: Property -> IO Result
-ensureProperty = catchDefaultIO FailedChange . ensureProperty' 
-
-ensureProperty' :: Property -> IO Result
-ensureProperty' (FileProperty _ f a) = go =<< doesFileExist f
+{- Makes a perhaps non-idempotent Property be idempotent by using a flag
+ - file to indicate whether it has run before.
+ - Use with caution. -}
+flagFile :: Property -> FilePath -> Property
+flagFile property flagfile = Property (propertyDesc property) $
+	go =<< doesFileExist flagfile
   where
-	go True = do
-		ls <- lines <$> readFile f
-		let ls' = a ls
-		if ls' == ls
-			then noChange
-			else makeChange $ viaTmp writeFile f (unlines ls')
-	go False = makeChange $ writeFile f (unlines $ a [])
-ensureProperty' (CmdProperty _ cmd params env) = do
-	env' <- addEntries env <$> getEnvironment
-	ifM (boolSystemEnv cmd params (Just env'))
-		( return MadeChange
-		, return FailedChange
+	go True = return NoChange
+	go False = do
+		r <- ensureProperty property
+		when (r == MadeChange) $
+			writeFile flagfile ""
+		return r
+
+{- Whenever a change has to be made for a Property, causes a hook
+ - Property to also be run, but not otherwise. -}
+onChange :: Property -> Property -> Property
+property `onChange` hook = Property (propertyDesc property) $ do
+	r <- ensureProperty property
+	case r of
+		MadeChange -> do
+			r' <- ensureProperty hook
+			return $ combineResult r r'
+		_ -> return r
+
+{- Indicates that the first property can only be satisfied once
+ - the second is. -} 
+requires :: Property -> Property -> Property
+x `requires` y = combineProperties (propertyDesc x) [y, x]
+
+{- Makes a Property only be performed when a test succeeds. -}
+check :: IO Bool -> Property -> Property
+check c property = Property (propertyDesc property) $ ifM c
+	( ensureProperty property
+	, return NoChange
 	)
-ensureProperty' (IOProperty _ a) = a
+
+ensureProperty :: Property -> IO Result
+ensureProperty = catchDefaultIO FailedChange . propertySatisfy
 
 ensureProperties :: [Property] -> IO ()
 ensureProperties ps = do
@@ -109,55 +123,3 @@ ensureProperties' ps = ensure ps NoChange
 				putStrLn "done"
 		setSGR []
 		ensure ls (combineResult r rs)
-
-makeChange :: IO () -> IO Result
-makeChange a = a >> return MadeChange
-
-noChange :: IO Result
-noChange = return NoChange
-
-cmdProperty :: String -> [CommandParam] -> Property
-cmdProperty cmd params = cmdProperty' cmd params []
-
-cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property
-cmdProperty' cmd params env = CmdProperty desc cmd params env
-  where
-  	desc = unwords $ cmd : map showp params
-	showp (Params s) = s
-	showp (Param s) = s
-	showp (File s) = s
-
-{- Makes a perhaps non-idempotent Property be idempotent by using a flag
- - file to indicate whether it has run before.
- - Use with caution. -}
-flagFile :: Property -> FilePath -> Property
-flagFile property flagfile = IOProperty (propertyDesc property) $
-	go =<< doesFileExist flagfile
-  where
-	go True = return NoChange
-	go False = do
-		r <- ensureProperty property
-		when (r == MadeChange) $
-			writeFile flagfile ""
-		return r
-
-{- Whenever a change has to be made for a Property, causes a hook
- - Property to also be run, but not otherwise. -}
-onChange :: Property -> Property -> Property
-property `onChange` hook = IOProperty (propertyDesc property) $ do
-	r <- ensureProperty property
-	case r of
-		MadeChange -> do
-			r' <- ensureProperty hook
-			return $ combineResult r r'
-		_ -> return r
-
-requires :: Property -> Property -> Property
-x `requires` y = combineProperties (propertyDesc x) [y, x]
-
-{- Makes a Property only be performed when a test succeeds. -}
-check :: IO Bool -> Property -> Property
-check c property = IOProperty (propertyDesc property) $ ifM c
-	( ensureProperty property
-	, return NoChange
-	)

Property/Apt.hs

@@ -6,10 +6,9 @@ import Data.List
 import System.IO
 import Control.Monad
 
-import Property
+import Common
 import qualified Property.File as File
-import Utility.SafeCommand
-import Utility.Process
+import Property.File (Line)
 
 sourcesList :: FilePath
 sourcesList = "/etc/apt/sources.list"
@@ -109,7 +108,7 @@ unattendedUpgrades enabled = installed ["unattended-upgrades"]
 reConfigure :: Package -> [(String, String, String)] -> Property
 reConfigure package vals = reconfigure `requires` setselections
   where
-	setselections = IOProperty "preseed" $ makeChange $
+	setselections = Property "preseed" $ makeChange $
 		withHandle StdinHandle createProcessSuccess
 			(proc "debconf-set-selections" []) $ \h -> do
 				forM_ vals $ \(template, tmpltype, value) ->

Property/Cmd.hs

@@ -0,0 +1,28 @@
+module Property.Cmd (
+	cmdProperty,
+	cmdProperty',
+	module Utility.SafeCommand
+) where
+
+import Control.Applicative
+
+import Property
+import Utility.Monad
+import Utility.SafeCommand
+import Utility.Env
+
+cmdProperty :: String -> [CommandParam] -> Property
+cmdProperty cmd params = cmdProperty' cmd params []
+
+cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property
+cmdProperty' cmd params env = Property desc $ do
+	env' <- addEntries env <$> getEnvironment
+	ifM (boolSystemEnv cmd 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

Property/File.hs

@@ -1,18 +1,17 @@
 module Property.File where
 
-import System.Directory
+import Common
 
-import Property
-import Utility.Directory
+type Line = String
 
 {- Replaces all the content of a file. -}
 hasContent :: FilePath -> [Line] -> Property
-f `hasContent` newcontent = FileProperty ("replace " ++ f)
-	f (\_oldcontent -> newcontent)
+f `hasContent` newcontent = fileProperty ("replace " ++ f)
+	(\_oldcontent -> newcontent) f
 
 {- Ensures that a line is present in a file, adding it to the end if not. -}
 containsLine :: FilePath -> Line -> Property
-f `containsLine` l = FileProperty (f ++ " contains:" ++ l) f go
+f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f
   where
 	go ls
 		| l `elem` ls = ls
@@ -22,9 +21,20 @@ f `containsLine` l = FileProperty (f ++ " contains:" ++ l) f go
  - Note that the file is ensured to exist, so if it doesn't, an empty
  - file will be written. -}
 lacksLine :: FilePath -> Line -> Property
-f `lacksLine` l = FileProperty (f ++ " remove: " ++ l) f (filter (/= l))
+f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
 
 {- Note: Does not remove symlinks or non-plain-files. -}
 notPresent :: FilePath -> Property
-notPresent f = check (doesFileExist f) $ IOProperty (f ++ " not present") $ 
+notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $ 
 	makeChange $ nukeFile f
+
+fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
+fileProperty desc a f = Property desc $ go =<< doesFileExist f
+  where
+	go True = do
+		ls <- lines <$> catchDefaultIO [] (readFile f)
+		let ls' = a ls
+		if ls' == ls
+			then noChange
+			else makeChange $ viaTmp writeFile f (unlines ls')
+	go False = makeChange $ writeFile f (unlines $ a [])

Property/GitHome.hs

@@ -1,22 +1,13 @@
 module Property.GitHome where
 
-import System.FilePath
-import System.Directory
-import Control.Applicative
-import Control.Monad
-
-import Property
-import Property.User
-import Utility.SafeCommand
-import Utility.Directory
-import Utility.Monad
-import Utility.Exception
+import Common
 import qualified Property.Apt as Apt
+import Property.User
 
 {- Clones Joey Hess's git home directory, and runs its fixups script. -}
 installedFor :: UserName -> Property
 installedFor user = check (not <$> hasGitDir user) $ 
-	IOProperty ("githome " ++ user) (go =<< homedir user)
+	Property ("githome " ++ user) (go =<< homedir user)
 		`requires` Apt.installed ["git", "myrepos"]
   where
  	go Nothing = noChange

Property/Hostname.hs

@@ -1,8 +1,7 @@
 module Property.Hostname where
 
-import Property
+import Common
 import qualified Property.File as File
-import Utility.SafeCommand
 
 type HostName = String
 

Property/Reboot.hs

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

Property/Ssh.hs

@@ -1,14 +1,8 @@
 module Property.Ssh where
 
-import Control.Applicative
-import Control.Monad
-import System.FilePath
-
-import Property
-import Property.User
+import Common
 import qualified Property.File as File
-import Utility.SafeCommand
-import Utility.Exception
+import Property.User
 
 sshBool :: Bool -> String
 sshBool True = "yes"
@@ -48,7 +42,7 @@ uniqueHostKeys :: Property
 uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
 	`onChange` restartSshd
   where
-	prop = IOProperty "ssh unique host keys" $ do
+	prop = Property "ssh unique host keys" $ do
 		void $ boolSystem "sh"
 			[ Param "-c"
 			, Param "rm -f /etc/ssh/ssh_host_*"

Property/Tor.hs

@@ -1,7 +1,6 @@
 module Property.Tor where
 
-import Property
-import Utility.SafeCommand
+import Common
 import qualified Property.File as File
 import qualified Property.Apt as Apt
 

Property/User.hs

@@ -1,13 +1,8 @@
 module Property.User where
 
 import System.Posix
-import Control.Applicative
-import Data.Maybe
 
-import Property
-import Utility.SafeCommand
-import Utility.Exception
-import Utility.Process
+import Common
 
 type UserName = String