diff --git a/language-puppet.cabal b/language-puppet.cabal --- a/language-puppet.cabal +++ b/language-puppet.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet -version: 1.3.18 +version: 1.3.18.1 synopsis: Tools to parse and evaluate the Puppet DSL. description: This is a set of tools that is supposed to fill all your Puppet needs : syntax checks, catalog compilation, PuppetDB queries, simulationg of complex interactions between nodes, Puppet master replacement, and more ! homepage: http://lpuppet.banquise.net/ @@ -126,8 +126,8 @@ , random , regex-pcre-builtin >= 0.94.4 , scientific >= 0.2 && < 0.4 - , servant >= 0.9 && < 0.14 - , servant-client >= 0.9 && < 0.14 + , servant >= 0.9 && < 0.15 + , servant-client >= 0.9 && < 0.15 , split == 0.2.* , stm == 2.4.* , strict-base-types >= 0.3 diff --git a/progs/PuppetResources.hs b/progs/PuppetResources.hs --- a/progs/PuppetResources.hs +++ b/progs/PuppetResources.hs @@ -3,15 +3,17 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE CPP #-} module Main where -import XPrelude hiding (option) +import XPrelude hiding (option, (<>)) import Control.Concurrent.ParallelIO (parallel) import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as Map import qualified Data.HashSet as HS import qualified Data.List as List +import Data.Semigroup as Sem hiding (option) import qualified Data.Set as Set import qualified Data.Text as Text import Data.Text.Strict.Lens (unpacked) @@ -67,7 +69,7 @@ options :: Parser Options options = Options - <$> switch + <$> switch ( long "JSON" <> short 'j' <> help "Shows the output as a JSON document (useful for full catalog views)") @@ -237,7 +239,7 @@ putText "" allparses <- do let parsefp fp = runPuppetParser fp <$> readFile fp - parallel (map (parsefp) (Set.toList usedfiles)) + parallel (map parsefp (Set.toList usedfiles)) let (parseFailed, parseSucceeded) = partitionEithers allparses unless (null parseFailed) $ do putDoc ("The following" <+> pretty (length parseFailed) <+> "files could not be parsed:" <> softline <> indent 4 (vcat (map (ppstring . show) parseFailed))) @@ -256,17 +258,21 @@ deadResources = filter isDead allResources isDead (ResourceDeclaration (ResDecl _ _ _ _ pp)) = not $ Set.member pp allpositions isDead _ = True - unless (null deadResources) $ do + unless (null deadResources) $ putDoc ("The following" <+> pretty (length deadResources) <+> "resource declarations are not used:" <> softline <> indent 4 (vcat (map pretty deadResources)) <> line ) newtype Maximum a = Maximum { getMaximum :: Maybe a } +instance (Ord a) => Semigroup (Maximum a) where + Maximum Nothing <> m2 = m2 + m1 <> Maximum Nothing = m1 + Maximum (Just a1) <> Maximum (Just a2) = Maximum (Just (max a1 a2)) + instance (Ord a) => Monoid (Maximum a) where mempty = Maximum Nothing - mappend (Maximum Nothing) m2 = m2 - mappend m1 (Maximum Nothing) = m1 - mappend (Maximum (Just a1)) (Maximum (Just a2)) = Maximum (Just (max a1 a2)) - +#if !(MIN_VERSION_base(4,11,0)) + mappend = (Sem.<>) +#endif -- For each node, queryfunc the catalog and return stats computeStats :: FilePath -> Options -> QueryFunc -> (MStats, MStats, MStats) -> [NodeName] -> IO () diff --git a/src/Puppet/Runner/Stdlib.hs b/src/Puppet/Runner/Stdlib.hs --- a/src/Puppet/Runner/Stdlib.hs +++ b/src/Puppet/Runner/Stdlib.hs @@ -93,7 +93,7 @@ , ("pick_default", pickDefault) , ("prefix", prefix) -- private - -- pw_hash + , ("pw_hash", pw_hash) -- range -- reject -- reverse @@ -178,6 +178,13 @@ prefix :: [PValue] -> InterpreterMonad PValue prefix = foofix "prefix" (<>) +-- Dummy mock implementation of pw_hash +-- To be implemented if required +pw_hash :: [PValue] -> InterpreterMonad PValue +pw_hash [PString (pwd), PString(algo), PString(salt)] = + pure (PString ("plain " <> pwd <> "(crypt with " <> algo <> " and " <> salt)) +pw_hash _ = throwPosError "pw_hash(): expects 3 string arguments" + foofix :: Doc -> (Text -> Text -> Text) -> [PValue] -> InterpreterMonad PValue foofix nm f args = case args of @@ -401,14 +408,14 @@ pick [] = throwPosError "pick(): must receive at least one non empty value" pick xs = case filter (`notElem` [PUndef, PString "", PString "undef"]) xs of - [] -> throwPosError "pick(): no value suitable to be picked" + [] -> throwPosError "pick(): no value suitable to be picked" (x:_) -> return x pickDefault :: [PValue] -> InterpreterMonad PValue pickDefault [] = throwPosError "pick_default(): must receive at least one non empty value" pickDefault xs = case filter (`notElem` [PUndef, PString "", PString "undef"]) xs of - [] -> return (List.last xs) + [] -> return (List.last xs) (x:_) -> return x size :: PValue -> InterpreterMonad PValue diff --git a/src/XPrelude/PP.hs b/src/XPrelude/PP.hs --- a/src/XPrelude/PP.hs +++ b/src/XPrelude/PP.hs @@ -1,6 +1,6 @@ {-# OPTIONS_HADDOCK ignore-exports #-} -{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} module XPrelude.PP ( module Exports , PrettyError (..) @@ -15,6 +15,7 @@ import Protolude import Data.Scientific +import Data.Semigroup as Sem import Data.String import qualified Data.Text as Text import Text.PrettyPrint.ANSI.Leijen as Exports hiding (bool, cat, @@ -29,9 +30,14 @@ { getError :: Doc } deriving Show +instance Sem.Semigroup PrettyError where + a <> b = PrettyError $ align (vsep [getError a, getError b]) + instance Monoid PrettyError where mempty = PrettyError mempty - mappend a b = PrettyError $ align (vsep [getError a, getError b]) +#if !(MIN_VERSION_base(4,11,0)) + mappend = (Sem.<>) +#endif instance IsString PrettyError where fromString = PrettyError . string