propellor/Property.hs

183 lines
5.4 KiB
Haskell
Raw Normal View History

module Property where
import System.Directory
import Control.Applicative
import Control.Monad
import System.Console.ANSI
import System.Exit
2014-03-30 05:24:57 +00:00
import System.IO
2014-03-30 05:13:53 +00:00
import Utility.Monad
import Utility.Exception
import Utility.SafeCommand
2014-03-30 05:13:53 +00:00
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])
2014-03-30 05:13:53 +00:00
| CmdProperty Desc String [CommandParam] [(String, String)]
| IOProperty Desc (IO Result)
data Result = NoChange | MadeChange | FailedChange
deriving (Show, Eq)
type Line = String
type Desc = String
combineResult :: Result -> Result -> Result
combineResult FailedChange _ = FailedChange
combineResult _ FailedChange = FailedChange
combineResult MadeChange _ = MadeChange
combineResult _ MadeChange = MadeChange
combineResult NoChange NoChange = NoChange
propertyDesc :: Property -> Desc
propertyDesc (FileProperty d _ _) = d
2014-03-30 05:13:53 +00:00
propertyDesc (CmdProperty d _ _ _) = d
propertyDesc (IOProperty d _) = d
2014-03-30 06:26:23 +00:00
{- Combines a list of properties, resulting in a single property
- that when run will run each property in the list in turn,
- and print out the description of each as it's run. Does not stop
- on failure; does propigate overall success/failure.
-}
propertyList :: Desc -> [Property] -> Property
propertyList desc ps = IOProperty 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
where
go [] rs = return rs
go (l:ls) rs = do
r <- ensureProperty l
case r of
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
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 [])
2014-03-30 05:13:53 +00:00
ensureProperty' (CmdProperty _ cmd params env) = do
env' <- addEntries env <$> getEnvironment
ifM (boolSystemEnv cmd params (Just env'))
( return MadeChange
, return FailedChange
)
ensureProperty' (IOProperty _ a) = a
2014-03-30 04:08:02 +00:00
ensureProperties :: [Property] -> IO ()
ensureProperties ps = do
2014-03-30 06:26:23 +00:00
r <- ensureProperties' ps
case r of
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
2014-03-30 06:26:23 +00:00
ensureProperties' :: [Property] -> IO Result
ensureProperties' ps = ensure ps NoChange
where
ensure [] rs = return rs
ensure (l:ls) rs = do
2014-03-30 05:24:57 +00:00
putStr $ propertyDesc l ++ "... "
hFlush stdout
r <- ensureProperty l
2014-03-30 05:24:57 +00:00
clearFromCursorToLineBeginning
setCursorColumn 0
2014-03-30 04:28:56 +00:00
putStr $ propertyDesc l ++ "... "
case r of
FailedChange -> do
setSGR [SetColor Foreground Vivid Red]
putStrLn "failed"
NoChange -> do
setSGR [SetColor Foreground Dull Green]
2014-03-30 05:21:21 +00:00
putStrLn "unchanged"
MadeChange -> do
setSGR [SetColor Foreground Vivid Green]
2014-03-30 05:24:57 +00:00
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
2014-03-30 05:13:53 +00:00
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
{- Replaces all the content of a file. -}
fileHasContent :: FilePath -> [Line] -> Property
fileHasContent f newcontent = FileProperty ("replace " ++ f)
f (\_oldcontent -> newcontent)
{- Ensures that a line is present in a file, adding it to the end if not. -}
lineInFile :: FilePath -> Line -> Property
lineInFile f l = FileProperty (f ++ " contains:" ++ l) f go
where
go ls
| l `elem` ls = ls
| otherwise = ls++[l]
{- Ensures that a line is not present in a file.
- Note that the file is ensured to exist, so if it doesn't, an empty
- file will be written. -}
lineNotInFile :: FilePath -> Line -> Property
lineNotInFile f l = FileProperty (f ++ " remove: " ++ l) f (filter (/= l))
{- 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
2014-03-30 04:52:02 +00:00
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
)