summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2016-03-24 16:56:01 -0400
committerJoey Hess2016-03-24 16:56:01 -0400
commitc0236e92be55cec267b425a3b1fffc65b119b1aa (patch)
treeac197a09d9d53f81047f53c3ec9cd3a4027597ed /src/Propellor
parentf1168d4b46e9a1c73afe4885f1b14b1bd81b7d50 (diff)
converted PrivData
Somewhat poorly; I don't like needing to export the Property constructor to use it here, and there's a use of undefined where it should be able to use sing. I got quite stuck on this, so am happy to have anything that works.
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/PrivData.hs37
-rw-r--r--src/Propellor/Types.hs12
2 files changed, 33 insertions, 16 deletions
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index bc09f0c6..6f3d4771 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -2,6 +2,8 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
module Propellor.PrivData (
withPrivData,
@@ -40,6 +42,7 @@ import Prelude
import Propellor.Types
import Propellor.Types.PrivData
+import Propellor.Types.MetaTypes
import Propellor.Types.Info
import Propellor.Message
import Propellor.Info
@@ -75,29 +78,41 @@ import Utility.FileSystemEncoding
-- being used, which is necessary to ensure that the privdata is sent to
-- the remote host by propellor.
withPrivData
- :: (IsContext c, IsPrivDataSource s, IsProp (Property i))
+ ::
+ ( IsContext c
+ , IsPrivDataSource s
+ , IncludesInfo metatypes ~ True
+ )
=> s
-> c
- -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property i)
- -> Property HasInfo
+ -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property metatypes)
+ -> Property metatypes
withPrivData s = withPrivData' snd [s]
-- Like withPrivData, but here any one of a list of PrivDataFields can be used.
withSomePrivData
- :: (IsContext c, IsPrivDataSource s, IsProp (Property i))
+ ::
+ ( IsContext c
+ , IsPrivDataSource s
+ , IncludesInfo metatypes ~ True
+ )
=> [s]
-> c
- -> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property i)
- -> Property HasInfo
+ -> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property metatypes)
+ -> Property metatypes
withSomePrivData = withPrivData' id
withPrivData'
- :: (IsContext c, IsPrivDataSource s, IsProp (Property i))
+ ::
+ ( IsContext c
+ , IsPrivDataSource s
+ , IncludesInfo metatypes ~ True
+ )
=> ((PrivDataField, PrivData) -> v)
-> [s]
-> c
- -> (((v -> Propellor Result) -> Propellor Result) -> Property i)
- -> Property HasInfo
+ -> (((v -> Propellor Result) -> Propellor Result) -> Property metatypes)
+ -> Property metatypes
withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
maybe missing (a . feed) =<< getM get fieldlist
where
@@ -112,7 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
"Fix this by running:" :
showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
return FailedChange
- addinfo p = infoProperty
+ addinfo p = Property undefined -- FIXME: should use sing here
(propertyDesc p)
(propertySatisfy p)
(propertyInfo p `addInfo` privset)
@@ -132,7 +147,7 @@ showSet = concatMap go
, Just ""
]
-addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property HasInfo
+addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property (HasInfo + UnixLike)
addPrivData v = pureInfoProperty (show v) (PrivInfo (S.singleton v))
{- Gets the requested field's value, in the specified context if it's
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 49ba9220..866e8090 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -12,10 +12,10 @@
module Propellor.Types
( Host(..)
- , Property
+ , Property(..)
, Info
, Desc
- , mkProperty
+ , property
, MetaType(..)
, OS(..)
, UnixLike
@@ -43,6 +43,7 @@ module Propellor.Types
, module Propellor.Types.Result
, module Propellor.Types.ZFS
, propertySatisfy
+ , Sing
) where
import Data.Monoid
@@ -127,7 +128,8 @@ data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
instance Show ChildProperty where
show (ChildProperty desc _ _ _) = desc
--- | Constructs a Property.
+-- | Constructs a Property, from a description and an action to run to
+-- ensure the Property is met.
--
-- You can specify any metatypes that make sense to indicate what OS
-- the property targets, etc.
@@ -138,12 +140,12 @@ instance Show ChildProperty where
-- > foo = mkProperty "foo" (...)
--
-- Note that using this needs LANGUAGE PolyKinds.
-mkProperty
+property
:: SingI metatypes
=> Desc
-> Propellor Result
-> Property (Sing metatypes)
-mkProperty d a = Property sing d a mempty mempty
+property d a = Property sing d a mempty mempty
-- | Adds info to a Property.
--