158 lines
4.4 KiB
Haskell
158 lines
4.4 KiB
Haskell
module Property where
|
|
|
|
import System.Directory
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import System.Console.ANSI
|
|
import System.Exit
|
|
import System.IO
|
|
|
|
import Utility.Tmp
|
|
import Utility.Exception
|
|
import Utility.SafeCommand
|
|
import Utility.Monad
|
|
|
|
-- 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]
|
|
| 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
|
|
propertyDesc (CmdProperty d _ _) = d
|
|
propertyDesc (IOProperty d _) = d
|
|
|
|
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 [])
|
|
ensureProperty' (CmdProperty _ cmd params) = ifM (boolSystem cmd params)
|
|
( return MadeChange
|
|
, return FailedChange
|
|
)
|
|
ensureProperty' (IOProperty _ a) = a
|
|
|
|
ensureProperties :: [Property] -> IO ()
|
|
ensureProperties ps = do
|
|
r <- ensure ps NoChange
|
|
case r of
|
|
FailedChange -> exitWith (ExitFailure 1)
|
|
_ -> exitWith ExitSuccess
|
|
where
|
|
ensure [] rs = return rs
|
|
ensure (l:ls) rs = do
|
|
putStr $ propertyDesc l ++ "... "
|
|
hFlush stdout
|
|
r <- ensureProperty l
|
|
case r of
|
|
FailedChange -> do
|
|
setSGR [SetColor Foreground Vivid Red]
|
|
putStrLn "failed"
|
|
NoChange -> do
|
|
setSGR [SetColor Foreground Dull Green]
|
|
putStrLn "(ok)"
|
|
MadeChange -> do
|
|
setSGR [SetColor Foreground Vivid Green]
|
|
putStrLn "(ok)"
|
|
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 desc cmd params
|
|
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
|
|
|
|
{- 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
|
|
)
|