From 5f41492d8afe6ac6ee3cc280c3e2f252bcc91817 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 28 Mar 2016 04:46:21 -0400 Subject: propellor spin --- src/Propellor/Property.hs | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) (limited to 'src/Propellor/Property.hs') diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 7878912b..55c39ee2 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -28,6 +28,7 @@ module Propellor.Property ( , pickOS , withOS , unsupportedOS + , unsupportedOS' , makeChange , noChange , doNothing @@ -292,7 +293,7 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b] then getSatisfy a else if matching o b then getSatisfy b - else unsupportedOS + else unsupportedOS' matching Nothing _ = False matching (Just o) p = Targeting (systemToTargetOS o) @@ -307,7 +308,7 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b] -- > myproperty = withOS "foo installed" $ \w o -> case o of -- > (Just (System (Debian (Stable release)) arch)) -> ensureProperty w ... -- > (Just (System (Debian suite) arch)) -> ensureProperty w ... --- > _ -> unsupportedOS +-- > _ -> unsupportedOS' -- -- Note that the operating system specifics may not be declared for all hosts, -- which is where Nothing comes in. @@ -324,21 +325,18 @@ withOS desc a = property desc $ a dummyoutermetatypes =<< getOS dummyoutermetatypes :: OuterMetaTypesWitness ('[]) dummyoutermetatypes = OuterMetaTypesWitness sing -class UnsupportedOS a where - unsupportedOS :: a +-- | A property that always fails with an unsupported OS error. +unsupportedOS :: Property UnixLike +unsupportedOS = property "unsupportedOS" unsupportedOS' -- | Throws an error, for use in `withOS` when a property is lacking -- support for an OS. -instance UnsupportedOS (Propellor a) where - unsupportedOS = go =<< getOS +unsupportedOS' :: Propellor Result +unsupportedOS' = go =<< getOS where go Nothing = error "Unknown host OS is not supported by this property." go (Just o) = error $ "This property is not implemented for " ++ show o --- | A property that always fails with an unsupported OS error. -instance UnsupportedOS (Property UnixLike) where - unsupportedOS = property "unsupportedOS" unsupportedOS - -- | Undoes the effect of a RevertableProperty. revert :: RevertableProperty setup undo -> RevertableProperty undo setup revert (RevertableProperty p1 p2) = RevertableProperty p2 p1 -- cgit v1.2.3