From 90efcd3203d64c2c5691e30ccc23307aae8d20c8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Mar 2014 15:31:57 -0400 Subject: refactor --- Property.hs | 142 ++++++++++++++++++++++-------------------------------------- 1 file changed, 52 insertions(+), 90 deletions(-) (limited to 'Property.hs') diff --git a/Property.hs b/Property.hs index f00ddfa2..4055ab2a 100644 --- a/Property.hs +++ b/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 - ) -ensureProperty' (IOProperty _ a) = a + 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 :: 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 - ) -- cgit v1.3-2-g0d8e