From 95281286eab75a9898712fc4bffd716f08ed81f5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 19 Jan 2025 08:32:02 +0000 Subject: [PATCH] ogma-core: Make it possible for the file format to be a local file. Refs #200. Ogma allows users to select the format used for the JSON file, but only known formats can be selected. Users should be able to pass a local file containing a JSON format specification as an argument. This commit modifies the standalone backend so that, if a file exists with the name of the format selected, or if the format name contains a path separator, then it is treated as a local file. Otherwise, Ogma finds the file in the package's data directory. --- ogma-core/ogma-core.cabal | 1 + ogma-core/src/Command/Standalone.hs | 72 ++++++++++++++++++----------- 2 files changed, 47 insertions(+), 26 deletions(-) diff --git a/ogma-core/ogma-core.cabal b/ogma-core/ogma-core.cabal index 07f1d7a1..18c3d0e4 100644 --- a/ogma-core/ogma-core.cabal +++ b/ogma-core/ogma-core.cabal @@ -123,6 +123,7 @@ library , aeson >= 2.0.0.0 && < 2.2 , bytestring >= 0.10.8.2 && < 0.13 , containers >= 0.5 && < 0.8 + , directory >= 1.3.1.5 && < 1.4 , filepath >= 1.4.2 && < 1.6 , graphviz >= 2999.20 && < 2999.21 , megaparsec >= 8.0.0 && < 9.10 diff --git a/ogma-core/src/Command/Standalone.hs b/ogma-core/src/Command/Standalone.hs index b9d507a4..b7d9f712 100644 --- a/ogma-core/src/Command/Standalone.hs +++ b/ogma-core/src/Command/Standalone.hs @@ -44,8 +44,9 @@ import Control.Exception as E import Data.Aeson (decode, eitherDecode, object, (.=)) import Data.ByteString.Lazy (fromStrict) import Data.Foldable (for_) -import Data.List (nub, (\\)) +import Data.List (isInfixOf, nub, (\\)) import Data.Maybe (fromMaybe) +import System.Directory (doesFileExist) import System.Process (readProcess) import System.FilePath (()) import Data.Text.Lazy (pack) @@ -138,32 +139,45 @@ standalone' fp options (ExprPair parse replace print ids) = do let name = standaloneFilename options typeMaps = typeToCopilotTypeMapping options - -- Obtain format file + -- Obtain format file. + -- + -- A format name that exists as a file in the disk always takes preference + -- over a file format included with Ogma. A file format with a forward slash + -- in the name is always assumed to be a user-provided filename. + -- Regardless of whether the file is user-provided or known to Ogma, we check + -- (again) whether the file exists, and print an error message if not. + let formatName = standaloneFormat options + exists <- doesFileExist formatName dataDir <- getDataDir - let formatFile = - dataDir "data" "formats" - (standaloneFormat options ++ "_" ++ standalonePropFormat options) - - format <- read <$> readFile formatFile - - let wrapper = wrapVia (standalonePropVia options) parse - - -- All of the following operations use Either to return error messages. The - -- use of the monadic bind to pass arguments from one function to the next - -- will cause the program to stop at the earliest error. - content <- B.safeReadFile fp - res <- case content of - Left s -> return $ Left s - Right b -> do case eitherDecode b of - Left e -> return $ Left e - Right v -> parseJSONSpec wrapper format v - - -- Complement the specification with any missing/implicit definitions - let res' = fmap (addMissingIdentifiers ids) res - - let copilot = spec2Copilot name typeMaps replace print =<< specAnalyze =<< res' - - return copilot + let formatFile + | isInfixOf "/" formatName || exists + = formatName + | otherwise + = dataDir "data" "formats" + (standaloneFormat options ++ "_" ++ standalonePropFormat options) + formatMissing <- not <$> doesFileExist formatFile + + if formatMissing + then return $ Left $ standaloneIncorrectFormatSpec formatFile + else do + format <- read <$> readFile formatFile + + let wrapper = wrapVia (standalonePropVia options) parse + + -- All of the following operations use Either to return error messages. + -- The use of the monadic bind to pass arguments from one function to the + -- next will cause the program to stop at the earliest error. + content <- B.safeReadFile fp + res <- case content of + Left s -> return $ Left s + Right b -> do case eitherDecode b of + Left e -> return $ Left e + Right v -> parseJSONSpec wrapper format v + + -- Complement the specification with any missing/implicit definitions + let res' = fmap (addMissingIdentifiers ids) res + + return $ spec2Copilot name typeMaps replace print =<< specAnalyze =<< res' -- | Parse a property using an auxiliary program to first translate it, if -- available. @@ -236,6 +250,12 @@ standaloneTemplateError options fp exception = ++ " permissions to write in the destination directory. " ++ show exception +-- | Error message associated to the format file not being found. +standaloneIncorrectFormatSpec :: String -> String +standaloneIncorrectFormatSpec formatFile = + "The format specification " ++ formatFile ++ " does not exist or is not " + ++ "readable" + -- * Mapping of types from input format to Copilot typeToCopilotTypeMapping :: StandaloneOptions -> [(String, String)] typeToCopilotTypeMapping options =