{-# LANGUAGE DeriveGeneric #-}
module Puppet.Language.NativeTypes.Package
( nativePackage
) where
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as Set
import Puppet.Language.NativeTypes.Helpers
nativePackage :: (NativeTypeName, NativeTypeMethods)
nativePackage = ("package", nativetypemethods parameterfunctions (getFeature >=> checkFeatures))
data PackagingFeatures
= Holdable
| InstallOptions
| Installable
| Purgeable
| UninstallOptions
| Uninstallable
| Upgradeable
| Versionable
deriving (Show, Eq, Generic)
instance Pretty PackagingFeatures where
pretty = ppline . show
instance Hashable PackagingFeatures
isFeatureSupported :: HashMap Text (HashSet PackagingFeatures)
isFeatureSupported = HM.fromList [ ("aix", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
, ("appdmg", Set.fromList [Installable])
, ("apple", Set.fromList [Installable])
, ("apt", Set.fromList [Holdable, InstallOptions, Installable, Purgeable, Uninstallable, Upgradeable, Versionable])
, ("aptitude", Set.fromList [Holdable, Installable, Purgeable, Uninstallable, Upgradeable, Versionable])
, ("aptrpm", Set.fromList [Installable, Purgeable, Uninstallable, Upgradeable, Versionable])
, ("blastwave", Set.fromList [Installable, Uninstallable, Upgradeable])
, ("dpkg", Set.fromList [Holdable, Installable, Purgeable, Uninstallable, Upgradeable])
, ("fink", Set.fromList [Holdable, Installable, Purgeable, Uninstallable, Upgradeable, Versionable])
, ("freebsd", Set.fromList [Installable, Uninstallable])
, ("gem", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
, ("hpux", Set.fromList [Installable, Uninstallable])
, ("macports", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
, ("msi", Set.fromList [InstallOptions, Installable, UninstallOptions, Uninstallable])
, ("nim", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
, ("openbsd", Set.fromList [Installable, Uninstallable, Versionable])
, ("pacman", Set.fromList [Installable, Uninstallable, Upgradeable])
, ("pip", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
, ("pkg", Set.fromList [Holdable, Installable, Uninstallable, Upgradeable, Versionable])
, ("pkgdmg", Set.fromList [Installable])
, ("pkgin", Set.fromList [Installable, Uninstallable])
, ("pkgutil", Set.fromList [Installable, Uninstallable, Upgradeable])
, ("portage", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
, ("ports", Set.fromList [Installable, Uninstallable, Upgradeable])
, ("portupgrade", Set.fromList [Installable, Uninstallable, Upgradeable])
, ("rpm", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
, ("rug", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
, ("sun", Set.fromList [InstallOptions, Installable, Uninstallable, Upgradeable])
, ("sunfreeware", Set.fromList [Installable, Uninstallable, Upgradeable])
, ("up2date", Set.fromList [Installable, Uninstallable, Upgradeable])
, ("urpmi", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
, ("windows", Set.fromList [InstallOptions, Installable, UninstallOptions, Uninstallable])
, ("yum", Set.fromList [Installable, Purgeable, Uninstallable, Upgradeable, Versionable])
, ("zypper", Set.fromList [Installable, Uninstallable, Upgradeable, Versionable])
]
parameterfunctions :: [(Text, [Text -> NativeTypeValidate])]
parameterfunctions =
[("adminfile" , [string, fullyQualified])
,("allowcdrom" , [string, values ["true","false"]])
,("configfiles" , [string, values ["keep","replace"]])
,("ensure" , [defaultvalue "present", string])
,("flavor" , [])
,("install_options" , [rarray])
,("name" , [nameval])
,("provider" , [defaultvalue "apt", string])
,("responsefile" , [string, fullyQualified])
,("source" , [string])
,("uninstall_options", [rarray])
]
getFeature :: Resource -> Either PrettyError (HashSet PackagingFeatures, Resource)
getFeature res =
case res ^. rattributes . at "provider" of
Just (PString x) ->
case HM.lookup x isFeatureSupported of
Just s -> Right (s, res)
Nothing -> Left $ PrettyError ("Do not know provider" <+> ppline x)
_ -> Left "Can't happen at Puppet.NativeTypes.Package"
checkFeatures :: (HashSet PackagingFeatures, Resource) -> Either PrettyError Resource
checkFeatures =
checkAdminFile
>=> checkEnsure
>=> checkParam "install_options" InstallOptions
>=> checkParam "uninstall_options" UninstallOptions
>=> decap
where
checkFeature :: HashSet PackagingFeatures -> Resource -> PackagingFeatures -> Either PrettyError (HashSet PackagingFeatures, Resource)
checkFeature s r f = if Set.member f s
then Right (s, r)
else Left $ PrettyError ("Feature" <+> pretty f <+> "is required for the current configuration")
checkParam :: Text -> PackagingFeatures -> (HashSet PackagingFeatures, Resource) -> Either PrettyError (HashSet PackagingFeatures, Resource)
checkParam pn f (s,r) = if has (ix pn) (r ^. rattributes)
then checkFeature s r f
else Right (s,r)
checkAdminFile :: (HashSet PackagingFeatures, Resource) -> Either PrettyError (HashSet PackagingFeatures, Resource)
checkAdminFile = Right
checkEnsure :: (HashSet PackagingFeatures, Resource) -> Either PrettyError (HashSet PackagingFeatures, Resource)
checkEnsure (s, res) = case res ^. rattributes . at "ensure" of
Just (PString "latest") -> checkFeature s res Installable
Just (PString "purged") -> checkFeature s res Purgeable
Just (PString "absent") -> checkFeature s res Uninstallable
Just (PString "installed") -> checkFeature s res Installable
Just (PString "present") -> checkFeature s res Installable
Just (PString "held") -> checkFeature s res Installable >> checkFeature s res Holdable
_ -> checkFeature s res Versionable
decap :: (HashSet PackagingFeatures, Resource) -> Either PrettyError Resource
decap = Right . snd