diff --git a/README.md b/README.md index de8981b..7e5b2fe 100644 --- a/README.md +++ b/README.md @@ -94,6 +94,10 @@ Once you've written a spec, simply run it with: If all your tests pass, curl-runnings will cleanly exit with a 0 code. A code of 1 will be returned if any tests failed. +You can also select specific test cases by filtering via regex by using the +`--grep` flag. Just make sure your case isn't referencing data from previous +examples that won't get run! + For more info: ```curl-runnings --help ``` @@ -102,17 +106,3 @@ For more info: Contributions in any form are welcome and encouraged. Don't be shy! :D -### Roadmap - -- [x] Json specifications for tests -- [x] Yaml specifications for tests -- [ ] Dhall specifications for tests -- [ ] More specification features - - [x] Reference values from previous json responses in matchers - - [x] Environment variable interpolation - - [ ] Call out to arbitrary shell commands in and between test cases - - [ ] Timeouts - - [ ] Support for non-json content type - - [ ] Retry logic -- [ ] A DSL for writing test specs - diff --git a/app/Main.hs b/app/Main.hs index fd83995..b46e2fe 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -17,27 +17,28 @@ import Testing.CurlRunnings.Types -- | Command line flags data CurlRunnings = CurlRunnings { file :: FilePath + , grep :: Maybe T.Text } deriving (Show, Data, Typeable, Eq) -- | cmdargs object argParser :: CurlRunnings argParser = - CurlRunnings {file = def &= typFile &= help "File to run"} &= + CurlRunnings {file = def &= typFile &= help "File to run", grep = def &= help "Regex to filter test cases by name"} &= summary ("curl-runnings " ++ showVersion version) &= program "curl-runnings" &= verbosity &= help "Use the --file or -f flag to specify an intput file spec to run" -runFile :: FilePath -> Verbosity -> IO () -runFile "" _ = +runFile :: FilePath -> Verbosity -> Maybe T.Text -> IO () +runFile "" _ _ = putStrLn "Please specify an input file with the --file (-f) flag or use --help for more information" -runFile path verbosityLevel = do +runFile path verbosityLevel regexp = do home <- getEnv "HOME" suite <- decodeFile . T.unpack $ T.replace "~" (T.pack home) (T.pack path) case suite of Right s -> do - results <- runSuite s $ toLogLevel verbosityLevel + results <- runSuite (s { suiteCaseFilter = regexp }) $ toLogLevel verbosityLevel if any isFailing results then putStrLn (T.unpack $ makeRed "Some tests failed") >> exitWith (ExitFailure 1) @@ -53,4 +54,4 @@ main :: IO () main = do userArgs <- cmdArgs argParser verbosityLevel <- getVerbosity - runFile (file userArgs) verbosityLevel + runFile (file userArgs) verbosityLevel (grep userArgs) diff --git a/curl-runnings.cabal b/curl-runnings.cabal index 8a2afb8..c7fe0cd 100644 --- a/curl-runnings.cabal +++ b/curl-runnings.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 54edbac6796242d948bec056fc052da66e68a038e47c65233a4600b0321666a3 +-- hash: 8ef22999ea1898841e719329745691890631e19500f94c71ae498066d285f192 name: curl-runnings -version: 0.8.3 +version: 0.8.4 synopsis: A framework for declaratively writing curl based API tests description: Please see the README on Github at category: Testing @@ -45,6 +45,7 @@ library , http-types >=0.9.1 , megaparsec >=6.3.0 , pretty-simple >=2.0.2.1 + , regex-posix >=0.95.2 , text >=1.2.2.2 , unordered-containers >=0.2.8.0 , vector >=0.12.0 diff --git a/package.yaml b/package.yaml index f56bf45..e9464c0 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: curl-runnings -version: 0.8.3 +version: 0.8.4 github: aviaviavi/curl-runnings license: MIT author: Avi Press @@ -42,6 +42,7 @@ library: - http-types >=0.9.1 - megaparsec >=6.3.0 - pretty-simple >=2.0.2.1 + - regex-posix >=0.95.2 - text >=1.2.2.2 - unordered-containers >=0.2.8.0 - vector >=0.12.0 diff --git a/src/Testing/CurlRunnings.hs b/src/Testing/CurlRunnings.hs index 17816d9..7107646 100644 --- a/src/Testing/CurlRunnings.hs +++ b/src/Testing/CurlRunnings.hs @@ -4,11 +4,10 @@ -- | curl-runnings is a framework for writing declaratively writing curl based tests for your API's. -- Write your test specifications with yaml or json, and you're done! module Testing.CurlRunnings - ( - runCase - , runSuite - , decodeFile - ) where + ( runCase + , runSuite + , decodeFile + ) where import Control.Monad import Data.Aeson @@ -33,20 +32,20 @@ import Testing.CurlRunnings.Internal import Testing.CurlRunnings.Internal.Parser import Testing.CurlRunnings.Types import Text.Printf +import Text.Regex.Posix -- | decode a json or yaml file into a suite object decodeFile :: FilePath -> IO (Either String CurlSuite) -decodeFile specPath = doesFileExist specPath >>= \exists -> - if exists then - case last $ T.splitOn "." (T.pack specPath) of - "json" -> - eitherDecode' <$> B.readFile specPath :: IO (Either String CurlSuite) - "yaml" -> - mapLeft show <$> YI.decodeFileEither specPath - "yml" -> - mapLeft show <$> YI.decodeFileEither specPath - _ -> return . Left $ printf "Invalid spec path %s" specPath - else return . Left $ printf "%s not found" specPath +decodeFile specPath = + doesFileExist specPath >>= \exists -> + if exists + then case last $ T.splitOn "." (T.pack specPath) of + "json" -> + eitherDecode' <$> B.readFile specPath :: IO (Either String CurlSuite) + "yaml" -> mapLeft show <$> YI.decodeFileEither specPath + "yml" -> mapLeft show <$> YI.decodeFileEither specPath + _ -> return . Left $ printf "Invalid spec path %s" specPath + else return . Left $ printf "%s not found" specPath -- | Run a single test case, and returns the result. IO is needed here since this method is responsible -- for actually curling the test case endpoint and parsing the result. @@ -74,9 +73,7 @@ runCase state curlCase = do logger state DEBUG - ("Request body: " <> - (pShow $ - fromMaybe emptyObject replacedJSON)) + ("Request body: " <> (pShow $ fromMaybe emptyObject replacedJSON)) response <- httpBS request logger state DEBUG (pShow response) returnVal <- @@ -97,7 +94,8 @@ runCase state curlCase = do failures -> CaseFail curlCase (Just receivedHeaders) returnVal failures -checkHeaders :: CurlRunningsState -> CurlCase -> Headers -> Maybe AssertionFailure +checkHeaders :: + CurlRunningsState -> CurlCase -> Headers -> Maybe AssertionFailure checkHeaders _ (CurlCase _ _ _ _ _ _ _ Nothing) _ = Nothing checkHeaders state curlCase@(CurlCase _ _ _ _ _ _ _ (Just (HeaderMatcher m))) receivedHeaders = let interpolatedHeaders = mapM (interpolatePartialHeader state) m @@ -116,7 +114,10 @@ checkHeaders state curlCase@(CurlCase _ _ _ _ _ _ _ (Just (HeaderMatcher m))) re (HeaderMatcher headerList) receivedHeaders -interpolatePartialHeader :: CurlRunningsState -> PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher +interpolatePartialHeader :: + CurlRunningsState + -> PartialHeaderMatcher + -> Either QueryError PartialHeaderMatcher interpolatePartialHeader state (PartialHeaderMatcher k v) = let k' = interpolateQueryString state <$> k v' = interpolateQueryString state <$> v @@ -163,77 +164,93 @@ printR x = print x >> return x -- | Runs the test cases in order and stop when an error is hit. Returns all the results runSuite :: CurlSuite -> LogLevel -> IO [CaseResult] -runSuite (CurlSuite cases) logLevel = do +runSuite (CurlSuite cases filterRegex) logLevel = do fullEnv <- getEnvironment let envMap = H.fromList $ map (\(x, y) -> (T.pack x, T.pack y)) fullEnv + filterNameByRegexp curlCase = + maybe + True + (\regexp -> T.unpack (name curlCase) =~ T.unpack regexp :: Bool) + filterRegex foldM (\prevResults curlCase -> case safeLast prevResults of Just CaseFail {} -> return prevResults Just CasePass {} -> do - result <- runCase (CurlRunningsState envMap prevResults logLevel) curlCase >>= printR + result <- + runCase (CurlRunningsState envMap prevResults logLevel) curlCase >>= + printR return $ prevResults ++ [result] Nothing -> do - result <- runCase (CurlRunningsState envMap [] logLevel) curlCase >>= printR + result <- + runCase (CurlRunningsState envMap [] logLevel) curlCase >>= printR return [result]) [] - cases + (filter filterNameByRegexp cases) -- | Check if the retrieved value fail's the case's assertion -checkBody :: CurlRunningsState -> CurlCase -> Maybe Value -> Maybe AssertionFailure +checkBody :: + CurlRunningsState -> CurlCase -> Maybe Value -> Maybe AssertionFailure -- | We are looking for an exact payload match, and we have a payload to check checkBody state curlCase@(CurlCase _ _ _ _ _ (Just (Exactly expectedValue)) _ _) (Just receivedBody) = case runReplacements state expectedValue of (Left err) -> Just $ QueryFailure curlCase err (Right interpolated) -> - if (unsafeLogger state DEBUG "exact body matcher" interpolated) /= receivedBody + if (unsafeLogger state DEBUG "exact body matcher" interpolated) /= + receivedBody then Just $ DataFailure (curlCase {expectData = Just $ Exactly interpolated}) (Exactly interpolated) (Just receivedBody) else Nothing - -- | We are checking a list of expected subvalues, and we have a payload to check checkBody state curlCase@(CurlCase _ _ _ _ _ (Just (Contains subexprs)) _ _) (Just receivedBody) = case runReplacementsOnSubvalues state subexprs of Left f -> Just $ QueryFailure curlCase f Right updatedMatcher -> - if jsonContainsAll receivedBody (unsafeLogger state DEBUG "partial json body matcher" updatedMatcher) + if jsonContainsAll + receivedBody + (unsafeLogger state DEBUG "partial json body matcher" updatedMatcher) then Nothing else Just $ DataFailure curlCase (Contains updatedMatcher) (Just receivedBody) - -- | We are checking a list of expected absent subvalues, and we have a payload to check checkBody state curlCase@(CurlCase _ _ _ _ _ (Just (NotContains subexprs)) _ _) (Just receivedBody) = case runReplacementsOnSubvalues state subexprs of Left f -> Just $ QueryFailure curlCase f Right updatedMatcher -> - if jsonContainsAny receivedBody (unsafeLogger state DEBUG "partial json body matcher" updatedMatcher) + if jsonContainsAny + receivedBody + (unsafeLogger state DEBUG "partial json body matcher" updatedMatcher) then Just $ - DataFailure curlCase (NotContains updatedMatcher) (Just receivedBody) + DataFailure + curlCase + (NotContains updatedMatcher) + (Just receivedBody) else Nothing - -- | We are checking for both contains and notContains vals, and we have a payload to check checkBody state curlCase@(CurlCase _ _ _ _ _ (Just m@(MixedContains subexprs)) _ _) receivedBody = - let failure = join $ + let failure = + join $ find isJust (map - (\subexpr -> - checkBody state curlCase {expectData = Just subexpr} receivedBody) - subexprs) - in - fmap (\_ -> DataFailure curlCase m receivedBody ) failure - + (\subexpr -> + checkBody + state + curlCase {expectData = Just subexpr} + receivedBody) + subexprs) + in fmap (\_ -> DataFailure curlCase m receivedBody) failure -- | We expected a body but didn't get one checkBody _ curlCase@(CurlCase _ _ _ _ _ (Just anything) _ _) Nothing = Just $ DataFailure curlCase anything Nothing - -- | No assertions on the body checkBody _ (CurlCase _ _ _ _ _ Nothing _ _) _ = Nothing -runReplacementsOnSubvalues :: CurlRunningsState -> [JsonSubExpr] -> Either QueryError [JsonSubExpr] +runReplacementsOnSubvalues :: + CurlRunningsState -> [JsonSubExpr] -> Either QueryError [JsonSubExpr] runReplacementsOnSubvalues state = mapM (\expr -> @@ -296,7 +313,8 @@ runReplacements _ s@(String "") = Right s runReplacements state (String s) = case parseQuery s of Right [LiteralText t] -> Right $ String t - Right [q@(InterpolatedQuery _ _)] -> getStringValueForQuery state q >>= (Right . String) + Right [q@(InterpolatedQuery _ _)] -> + getStringValueForQuery state q >>= (Right . String) Right [q@(NonInterpolatedQuery _)] -> getValueForQuery state q Right _ -> mapRight String $ interpolateQueryString state s Left parseErr -> Left parseErr @@ -304,7 +322,8 @@ runReplacements _ valToUpdate = Right valToUpdate -- | Given a query string, return some text with interpolated values. Type -- errors will be returned if queries don't resolve to strings -interpolateQueryString :: CurlRunningsState -> FullQueryText -> Either QueryError T.Text +interpolateQueryString :: + CurlRunningsState -> FullQueryText -> Either QueryError T.Text interpolateQueryString state query = let parsedQuery = parseQuery query in case parsedQuery of @@ -318,7 +337,8 @@ interpolateQueryString state query = in fromMaybe (Right $ foldr (<>) (T.pack "") goodLookups) failure -- | Lookup the text at the specified query -getStringValueForQuery :: CurlRunningsState -> InterpolatedQuery -> Either QueryError T.Text +getStringValueForQuery :: + CurlRunningsState -> InterpolatedQuery -> Either QueryError T.Text getStringValueForQuery _ (LiteralText rawText) = Right rawText getStringValueForQuery state (NonInterpolatedQuery q) = getStringValueForQuery state $ InterpolatedQuery "" q @@ -331,35 +351,52 @@ getStringValueForQuery (CurlRunningsState env _ _) (InterpolatedQuery rawText (E Right $ rawText <> H.lookupDefault "" v env -- | Lookup the value for the specified query -getValueForQuery :: CurlRunningsState -> InterpolatedQuery -> Either QueryError Value +getValueForQuery :: + CurlRunningsState -> InterpolatedQuery -> Either QueryError Value getValueForQuery _ (LiteralText rawText) = Right $ String rawText getValueForQuery (CurlRunningsState _ previousResults _) full@(NonInterpolatedQuery (Query indexes)) = case head indexes of (CaseResultIndex i) -> - let (CasePass _ _ returnedJSON) = arrayGet previousResults $ fromInteger i - jsonToIndex = - case returnedJSON of - Just v -> Right v - Nothing -> - Left $ - NullPointer - (T.pack $ show full) - "No data was returned from this case" - in foldl - (\eitherVal index -> - case (eitherVal, index) of - (Left l, _) -> Left l - (Right (Object o), KeyIndex k) -> - Right $ H.lookupDefault Null k o - (Right (Array a), ArrayIndex i') -> Right $ arrayGet (V.toList a) $ fromInteger i' - (Right Null, q) -> - Left $ NullPointer (T.pack $ show full) (T.pack $ show q) - (Right o, _) -> Left $ QueryTypeMismatch (T.pack $ show index) o) - jsonToIndex - (tail indexes) + let maybeCase = arrayGet previousResults $ fromInteger i + in if isJust maybeCase + then let (CasePass _ _ returnedJSON) = fromJust maybeCase + jsonToIndex = + case returnedJSON of + Just v -> Right v + Nothing -> + Left $ + NullPointer + (T.pack $ show full) + "No data was returned from this case" + in foldl + (\eitherVal index -> + case (eitherVal, index) of + (Left l, _) -> Left l + (Right (Object o), KeyIndex k) -> + Right $ H.lookupDefault Null k o + (Right (Array a), ArrayIndex i') -> + maybe + (Left $ + NullPointer (T.pack $ show full) $ + "Array index not found: " <> T.pack (show i')) + Right + (arrayGet (V.toList a) $ fromInteger i') + (Right Null, q) -> + Left $ + NullPointer (T.pack $ show full) (T.pack $ show q) + (Right o, _) -> + Left $ QueryTypeMismatch (T.pack $ show index) o) + jsonToIndex + (tail indexes) + else Left $ + NullPointer (T.pack $ show full) $ + "Attempted to index into previous a test case that didn't exist: " <> + T.pack (show i) _ -> Left . QueryValidationError $ - T.pack $ "$<> queries must start with a RESPONSES[index] query: " ++ show full + T.pack $ + "'$< ... >' queries must start with a RESPONSES[index] query: " ++ + show full getValueForQuery (CurlRunningsState env _ _) (NonInterpolatedQuery (EnvironmentVariable var)) = Right . String $ H.lookupDefault "" var env getValueForQuery state (InterpolatedQuery _ q) = @@ -369,19 +406,19 @@ getValueForQuery state (InterpolatedQuery _ q) = Right v -> Left $ QueryTypeMismatch (T.pack "Expected a string") v Left l -> Left l -jsonContains :: ((JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool) - -> Value -> [JsonSubExpr] -> Bool +jsonContains :: + ((JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool) + -> Value + -> [JsonSubExpr] + -> Bool jsonContains f jsonValue = - let - traversedValue = traverseValue jsonValue - in - f $ \match -> - case match of - ValueMatch subval -> subval `elem` traversedValue - KeyMatch key -> - any (`containsKey` key) traversedValue - KeyValueMatch key subval -> - any (\o -> containsKeyVal o key subval) traversedValue + let traversedValue = traverseValue jsonValue + in f $ \match -> + case match of + ValueMatch subval -> subval `elem` traversedValue + KeyMatch key -> any (`containsKey` key) traversedValue + KeyValueMatch key subval -> + any (\o -> containsKeyVal o key subval) traversedValue -- | Does the json value contain all of these sub-values? jsonContainsAll :: Value -> [JsonSubExpr] -> Bool @@ -393,15 +430,17 @@ jsonContainsAny = jsonContains any -- | Does the json value contain the given key value pair? containsKeyVal :: Value -> T.Text -> Value -> Bool -containsKeyVal jsonValue key val = case jsonValue of - Object o -> H.lookup key o == Just val - _ -> False +containsKeyVal jsonValue key val = + case jsonValue of + Object o -> H.lookup key o == Just val + _ -> False -- | Does the json value contain the given key value pair? containsKey :: Value -> T.Text -> Bool -containsKey jsonValue key = case jsonValue of - Object o -> isJust $ H.lookup key o - _ -> False +containsKey jsonValue key = + case jsonValue of + Object o -> isJust $ H.lookup key o + _ -> False -- | Fully traverse the json and return a list of all the values traverseValue :: Value -> [Value] @@ -435,7 +474,8 @@ fromHTTPHeader (a, b) = -- | Utility conversion from an HTTP header to a CurlRunnings header. toHTTPHeader :: Header -> HTTP.Header -toHTTPHeader (Header a b) = (CI.mk . B8S.pack $ T.unpack a, B8S.pack $ T.unpack b) +toHTTPHeader (Header a b) = + (CI.mk . B8S.pack $ T.unpack a, B8S.pack $ T.unpack b) -- | Utility conversion from CurlRunnings headers to HTTP headers. toHTTPHeaders :: Headers -> HTTP.RequestHeaders diff --git a/src/Testing/CurlRunnings/Internal.hs b/src/Testing/CurlRunnings/Internal.hs index 2385644..859a526 100644 --- a/src/Testing/CurlRunnings/Internal.hs +++ b/src/Testing/CurlRunnings/Internal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + -- | This module specifies any utilities used by this package. At this time, -- consider everything in this module to be private to the curl-runnings package module Testing.CurlRunnings.Internal @@ -11,7 +12,6 @@ module Testing.CurlRunnings.Internal , makeLogger , makeUnsafeLogger , pShow - , LogLevel(..) , CurlRunningsLogger , CurlRunningsUnsafeLogger @@ -19,10 +19,10 @@ module Testing.CurlRunnings.Internal import Control.Monad import Data.Monoid +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import Debug.Trace import qualified Text.Pretty.Simple as P -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL makeGreen :: T.Text -> T.Text makeGreen s = "\x1B[32m" <> s <> "\x1B[0m" @@ -41,16 +41,21 @@ mapRight f (Right v) = Right $ f v mapRight _ (Left v) = Left v mapLeft :: (a -> c) -> Either a b -> Either c b -mapLeft f (Left v) = Left $ f v -mapLeft _ (Right v) = Right v +mapLeft f (Left v) = Left $ f v +mapLeft _ (Right v) = Right v -- | Array indexing with negative values allowed -arrayGet :: [a] -> Int -> a +arrayGet :: [a] -> Int -> Maybe a arrayGet a i - | i >= 0 = a !! i - | otherwise = a !! (length a + i) + | (i >= 0 && length a <= abs i) || null a || (i < 0 && length a <= (abs i - 1)) = Nothing + | i >= 0 = Just $ a !! i + | otherwise = Just $ a !! (length a + i) -data LogLevel = ERROR | INFO | DEBUG deriving (Show, Eq, Ord, Enum) +data LogLevel + = ERROR + | INFO + | DEBUG + deriving (Show, Eq, Ord, Enum) -- | A logger that respects the verbosity level given by input args type CurlRunningsLogger = (LogLevel -> T.Text -> IO ()) @@ -61,14 +66,10 @@ type CurlRunningsLogger = (LogLevel -> T.Text -> IO ()) type CurlRunningsUnsafeLogger a = (LogLevel -> T.Text -> a -> a) makeLogger :: LogLevel -> CurlRunningsLogger -makeLogger threshold level text = - when (level <= threshold) $ P.pPrint text +makeLogger threshold level text = when (level <= threshold) $ P.pPrint text makeUnsafeLogger :: Show a => LogLevel -> CurlRunningsUnsafeLogger a makeUnsafeLogger threshold level text object = - if level <= threshold then - tracer text object - else - object - - + if level <= threshold + then tracer text object + else object diff --git a/src/Testing/CurlRunnings/Types.hs b/src/Testing/CurlRunnings/Types.hs index be1174d..83799e4 100644 --- a/src/Testing/CurlRunnings/Types.hs +++ b/src/Testing/CurlRunnings/Types.hs @@ -134,9 +134,9 @@ data QueryError Value -- | The query was parse-able | QueryValidationError T.Text - -- | Tried to access a value in a null object - | NullPointer T.Text - T.Text + -- | Tried to access a value in a null object. + | NullPointer T.Text -- full query + T.Text -- message instance Show QueryError where show (QueryParseError t q) = printf "error parsing query %s: %s" q $ T.unpack t @@ -207,7 +207,6 @@ instance FromJSON JsonSubExpr where in case toParse of Object o -> KeyValueMatch <$> o .: "key" <*> o .: "value" _ -> typeMismatch "JsonSubExpr" toParse - | isJust $ H.lookup "keyMatch" v = let toParse = fromJust $ H.lookup "keyMatch" v in case toParse of @@ -365,15 +364,19 @@ instance Show CaseResult where -- | A wrapper type around a set of test cases. This is the top level spec type -- that we parse a test spec file into -newtype CurlSuite = - CurlSuite [CurlCase] - deriving (Show, Generic) +data CurlSuite = CurlSuite + { suiteCases :: [CurlCase] + , suiteCaseFilter :: Maybe T.Text + } deriving (Show, Generic) + +noFilterSuite :: [CurlCase] -> CurlSuite +noFilterSuite = flip CurlSuite Nothing instance ToJSON CurlSuite instance FromJSON CurlSuite where - parseJSON (Object v) = CurlSuite <$> v .: "cases" - parseJSON a@(Array _) = CurlSuite <$> parseJSON a + parseJSON (Object v) = noFilterSuite <$> v .: "cases" + parseJSON a@(Array _) = noFilterSuite <$> parseJSON a parseJSON invalid = typeMismatch "JsonMatcher" invalid -- | Simple predicate that checks if the result is passing diff --git a/test/Spec.hs b/test/Spec.hs index f13e872..a291495 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Main where @@ -6,6 +6,7 @@ import Data.Either import System.Directory import Test.Hspec import Testing.CurlRunnings +import Testing.CurlRunnings.Internal import Testing.CurlRunnings.Internal.Parser main :: IO () @@ -42,6 +43,21 @@ main = hspec $ parseQuery "$" `shouldSatisfy` isLeft parseQuery "some text $" `shouldSatisfy` isLeft + it "arrayGet should handle positive and negative indexes correctly" $ do + let a = [1, 2, 3] + b = [] :: [Int] + (arrayGet a 0) `shouldBe` Just 1 + (arrayGet a 1) `shouldBe` Just 2 + (arrayGet a 2) `shouldBe` Just 3 + (arrayGet a (-1)) `shouldBe` Just 3 + (arrayGet a (-2)) `shouldBe` Just 2 + (arrayGet a (-3)) `shouldBe` Just 1 + (arrayGet a (-4)) `shouldBe` Nothing + (arrayGet a 3) `shouldBe` Nothing + (arrayGet b 0) `shouldBe` Nothing + (arrayGet b 1) `shouldBe` Nothing + (arrayGet b (-1)) `shouldBe` Nothing + testValidSpec :: String -> IO () testValidSpec file = do currentDirectory <- getCurrentDirectory