ogma-language-jsonspec 1.14.0 → 1.15.0

raw patch · 3 files changed

+156/−41 lines, 3 filesdep +filepathdep ~ogma-specPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath

Dependency ranges changed: ogma-spec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• ogma-language-jsonspec.cabal +3/−2
• src/Language/JSONSpec/Parser.hs +147/−39

@@ -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).

@@ -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

@@ -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