diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,4 +1,9 @@ -# v1.3.6 (UNRELEASED) +# v1.3.7 (2017/03/14) + +* Add puppet `sprintf` function +* Fix scientific2text (#196) + +# v1.3.6 (2017/02/27) * The `defined` function can now test variables * Fixed the `delete_at` function, added new tests, TBC diff --git a/Puppet/Interpreter/IO.hs b/Puppet/Interpreter/IO.hs --- a/Puppet/Interpreter/IO.hs +++ b/Puppet/Interpreter/IO.hs @@ -79,7 +79,6 @@ PuppetPaths -> runInstr (r ^. readerPuppetPaths) GetNativeTypes -> runInstr (r ^. readerNativeTypes) ErrorThrow d -> return (Left d, s, mempty) - ErrorCatch _ _ -> thpe "ErrorCatch" GetNodeName -> runInstr (r ^. readerNodename) HieraQuery scps q t -> canFail ((r ^. readerHieraQuery) scps q t) PDBInformation -> pdbInformation pdb >>= runInstr @@ -96,3 +95,9 @@ TraceEvent e -> (r ^. readerIoMethods . ioTraceEvent) e >>= runInstr IsIgnoredModule m -> runInstr (r ^. readerIgnoredModules . contains m) IsExternalModule m -> runInstr (r ^. readerExternalModules . contains m) + -- on error, the program state is RESET and the logged messages are dropped + ErrorCatch atry ahandle -> do + (eres, s', w) <- interpretMonad r s atry + case eres of + Left rr -> interpretMonad r s (ahandle rr >>= k) + Right x -> logStuff w (interpretMonad r s' (k x)) diff --git a/Puppet/Interpreter/Resolve.hs b/Puppet/Interpreter/Resolve.hs --- a/Puppet/Interpreter/Resolve.hs +++ b/Puppet/Interpreter/Resolve.hs @@ -29,15 +29,6 @@ fixResourceName ) where -import Puppet.Interpreter.PrettyPrinter () -import Puppet.Interpreter.RubyRandom -import Puppet.Interpreter.Types -import Puppet.Interpreter.Utils -import Puppet.Parser.Types -import Puppet.Paths -import Puppet.PP -import Puppet.Utils - import Control.Lens import Control.Monad import Control.Monad.Operational (singleton) @@ -45,8 +36,8 @@ import Data.Aeson hiding ((.=)) import Data.Aeson.Lens hiding (key) import Data.Bits -import Data.ByteString (ByteString) -import Data.ByteArray (convert) +import Data.ByteArray (convert) +import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import Data.CaseInsensitive (mk) @@ -54,18 +45,28 @@ import qualified Data.Foldable as F import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS -import Data.Maybe (mapMaybe,fromMaybe) +import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Maybe.Strict as S import Data.Scientific import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Tuple.Strict as S import qualified Data.Vector as V -import Data.Version (parseVersion, Version(..)) +import Data.Version (Version (..), parseVersion) import Text.ParserCombinators.ReadP (readP_to_S) import qualified Text.PrettyPrint.ANSI.Leijen as PP import Text.Regex.PCRE.ByteString.Utils +import Puppet.Interpreter.PrettyPrinter () +import Puppet.Interpreter.RubyRandom +import Puppet.Interpreter.Types +import Puppet.Interpreter.Utils +import Puppet.Interpreter.Resolve.Sprintf (sprintf) +import Puppet.Parser.Types +import Puppet.Paths +import Puppet.PP +import Puppet.Utils + sha1 :: ByteString -> ByteString sha1 = convert . (hash :: ByteString -> Digest SHA1) @@ -95,7 +96,7 @@ -- we can't use _PString, because of dependency cycles toStr (k,v) = case v of PString x -> Just (k,x) - _ -> Nothing + _ -> Nothing toplevels = map (_1 %~ ("::" <>)) $ getV "::" locals = getV ctx vars = HM.fromList (toplevels <> locals) @@ -191,7 +192,7 @@ (PString sa, PString sb) -> mk sa == mk sb -- TODO, check if array / hash equality should be recursed -- for case insensitive matching - _ -> ra == rb + _ -> ra == rb -- | The main resolution function : turns an 'Expression' into a 'PValue', -- if possible. @@ -244,7 +245,7 @@ PHash h -> do ridx <- resolveExpressionString idx case h ^. at ridx of - Just _ -> return (PBoolean True) + Just _ -> return (PBoolean True) Nothing -> return (PBoolean False) PArray ar -> do ridx <- resolveExpression idx @@ -294,9 +295,9 @@ ra <- resolveExpression a rb <- resolveExpression b case (ra, rb) of - (PHash ha, PHash hb) -> return (PHash (ha <> hb)) + (PHash ha, PHash hb) -> return (PHash (ha <> hb)) (PArray ha, PArray hb) -> return (PArray (ha <> hb)) - _ -> binaryOperation a b (+) + _ -> binaryOperation a b (+) resolveExpression (Substraction a b) = binaryOperation a b (-) resolveExpression (Division a b) = do ra <- resolveExpressionNumber a @@ -380,10 +381,10 @@ -- | Turns a 'PValue' into a 'Bool', as explained in the reference -- documentation. pValue2Bool :: PValue -> Bool -pValue2Bool PUndef = False +pValue2Bool PUndef = False pValue2Bool (PString "") = False pValue2Bool (PBoolean x) = x -pValue2Bool _ = True +pValue2Bool _ = True -- | This resolve function calls at the expression level. resolveFunction :: T.Text -> V.Vector Expression -> InterpreterMonad PValue @@ -406,7 +407,7 @@ resolveFunction fname args = mapM resolveExpression (V.toList args) >>= resolveFunction' fname . map undefEmptyString where undefEmptyString PUndef = PString "" - undefEmptyString x = x + undefEmptyString x = x resolveFunction' :: T.Text -> [PValue] -> InterpreterMonad PValue resolveFunction' "defined" [PResourceReference "class" cn] = do @@ -426,7 +427,7 @@ scps <- use scopes scp <- getScopeName return $ PBoolean $ case getVariable scps scp (T.tail t) of - Left _ -> False + Left _ -> False Right _ -> True else do -- resource test -- case 1, nested thingie @@ -459,7 +460,7 @@ Right x -> fmap PString (safeDecodeUtf8 x) case ptarget of PArray a -> fmap PArray (traverse sub a) - s -> sub s + s -> sub s resolveFunction' "regsubst" _ = throwPosError "regsubst(): Expects 3 or 4 arguments" resolveFunction' "split" [psrc, psplt] = do src <- fmap T.encodeUtf8 (resolvePValueString psrc) @@ -507,15 +508,17 @@ b <- resolvePValueString pb let parser x = case filter (null . Prelude.snd) (readP_to_S parseVersion (T.unpack x)) of ( (v, _) : _ ) -> v - _ -> Version [] [] -- fallback :( + _ -> Version [] [] -- fallback :( va = parser a vb = parser b return $ PString $ case compare va vb of EQ -> "0" LT -> "-1" GT -> "1" - resolveFunction' "versioncmp" _ = throwPosError "versioncmp(): Expects two arguments" +-- | Simplified implementation of sprintf +resolveFunction' "sprintf" (PString str:args) = sprintf str args +resolveFunction' "sprintf" _ = throwPosError "sprintf(): Expects a string as its first argument" -- some custom functions resolveFunction' "pdbresourcequery" [q] = pdbresourcequery q Nothing resolveFunction' "pdbresourcequery" [q,k] = fmap Just (resolvePValueString k) >>= pdbresourcequery q @@ -548,7 +551,7 @@ Nothing -> throwPosError ("pdbresourcequery strange error, could not find key" <+> ttext ky <+> "in" <+> pretty (PHash h)) extractSubHash _ x = throwPosError ("pdbresourcequery strange error, expected a hash, had" <+> pretty x) case mkey of - Nothing -> return (PArray rv) + Nothing -> return (PArray rv) (Just k) -> fmap PArray (V.mapM (extractSubHash k) rv) calcTemplate :: (T.Text -> Either T.Text T.Text) -> PValue -> InterpreterMonad T.Text @@ -583,9 +586,9 @@ mkSE (RNonEqualitySearch a b) = fmap QNot (mkSE (REqualitySearch a b)) mkSE (REqualitySearch a (PString b)) = [QEqual (mkFld a) b] mkSE _ = [] - mkFld "tag" = RTag + mkFld "tag" = RTag mkFld "title" = RTitle - mkFld z = RParameter z + mkFld z = RParameter z -- | Checks whether a given 'Resource' matches a 'RSearchExpression'. Note -- that the expression doesn't check for type, so you must filter the @@ -599,21 +602,21 @@ checkSearchExpression (REqualitySearch "title" v) r = let nameequal = puppetEquality v (PString (r ^. rid . iname)) aliasequal = case r ^. rattributes . at "alias" of - Just a -> puppetEquality v a + Just a -> puppetEquality v a Nothing -> False in nameequal || aliasequal checkSearchExpression (REqualitySearch attributename v) r = case r ^. rattributes . at attributename of - Nothing -> False + Nothing -> False Just (PArray x) -> F.any (flip puppetEquality v) x - Just x -> puppetEquality x v + Just x -> puppetEquality x v checkSearchExpression (RNonEqualitySearch attributename v) r | attributename == "tag" = True | attributename == "title" = not (checkSearchExpression (REqualitySearch attributename v) r) | otherwise = case r ^. rattributes . at attributename of - Nothing -> True + Nothing -> True Just (PArray x) -> not (F.all (flip puppetEquality v) x) - Just x -> not (puppetEquality x v) + Just x -> not (puppetEquality x v) -- | Generates variable associations for evaluation of blocks. Each item -- corresponds to an iteration in the calling block. diff --git a/Puppet/Interpreter/Resolve/Sprintf.hs b/Puppet/Interpreter/Resolve/Sprintf.hs new file mode 100644 --- /dev/null +++ b/Puppet/Interpreter/Resolve/Sprintf.hs @@ -0,0 +1,144 @@ +module Puppet.Interpreter.Resolve.Sprintf where + +import Control.Applicative +import Control.Monad +import Data.Attoparsec.Text +import Data.Scientific (Scientific) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TB +import qualified Data.Text.Lazy.Builder.Int as TB +import qualified Data.Text.Lazy.Builder.Scientific as TB + + +import Puppet.Interpreter.Types +import Puppet.Interpreter.Utils +import Puppet.Utils +import Puppet.PP (pretty) +import Puppet.Interpreter.PrettyPrinter() + +data Flag = Minus | Plus | Space | Zero | Hash + deriving (Show, Eq) + +data FLen = Lhh | Lh | Ll | Lll | LL | Lz | Lj | Lt + deriving (Show, Eq) + +data FType = TPct | Td | Tu | Tf | TF | Te | TE | Tg | TG | Tx | TX | To | Ts | Tc | Tp | Ta | TA + deriving (Show, Eq) + +data PrintfFormat = PrintfFormat { _pfFlags :: [Flag] + , _pfWidth :: Maybe Int + , _pfPrec :: Maybe Int + , _pfLen :: Maybe FLen + , _pfType :: FType + } deriving (Show, Eq) + +data FormatStringPart = Raw T.Text + | Format PrintfFormat + deriving (Show, Eq) + +parseFormat :: T.Text -> [FormatStringPart] +parseFormat t | T.null t = [] + | T.null nxt = [Raw raw] + | otherwise = Raw raw : rformat + where + (raw, nxt) = T.break (== '%') t + tryNext = case parseFormat (T.tail nxt) of + (Raw nt : nxt') -> Raw (T.cons '%' nt) : nxt' + nxt' -> Raw (T.singleton '%') : nxt' + rformat = case parse format nxt of + Fail _ _ _ -> tryNext + Partial _ -> tryNext + Done remaining f -> Format f : parseFormat remaining + +flag :: Parser Flag +flag = (Minus <$ char '-') + <|> (Plus <$ char '+') + <|> (Space <$ char ' ') + <|> (Zero <$ char '0') + <|> (Hash <$ char '#') + +lenModifier :: Parser FLen +lenModifier = (Lhh <$ string "hh") + <|> (Lh <$ char 'h') + <|> (Lll <$ string "ll") + <|> (Ll <$ char 'l') + <|> (LL <$ char 'L') + <|> (Lz <$ char 'z') + <|> (Lj <$ char 'j') + <|> (Lt <$ char 't') + +ftype :: Parser FType +ftype = (TPct <$ char '%') + <|> (Td <$ char 'd') + <|> (Td <$ char 'i') + <|> (Tu <$ char 'u') + <|> (Tf <$ char 'f') + <|> (TF <$ char 'F') + <|> (Te <$ char 'e') + <|> (TE <$ char 'E') + <|> (Tg <$ char 'g') + <|> (TG <$ char 'G') + <|> (Tx <$ char 'x') + <|> (TX <$ char 'X') + <|> (To <$ char 'o') + <|> (Ts <$ char 's') + <|> (Tc <$ char 'c') + <|> (Ta <$ char 'a') + <|> (Tp <$ char 'p') + <|> (TA <$ char 'A') + +format :: Parser PrintfFormat +format = do + void $ char '%' + flags <- many flag + width <- optional decimal + prec <- optional $ do + void $ char '.' + decimal + len <- optional lenModifier + ft <- ftype + return (PrintfFormat flags width prec len ft) + +sprintf :: T.Text -> [PValue] -> InterpreterMonad PValue +sprintf str oargs = PString . TL.toStrict . TB.toLazyText . mconcat <$> go (parseFormat str) oargs + where + go (Raw x : xs) args = (TB.fromText x :) <$> go xs args + go (Format f : _) _ | Hash `elem` _pfFlags f = throwPosError "sprintf: the # modifier is not supported" + go (Format f : xs) (arg : args) = do + let numeric = case arg of + PNumber n -> pure n + PString s -> maybe (throwError "sprintf: Don't know how to convert this to a number") return (text2Scientific s) + _ -> throwError "sprintf: Don't know how to convert this to a number" + flags = _pfFlags f + sh mkBuilder n | has Minus = TL.justifyLeft padlen ' ' (sprefix <> content) + | has Plus && has Zero = sprefix <> TL.justifyRight mpadlen '0' content + | has Plus = TL.justifyRight padlen ' ' (sprefix <> content) + | has Zero = TL.justifyRight padlen '0' content + | otherwise = TL.justifyRight padlen ' ' content + where + (mpadlen, sprefix) | Plus `elem` flags && n >= 0 = (padlen - 1, "+") + | Space `elem` flags && n >= 0 = (padlen - 1, " ") + | otherwise = (padlen, mempty) + padlen = maybe 0 fromIntegral (_pfWidth f) + has flg = flg `elem` flags + content = TB.toLazyText (mkBuilder n) + baseString <- case _pfType f of + Td -> sh (TB.formatScientificBuilder TB.Fixed (Just 0)) <$> numeric + Tf -> sh (TB.formatScientificBuilder TB.Fixed (_pfPrec f)) <$> numeric + TF -> sh (TB.formatScientificBuilder TB.Fixed (_pfPrec f)) <$> numeric + Tg -> sh (TB.formatScientificBuilder TB.Generic (_pfPrec f)) <$> numeric + TG -> sh (TB.formatScientificBuilder TB.Generic (_pfPrec f)) <$> numeric + Te -> sh (TB.formatScientificBuilder TB.Exponent (_pfPrec f)) <$> numeric + TE -> sh (TB.formatScientificBuilder TB.Exponent (_pfPrec f)) <$> numeric + Tx -> sh (TB.hexadecimal . (truncate :: Scientific -> Integer)) <$> numeric + TX -> sh (TB.hexadecimal . (truncate :: Scientific -> Integer)) <$> numeric + Ts -> return $ case arg of + PString s -> TL.fromStrict s + _ -> TL.pack (show (pretty arg)) + _ -> throwPosError "sprintf: not yet supported" + (TB.fromLazyText baseString :) <$> go xs args + go [] [] = return [] + go _ [] = throwPosError "sprintf: not enough arguments" + go [] _ = [] <$ let msg = "sprintf: too many arguments" in checkStrict msg msg + diff --git a/Puppet/Interpreter/Types.hs b/Puppet/Interpreter/Types.hs --- a/Puppet/Interpreter/Types.hs +++ b/Puppet/Interpreter/Types.hs @@ -74,6 +74,7 @@ , EdgeMap -- * Classes , MonadThrowPos(..) + , MonadError(..) -- * definitions , metaparameters , showPos @@ -137,6 +138,8 @@ instance Exception PrettyError +instance Pretty PrettyError where + pretty = getError data PValue = PBoolean !Bool | PUndef @@ -180,9 +183,9 @@ deriving (Show, Eq) instance FromJSON Strictness where - parseJSON (Bool True) = pure Strict + parseJSON (Bool True) = pure Strict parseJSON (Bool False) = pure Permissive - parseJSON _ = mzero + parseJSON _ = mzero data RSearchExpression = REqualitySearch !Text !PValue | RNonEqualitySearch !Text !PValue @@ -513,7 +516,7 @@ where chk (Left x) = Left x chk (Right x) = case fromJSON x of - Error rr -> Left rr + Error rr -> Left rr Success suc -> Right suc @@ -626,7 +629,7 @@ [ "<", flds, val ] -> QL <$> parseJSON flds <*> parseJSON val [">=", flds, val ] -> QGE <$> parseJSON flds <*> parseJSON val ["<=", flds, val ] -> QLE <$> parseJSON flds <*> parseJSON val - x -> fail ("unknown query" ++ show x) + x -> fail ("unknown query" ++ show x) parseJSON _ = fail "Expected an array" instance ToJSON FactField where @@ -641,13 +644,13 @@ parseJSON _ = fail "Can't parse fact field" instance ToJSON NodeField where - toJSON NName = "name" + toJSON NName = "name" toJSON (NFact t) = toJSON [ "fact", t ] instance FromJSON NodeField where parseJSON (Array xs) = case V.toList xs of ["fact", x] -> NFact <$> parseJSON x - _ -> fail "Invalid field syntax" + _ -> fail "Invalid field syntax" parseJSON (String "name") = pure NName parseJSON _ = fail "invalid field" @@ -676,7 +679,7 @@ instance FromJSON RIdentifier where parseJSON (Object v) = RIdentifier <$> v .: "type" <*> v .: "title" - parseJSON _ = fail "invalid resource" + parseJSON _ = fail "invalid resource" instance ToJSON RIdentifier where toJSON (RIdentifier t n) = object [("type", String t), ("title", String n)] diff --git a/Puppet/Puppetlabs.hs b/Puppet/Puppetlabs.hs --- a/Puppet/Puppetlabs.hs +++ b/Puppet/Puppetlabs.hs @@ -27,6 +27,8 @@ extFun :: [(FilePath, Text, [PValue] -> InterpreterMonad PValue)] extFun = [ ("/apache", "bool2httpd", apacheBool2httpd) , ("/docker", "docker_run_flags", mockDockerRunFlags) + , ("/jenkins", "jenkins_port", mockJenkinsPort) + , ("/jenkins", "jenkins_prefix", mockJenkinsPrefix) , ("/postgresql", "postgresql_acls_to_resources_hash", pgAclsToHash) , ("/postgresql", "postgresql_password", pgPassword) , ("/extlib", "random_password", randomPassword) @@ -65,6 +67,16 @@ randomPassword _ = throwPosError "expect one single string arguments" + +-- | To be implemented if needed +mockJenkinsPrefix :: MonadThrowPos m => [PValue] -> m PValue +mockJenkinsPrefix [] = return $ PString "" +mockJenkinsPrefix arg@_ = throwPosError $ "expect no argument" <+> pretty arg + +-- | To be implemented if needed +mockJenkinsPort :: MonadThrowPos m => [PValue] -> m PValue +mockJenkinsPort [] = return $ PString "8080" +mockJenkinsPort arg@_ = throwPosError $ "expect no argument" <+> pretty arg mockCacheData :: MonadThrowPos m => [PValue] -> m PValue mockCacheData [_, _, b] = return b diff --git a/Puppet/Utils.hs b/Puppet/Utils.hs --- a/Puppet/Utils.hs +++ b/Puppet/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE LambdaCase #-} -- | Those are utility functions, most of them being pretty much self -- explanatory. @@ -30,7 +31,6 @@ import Data.Scientific import Control.Exception import Control.Lens -import Data.Aeson.Lens import qualified Data.Yaml as Y text2Scientific :: T.Text -> Maybe Scientific @@ -39,9 +39,9 @@ Right s -> Just s scientific2text :: Scientific -> T.Text -scientific2text n = T.pack $ case n ^? _Integer of - Just i -> show i - _ -> show n +scientific2text n = T.pack $ case floatingOrInteger n of + Left r -> show (r :: Double) + Right i -> show (i :: Integer) strictifyEither :: Either a b -> S.Either a b strictifyEither (Left x) = S.Left x diff --git a/PuppetDB/Dummy.hs b/PuppetDB/Dummy.hs --- a/PuppetDB/Dummy.hs +++ b/PuppetDB/Dummy.hs @@ -16,4 +16,3 @@ (const (return [] )) (throwError "not implemented") (\_ _ -> 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.6 +version: 1.3.7 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.8.4, GHC == 7.10.3, GHC == 8.0.1 +Tested-With: GHC == 7.10.3, GHC == 8.0.1 extra-source-files: CHANGELOG.markdown @@ -45,6 +45,7 @@ , Puppet.Interpreter.PrettyPrinter , Puppet.Interpreter.Pure , Puppet.Interpreter.Resolve + , Puppet.Interpreter.Resolve.Sprintf , Puppet.Interpreter.Types , Puppet.Interpreter.Utils , Puppet.Lens @@ -176,6 +177,7 @@ extensions: OverloadedStrings build-depends: language-puppet,base,strict-base-types,lens,text,hspec,unordered-containers,megaparsec,vector,scientific,mtl other-modules: Function.ShellquoteSpec + Function.SprintfSpec Function.SizeSpec Function.MergeSpec Function.EachSpec diff --git a/tests/Function/SprintfSpec.hs b/tests/Function/SprintfSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Function/SprintfSpec.hs @@ -0,0 +1,60 @@ +module Function.SprintfSpec (spec, main) where + +import Test.Hspec +import Data.Text (Text) +import Control.Monad +import qualified Data.Vector as V +import Data.Monoid + +import Puppet.Interpreter.Pure +import Puppet.Interpreter.Resolve +import Puppet.Interpreter.Types +import Puppet.Parser.Types +import Puppet.PP + +main :: IO () +main = hspec spec + +evalArgs :: [Expression] -> Either PrettyError Text +evalArgs = dummyEval . resolveValue . UFunctionCall "sprintf" . V.fromList + >=> \pv -> case pv of + PString s -> return s + _ -> Left ("Expected a string, not " <> PrettyError (pretty pv)) + +checkSuccess :: [Expression] -> Text -> Expectation +checkSuccess args res = + case evalArgs args of + Left rr -> expectationFailure (show rr) + Right res' -> res' `shouldBe` res +checkError :: [Expression] -> String -> Expectation +checkError args msg = + case evalArgs args of + Left rr -> show rr `shouldContain` msg + Right r -> expectationFailure ("Should have errored, received this instead: " <> show r) + +spec :: Spec +spec = do + it "should fail with no argument" (checkError [] "Expects a string as its first argument") + it "should succeed with one argument" (checkSuccess ["hello"] "hello") -- puppet sprintf accepts one arg + it "should work with multiple arguments" (checkSuccess ["hello %s %s", "world", "!"] "hello world !") + it "should work with one string argument" (checkSuccess ["hello %s", "world"] "hello world" ) + it "should work with one int argument" (checkSuccess ["hello %d", 10] "hello 10" ) + it "should fail if arg is not provided" (checkError ["hello %s"] "not enough arguments") + it "should fail when a wrong format instruction is used" (checkError ["hello %d", "world"] "Don't know how to convert this to a number" ) + it "should fail when a wrong format instruction is used" (checkError ["hello %f", "world"] "Don't know how to convert this to a number" ) + it "should work with one int argument" (checkSuccess ["hello %f", 1.0] "hello 1.0" ) + it "should work with one int argument" (checkSuccess ["hello %.1f", 1.23] "hello 1.2" ) + it "should pad with zeroes" (checkSuccess ["hello %03d", 10] "hello 010") + it "should pad with spaces" (checkSuccess ["hello % 3d", 10] "hello 10") + it "should format integers" (checkSuccess ["%+05d", 23] "+0023") + it "should format floats" (checkSuccess ["%+.2f", 2.7182818284590451] "+2.72") + it "should format large floats" (pendingWith "Minor formatting difference" >> checkSuccess ["%+.2e", 27182818284590451] "+2.72e+16") + it "should work with " (checkSuccess ["%5d" , 5] " 5") + it "should work with 0" (checkSuccess ["%05d" , 5] "00005") + it "should work with - " (checkSuccess ["%-5d" , 5] "5 ") + it "should work with -0" (checkSuccess ["%-05d" , 5] "5 ") + it "should work with + " (checkSuccess ["%+5d" , 5] " +5") + it "should work with + 0" (checkSuccess ["%+05d" , 5] "+0005") + it "should work with +- " (checkSuccess ["%+-5d" , 5] "+5 ") + it "should work with +-0" (checkSuccess ["%+-05d", 5] "+5 ") + it "should perform more complex formatting" (pendingWith "# is not yet supported" >> checkSuccess [ "<%.8s:%#5o %#8X (%-8s)>", "overlongstring", 23, 48879, "foo" ] "") diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -10,6 +10,7 @@ import qualified Function.JoinKeysToValuesSpec import qualified Function.DeleteAtSpec import qualified Interpreter.IfSpec +import qualified Function.SprintfSpec main :: IO () main = hspec spec @@ -23,6 +24,7 @@ describe "If" Interpreter.IfSpec.spec describe "Puppet functions" $ do describe "The shellquote function" Function.ShellquoteSpec.spec + describe "The sprintf function" Function.SprintfSpec.spec describe "The each function" Function.EachSpec.spec describe "stdlib functions" $ do describe "The assert_private function" Function.AssertPrivateSpec.spec