diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Revision history for ogma-language-jsonspec +## [1.15.0] - 2026-07-21 + +* Version bump (1.15.0) (#508). +* Allow using file name as requirement ID in JSON files (#472). +* Apply multiple style fixes (#492). + ## [1.14.0] - 2026-05-21 * Version bump (1.14.0) (#425). diff --git a/ogma-language-jsonspec.cabal b/ogma-language-jsonspec.cabal --- a/ogma-language-jsonspec.cabal +++ b/ogma-language-jsonspec.cabal @@ -19,7 +19,7 @@ build-type: Simple name: ogma-language-jsonspec -version: 1.14.0 +version: 1.15.0 homepage: https://github.com/nasa/ogma bug-reports: https://github.com/nasa/ogma/issues license: Apache-2.0 @@ -58,13 +58,14 @@ build-depends: base >= 4.11.0.0 && < 5 , aeson >= 2.0.0.0 && < 2.3 + , filepath >= 1.4.2 && < 1.6 , jsonpath >= 0.3 && < 0.4 , text >= 1.2.3.1 && < 2.2 , megaparsec >= 8.0.0 && < 9.8 , mtl >= 2.2.2 && < 2.4 , bytestring >= 0.10.8.2 && < 0.13 - , ogma-spec >= 1.14.0 && < 1.15 + , ogma-spec >= 1.15.0 && < 1.16 hs-source-dirs: src diff --git a/src/Language/JSONSpec/Parser.hs b/src/Language/JSONSpec/Parser.hs --- a/src/Language/JSONSpec/Parser.hs +++ b/src/Language/JSONSpec/Parser.hs @@ -27,17 +27,19 @@ import Data.Aeson.Types (prependFailure, typeMismatch) import Data.Bifunctor (first) import Data.ByteString.Lazy (fromStrict) -import Data.JSONPath.Execute -import Data.JSONPath.Parser -import Data.JSONPath.Types +import Data.JSONPath.Execute (executeJSONPath) +import Data.JSONPath.Parser (jsonPath) +import Data.JSONPath.Types (JSONPathElement(..)) import Data.Text (pack, unpack) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T +import System.FilePath (takeBaseName, takeFileName) import Text.Megaparsec (eof, errorBundlePretty, parse) -- External imports: ogma-spec -import Data.OgmaSpec +import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..), + Requirement (..), Spec (..)) data JSONFormat = JSONFormat { specInternalVars :: Maybe String @@ -48,7 +50,7 @@ , specExternalVarId :: String , specExternalVarType :: Maybe String , specRequirements :: String - , specRequirementId :: String + , specRequirementId :: FieldSource , specRequirementDesc :: Maybe String , specRequirementExpr :: String , specRequirementResultType :: Maybe String @@ -56,6 +58,25 @@ } deriving (Read) +-- | Source used to populate the value of a field in a spec. +data FieldSource + = JSONPath String -- ^ JSON path + | FileName -- ^ Filename with extension + | BaseName -- ^ Filename without extension + deriving (Show) + +-- | Custom instance to read a 'FieldSource' that allows JSON paths to be +-- written down as plain strings. +instance Read FieldSource where + readsPrec prec str = + case lex str of + [("JSONPath", rest)] -> first JSONPath <$> readsPrec prec rest + [("FileName", rest)] -> [(FileName, rest)] + [("BaseName", rest)] -> [(BaseName, rest)] + -- If it doesn't match a constructor, we attempt to read a string and + -- treat it as a JSONPath. + _ -> first JSONPath <$> readsPrec prec str + data JSONFormatInternal = JSONFormatInternal { jfiInternalVars :: Maybe [JSONPathElement] , jfiInternalVarId :: [JSONPathElement] @@ -65,28 +86,55 @@ , jfiExternalVarId :: [JSONPathElement] , jfiExternalVarType :: Maybe [JSONPathElement] , jfiRequirements :: [JSONPathElement] - , jfiRequirementId :: [JSONPathElement] + , jfiRequirementId :: FieldSourceInternal , jfiRequirementDesc :: Maybe [JSONPathElement] , jfiRequirementExpr :: [JSONPathElement] , jfiRequirementResultType :: Maybe [JSONPathElement] , jfiRequirementResultExpr :: Maybe [JSONPathElement] } +-- | Internal representation of the source used to populate the value of a +-- field in a spec. +data FieldSourceInternal + = FSIJSONPath [JSONPathElement] -- ^ JSON path + | FSIFileName -- ^ Filename with extension + | FSIBaseName -- ^ Filename without extension + deriving (Show) + parseJSONFormat :: JSONFormat -> Either String JSONFormatInternal parseJSONFormat jsonFormat = do - jfi2 <- showErrorsM $ fmap (parseJSONPath . pack) $ specInternalVars jsonFormat - jfi3 <- showErrors $ parseJSONPath $ pack $ specInternalVarId jsonFormat - jfi4 <- showErrors $ parseJSONPath $ pack $ specInternalVarExpr jsonFormat - jfi5 <- showErrorsM $ fmap (parseJSONPath . pack) $ specInternalVarType jsonFormat - jfi6 <- showErrorsM $ fmap (parseJSONPath . pack) $ specExternalVars jsonFormat - jfi7 <- showErrors $ parseJSONPath $ pack $ specExternalVarId jsonFormat - jfi8 <- showErrorsM $ fmap (parseJSONPath . pack) $ specExternalVarType jsonFormat - jfi9 <- showErrors $ parseJSONPath $ pack $ specRequirements jsonFormat - jfi10 <- showErrors $ parseJSONPath $ pack $ specRequirementId jsonFormat - jfi11 <- showErrorsM $ fmap (parseJSONPath . pack) $ specRequirementDesc jsonFormat - jfi12 <- showErrors $ parseJSONPath $ pack $ specRequirementExpr jsonFormat - jfi13 <- showErrorsM $ fmap (parseJSONPath . pack) $ specRequirementResultType jsonFormat - jfi14 <- showErrorsM $ fmap (parseJSONPath . pack) $ specRequirementResultExpr jsonFormat + jfi2 <- showErrorsM $ + fmap (parseJSONPath . pack) $ specInternalVars jsonFormat + jfi3 <- showErrors $ + parseJSONPath $ pack $ specInternalVarId jsonFormat + jfi4 <- showErrors $ + parseJSONPath $ pack $ specInternalVarExpr jsonFormat + jfi5 <- showErrorsM $ + fmap (parseJSONPath . pack) $ specInternalVarType jsonFormat + jfi6 <- showErrorsM $ + fmap (parseJSONPath . pack) $ specExternalVars jsonFormat + jfi7 <- showErrors $ + parseJSONPath $ pack $ specExternalVarId jsonFormat + jfi8 <- showErrorsM $ + fmap (parseJSONPath . pack) $ specExternalVarType jsonFormat + jfi9 <- showErrors $ + parseJSONPath $ pack $ specRequirements jsonFormat + + -- Handle the case where the requirement ID is the file name, with or without + -- extension. + jfi10 <- case specRequirementId jsonFormat of + FileName -> return FSIFileName + BaseName -> return FSIBaseName + JSONPath p -> showErrors $ fmap FSIJSONPath $ parseJSONPath $ pack p + + jfi11 <- showErrorsM $ + fmap (parseJSONPath . pack) $ specRequirementDesc jsonFormat + jfi12 <- showErrors $ + parseJSONPath $ pack $ specRequirementExpr jsonFormat + jfi13 <- showErrorsM $ + fmap (parseJSONPath . pack) $ specRequirementResultType jsonFormat + jfi14 <- showErrorsM $ + fmap (parseJSONPath . pack) $ specRequirementResultExpr jsonFormat return $ JSONFormatInternal { jfiInternalVars = jfi2 , jfiInternalVarId = jfi3 @@ -103,47 +151,82 @@ , jfiRequirementResultExpr = jfi14 } -parseJSONSpec :: (String -> IO (Either String a)) -> JSONFormat -> Value -> IO (Either String (Spec a)) -parseJSONSpec parseExpr jsonFormat value = runExceptT $ do +parseJSONSpec :: (String -> IO (Either String a)) + -> JSONFormat + -> FilePath + -> Value + -> IO (Either String (Spec a)) +parseJSONSpec parseExpr jsonFormat filepath value = runExceptT $ do jsonFormatInternal <- except $ parseJSONFormat jsonFormat let values :: [Value] - values = maybe [] (`executeJSONPath` value) (jfiInternalVars jsonFormatInternal) + values = + maybe [] (`executeJSONPath` value) (jfiInternalVars jsonFormatInternal) internalVarDef :: Value -> Either String InternalVariableDef internalVarDef value = do let msg = "internal variable name" - varId <- valueToString msg =<< (listToEither msg (executeJSONPath (jfiInternalVarId jsonFormatInternal) value)) + varId <- valueToString msg =<< + listToEither + msg + ( executeJSONPath + (jfiInternalVarId jsonFormatInternal) + value + ) let msg = "internal variable type" - varType <- maybe (Right "") (\e -> valueToString msg =<< (listToEither msg (executeJSONPath e value))) (jfiInternalVarType jsonFormatInternal) + varType <- maybe + (Right "") + (\e -> valueToString msg =<< + listToEither msg (executeJSONPath e value) + ) + (jfiInternalVarType jsonFormatInternal) let msg = "internal variable expr" - varExpr <- valueToString msg =<< (listToEither msg (executeJSONPath (jfiInternalVarExpr jsonFormatInternal) value)) + varExpr <- valueToString msg =<< + listToEither + msg + ( executeJSONPath + (jfiInternalVarExpr jsonFormatInternal) + value + ) return $ InternalVariableDef - { internalVariableName = varId - , internalVariableType = varType - , internalVariableExpr = varExpr + { internalVariableName = varId + , internalVariableType = varType + , internalVariableExpr = varExpr } internalVariableDefs <- except $ mapM internalVarDef values let values :: [Value] - values = maybe [] (`executeJSONPath` value) (jfiExternalVars jsonFormatInternal) + values = + maybe [] (`executeJSONPath` value) (jfiExternalVars jsonFormatInternal) externalVarDef :: Value -> Either String ExternalVariableDef externalVarDef value = do let msg = "external variable name" - varId <- valueToString msg =<< (listToEither msg (executeJSONPath (jfiExternalVarId jsonFormatInternal) value)) + varId <- valueToString msg =<< + listToEither + msg + ( executeJSONPath + (jfiExternalVarId jsonFormatInternal) + value + ) let msg = "external variable type" - varType <- maybe (Right "") (\e -> valueToString msg =<< (listToEither msg (executeJSONPath e value))) (jfiExternalVarType jsonFormatInternal) + varType <- + maybe + (Right "") + (\e -> valueToString msg =<< + listToEither msg (executeJSONPath e value) + ) + (jfiExternalVarType jsonFormatInternal) return $ ExternalVariableDef - { externalVariableName = varId - , externalVariableType = varType + { externalVariableName = varId + , externalVariableType = varType } externalVariableDefs <- except $ mapM externalVarDef values @@ -154,23 +237,47 @@ -- requirementDef :: Value -> Either String (Requirement a) requirementDef value = do let msg = "Requirement name" - reqId <- except $ valueToString msg =<< (listToEither msg (executeJSONPath (jfiRequirementId jsonFormatInternal) value)) + -- Handle the case where the requirement ID is the file name, with or + -- without extension. + reqId <- case jfiRequirementId jsonFormatInternal of + FSIFileName -> return $ takeFileName filepath + FSIBaseName -> return $ takeBaseName filepath + FSIJSONPath p -> except $ + valueToString msg =<< listToEither msg (executeJSONPath p value) + let msg = "Requirement expression" - reqExpr <- except $ valueToString msg =<< (listToEither msg (executeJSONPath (jfiRequirementExpr jsonFormatInternal) value)) + reqExpr <- except $ valueToString msg =<< + listToEither + msg + ( executeJSONPath + (jfiRequirementExpr jsonFormatInternal) + value + ) reqExpr' <- ExceptT $ parseExpr reqExpr let msg = "Requirement description" - reqDesc <- except $ maybe (Right "") (\e -> valueToString msg =<< (listToEither msg (executeJSONPath e value))) (jfiRequirementDesc jsonFormatInternal) + reqDesc <- except $ maybe + (Right "") + (\e -> valueToString msg =<< + listToEither msg (executeJSONPath e value) + ) + (jfiRequirementDesc jsonFormatInternal) let msg = "Requirement result type" ty :: Maybe (Either String String) - ty = (\e -> valueToString msg =<< (listToEither msg (executeJSONPath e value))) <$> (jfiRequirementResultType jsonFormatInternal) + ty = (\e -> valueToString msg =<< + listToEither msg (executeJSONPath e value) + ) + <$> jfiRequirementResultType jsonFormatInternal reqResType <- except $ maybeEither ty let msg = "Requirement result expression" resultExpr :: Maybe (Either String String) - resultExpr = (\e -> valueToString msg =<< (listToEither msg (executeJSONPath e value))) <$> (jfiRequirementResultExpr jsonFormatInternal) + resultExpr = (\e -> valueToString msg =<< + listToEither msg (executeJSONPath e value) + ) + <$> jfiRequirementResultExpr jsonFormatInternal reqResExpr <- except $ maybeEither resultExpr reqResExpr' <- ExceptT $ case reqResExpr of @@ -191,7 +298,8 @@ valueToString :: String -> Value -> Either String String valueToString msg (String x) = Right $ unpack x -valueToString msg _ = Left $ "The JSON value provided for " ++ msg ++ " does not contain a string" +valueToString msg _ = Left $ + "The JSON value provided for " ++ msg ++ " does not contain a string" listToEither :: String -> [a] -> Either String a listToEither _ [x] = Right x