summaryrefslogtreecommitdiff
path: root/src/Propellor/Types
diff options
context:
space:
mode:
authorJoey Hess2016-03-09 11:00:21 -0400
committerJoey Hess2016-03-09 11:00:21 -0400
commit892462ce5be7b37d2a24c1eee662f7d36dbaec82 (patch)
tree8e4a36a25c3d6824060e2ced975e12d84c088c99 /src/Propellor/Types
parenta08ec3412b45a49d3668a6d6439d1c81b05612ab (diff)
added protype of ensureProperty that prevents running properties in the wrong OS
Diffstat (limited to 'src/Propellor/Types')
-rw-r--r--src/Propellor/Types/OS/Typelevel.hs32
1 files changed, 25 insertions, 7 deletions
diff --git a/src/Propellor/Types/OS/Typelevel.hs b/src/Propellor/Types/OS/Typelevel.hs
index 0c2e76bf..3d4eeb8f 100644
--- a/src/Propellor/Types/OS/Typelevel.hs
+++ b/src/Propellor/Types/OS/Typelevel.hs
@@ -7,7 +7,7 @@ module Propellor.Types.OS.TypeLevel (
buntish,
freeBSD,
unixlike,
- combineSupportedOS,
+ includeSupportedOS,
intersectSupportedOS,
) where
@@ -41,17 +41,35 @@ freeBSD = typeOS OSFreeBSD
typeOS :: SupportedOS -> OSList os
typeOS o = OSList [o]
-foo :: OSList '[OSDebian, OSFreeBSD]
-foo = (debian `combineSupportedOS` freeBSD ) `intersectSupportedOS` unixlike
+data Property os = Property os (IO ())
--- | Combines two lists of supported OS's, yielding a list with the
--- contents of both.
-combineSupportedOS
+mkProperty :: os -> IO () -> Property os
+mkProperty os a = Property os a
+
+-- Intentionally a type error! :)
+--foo :: Property (OSList '[OSDebian, OSFreeBSD])
+--foo = mkProperty supportedos $ do
+-- ensureProperty supportedos jail
+-- where supportedos = includeSupportedOS debian
+
+jail :: Property (OSList '[OSFreeBSD])
+jail = Property freeBSD $ do
+ return ()
+
+ensureProperty
+ :: (CannotCombineOS outeros inneros (IntersectOSList outeros inneros) ~ CanCombineOS)
+ => OSList outeros
+ -> Property (OSList inneros)
+ -> IO ()
+ensureProperty outeros (Property inneros a) = a
+
+-- | Adds to a list of supported OS's.
+includeSupportedOS
:: (r ~ ConcatOSList l1 l2)
=> OSList l1
-> OSList l2
-> OSList r
-combineSupportedOS (OSList l1) (OSList l2) = OSList (l1 ++ l2)
+includeSupportedOS (OSList l1) (OSList l2) = OSList (l1 ++ l2)
-- | Type level concat for OSList.
type family ConcatOSList (list1 :: [a]) (list2 :: [a]) :: [a]