summaryrefslogtreecommitdiff
path: root/Property.hs
diff options
context:
space:
mode:
authorJoey Hess2014-03-30 15:31:57 -0400
committerJoey Hess2014-03-30 15:38:08 -0400
commit90efcd3203d64c2c5691e30ccc23307aae8d20c8 (patch)
tree183f38a857a81a3cb1a301b94f827f8a807dc961 /Property.hs
parent8d31a6226ac9e1dfc75ec7521f039a43e749ed82 (diff)
refactor
Diffstat (limited to 'Property.hs')
-rw-r--r--Property.hs142
1 files changed, 52 insertions, 90 deletions
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
- )