diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,9 @@ +# v1.3.10 (2017/08/28) + +* Add `sort` stdlib function +* Remove `SafeProcess` module (fix `ghc-8.2` compilation) +* Remove `ghc-7.x` support + # v1.3.9 (2017/07/30) * Moved to megaparsec 6 diff --git a/Puppet/Daemon.hs b/Puppet/Daemon.hs --- a/Puppet/Daemon.hs +++ b/Puppet/Daemon.hs @@ -48,6 +48,7 @@ {-| API for the Daemon. The main method is `getCatalog`: given a node and a list of facts, it returns the result of the compilation. This will be either an error, or a tuple containing: + - all the resources in this catalog - the dependency map - the exported resources @@ -55,10 +56,7 @@ Notes : -* It might be buggy when top level statements that are not class\/define\/nodes -are altered, or when files loaded with require are changed. -* The catalog is not computed exactly the same way Puppet does. Some good practices are enforced, particularly in strict mode. -For instance, unknown variables are always an error. Querying a dictionary with a non existent key returns undef in puppet, whereas it would throw an error in strict mode. +* It might be buggy when top level statements that are not class\/define\/nodes are altered. -} data Daemon = Daemon { getCatalog :: NodeName -> Facts -> IO (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) @@ -70,7 +68,7 @@ {-| Entry point to get a Daemon It will initialize the parsing and interpretation infrastructure from the 'Preferences'. -Internally it initializes a thread for the LUA interpreter, and a thread for the Ruby one. +Internally it initializes a thread for the Ruby interpreter. It should cache the AST of every .pp file, and could use a bit of memory. As a comparison, it fits in 60 MB with the author's manifests, but really breathes when given 300 MB of heap space. In this configuration, even if it spawns a ruby process for every @@ -185,7 +183,7 @@ cnt <- T.readFile fname o <- case runPParser fname cnt of Right r -> traceEventIO ("Stopped parsing " ++ fname) >> return (S.Right r) - Left rr -> traceEventIO ("Stopped parsing " ++ fname ++ " (failure: " ++ show rr ++ ")") >> return (S.Left (P.parseErrorPretty rr)) + Left rr -> traceEventIO ("Stopped parsing " ++ fname ++ " (failure: " ++ P.parseErrorPretty rr ++ ")") >> return (S.Left (P.parseErrorPretty rr)) traceEventIO ("STOP parsing " ++ fname) return o diff --git a/Puppet/Parser.hs b/Puppet/Parser.hs --- a/Puppet/Parser.hs +++ b/Puppet/Parser.hs @@ -599,7 +599,7 @@ resDeclGroup :: Parser [ResDecl] resDeclGroup = do - let resourceName = token stringExpression + let resourceName = expression resourceDeclaration = do p <- getPosition names <- brackets (sepComma1 resourceName) <|> fmap return resourceName diff --git a/Puppet/Preferences.hs b/Puppet/Preferences.hs --- a/Puppet/Preferences.hs +++ b/Puppet/Preferences.hs @@ -90,7 +90,8 @@ labsFunctions <- Puppetlabs.extFunctions modulesdir let loadedTypes = HM.fromList (map defaulttype typenames) return $ Preferences dirpaths - dummyPuppetDB (baseNativeTypes `HM.union` loadedTypes) + dummyPuppetDB + (baseNativeTypes `HM.union` loadedTypes) (HM.union stdlibFunctions labsFunctions) (Just (basedir <> "/hiera.yaml")) (getIgnoredmodules defaults) diff --git a/Puppet/Stdlib.hs b/Puppet/Stdlib.hs --- a/Puppet/Stdlib.hs +++ b/Puppet/Stdlib.hs @@ -1,13 +1,16 @@ +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} module Puppet.Stdlib (stdlibFunctions) where +import Control.Applicative import Control.Lens import Control.Monad import Data.Aeson.Lens import qualified Data.ByteString.Base16 as B16 import Data.Char import qualified Data.HashMap.Strict as HM +import qualified Data.List as List import Data.List.Split (chunksOf) import Data.Maybe (mapMaybe) import Data.Monoid @@ -107,7 +110,7 @@ -- seeded_rand -- shuffle , singleArgument "size" size - -- sort + , singleArgument "sort" sort -- squeeze , singleArgument "str2bool" str2Bool -- strtosaltedshar512 @@ -396,6 +399,16 @@ size (PArray v) = return (_Integer # fromIntegral (V.length v)) size (PString s) = return (_Integer # fromIntegral (T.length s)) size x = throwPosError ("size(): Expects a hash, and array or a string, not" <+> pretty x) + +sort :: PValue -> InterpreterMonad PValue +sort (PArray s) = + let lst = V.toList s + msort :: Ord a => Prism' PValue a -> Maybe PValue + msort prsm = PArray . V.fromList . map (review prsm) . List.sort <$> mapM (preview prsm) lst + in case (msort _PString <|> msort _PNumber) of + Just x -> return x + _ -> throwPosError "sort(): only homogeneous arrays of numbers or strings are allowed" +sort x = throwPosError ("sort(): Expect to sort an array, not" <+> pretty x) str2Bool :: PValue -> InterpreterMonad PValue str2Bool PUndef = return (PBoolean False) diff --git a/README.adoc b/README.adoc --- a/README.adoc +++ b/README.adoc @@ -25,6 +25,8 @@ The `puppetresources` command is a command line utility that let you interactively compute catalogs on your local computer. It is much faster than its ruby counterpart, and has been designed for giving assistance to the Puppet catalog writer. + + There are 4 different modes: * `--node` will display all resources on screen in a nice user-friendly colored fashion. @@ -32,7 +34,7 @@ * `--parse` only goes as far as parsing. No interpretation. * `--showcontent` to display file content. -Catalog can be verified using strict or more permissive rules. +Catalog is not computed exactly the same way Puppet does. Some good practices are enforced. A strict and more permissive mode are provided. === Command line arguments diff --git a/SafeProcess.hs b/SafeProcess.hs deleted file mode 100644 --- a/SafeProcess.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE LambdaCase, CPP #-} --- from http://stackoverflow.com/questions/8820903/haskell-how-to-timeout-a-function-that-runs-an-external-command -module SafeProcess where - -import Control.Concurrent -import Control.Exception -import System.Exit -import System.IO -import System.Timeout -import System.Posix.Signals -import System.Process -import System.Process.Internals -import qualified Data.Text as T -import qualified Data.Text.IO as T -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.IO as TL - -safeReadProcessTimeout :: String -> [String] -> TL.Text -> Int -> IO (Maybe (Either String T.Text)) -safeReadProcessTimeout prog args input tout = timeout (tout*1000) $ safeReadProcess prog args input - -safeCreateProcess :: String -> [String] -> StdStream -> StdStream -> StdStream - -> ( ( Maybe Handle - , Maybe Handle - , Maybe Handle - , ProcessHandle - ) -> IO a ) - -> IO a -safeCreateProcess prog args streamIn streamOut streamErr = bracket - ( createProcess (proc prog args) { std_in = streamIn - , std_out = streamOut - , std_err = streamErr - , create_group = True } - ) --- "interruptProcessGroupOf" is in the new System.Process. Since some --- programs return funny exit codes i implemented a "terminateProcessGroupOf". --- (\(_, _, _, ph) -> interruptProcessGroupOf ph >> waitForProcess ph) - (\(_, _, _, ph) -> terminateProcessGroup ph >> waitForProcess ph) -{-# NOINLINE safeCreateProcess #-} - -safeReadProcess :: String -> [String] -> TL.Text -> IO (Either String T.Text) -safeReadProcess prog args str = - safeCreateProcess prog args CreatePipe CreatePipe Inherit - (\(Just inh, Just outh, _, ph) -> do - hSetBinaryMode inh True - hSetBinaryMode outh True - TL.hPutStr inh str - hClose inh - -- fork a thread to consume output - output <- T.hGetContents outh - outMVar <- newEmptyMVar - _ <- forkIO $ evaluate (T.length output) >> putMVar outMVar () - -- wait on output - takeMVar outMVar - hClose outh - waitForProcess ph >>= \case - ExitSuccess -> return $ Right output - ExitFailure r -> return $ Left $ prog ++ " " ++ show args ++ " failed, errorcode = " ++ show r - ) - -terminateProcessGroup :: ProcessHandle -> IO () -terminateProcessGroup ph = do - let (ProcessHandle pmvar _) = ph - readMVar pmvar >>= \case - -- pid is a POSIX pid - OpenHandle pid -> signalProcessGroup 15 pid - _ -> return () 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.9 +version: 1.3.10 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/ @@ -15,7 +15,7 @@ build-type: Simple cabal-version: >=1.8 -Tested-With: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 +Tested-With: GHC == 8.0.2, GHC == 8.2.1 extra-source-files: CHANGELOG.markdown @@ -61,7 +61,6 @@ , Puppet.Stdlib , Puppet.OptionalTests , Puppet.Utils - , SafeProcess other-modules: Erb.Compute , Paths_language_puppet , Puppet.Interpreter.RubyRandom @@ -86,7 +85,7 @@ build-depends: aeson >= 0.8 , ansi-wl-pprint == 0.6.* , attoparsec >= 0.12 - , base >=4.8 && < 5 + , base >=4.9 && < 5 , base16-bytestring == 0.1.* , bytestring , case-insensitive == 1.2.*