-- Copyright 2024 United States Government as represented by the Administrator
-- of the National Aeronautics and Space Administration. All Rights Reserved.
--
-- Disclaimers
--
-- No Warranty: THE SUBJECT SOFTWARE IS PROVIDED "AS IS" WITHOUT ANY WARRANTY
-- OF ANY KIND, EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT
-- LIMITED TO, ANY WARRANTY THAT THE SUBJECT SOFTWARE WILL CONFORM TO
-- SPECIFICATIONS, ANY IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
-- PARTICULAR PURPOSE, OR FREEDOM FROM INFRINGEMENT, ANY WARRANTY THAT THE
-- SUBJECT SOFTWARE WILL BE ERROR FREE, OR ANY WARRANTY THAT DOCUMENTATION, IF
-- PROVIDED, WILL CONFORM TO THE SUBJECT SOFTWARE. THIS AGREEMENT DOES NOT, IN
-- ANY MANNER, CONSTITUTE AN ENDORSEMENT BY GOVERNMENT AGENCY OR ANY PRIOR
-- RECIPIENT OF ANY RESULTS, RESULTING DESIGNS, HARDWARE, SOFTWARE PRODUCTS OR
-- ANY OTHER APPLICATIONS RESULTING FROM USE OF THE SUBJECT SOFTWARE. FURTHER,
-- GOVERNMENT AGENCY DISCLAIMS ALL WARRANTIES AND LIABILITIES REGARDING
-- THIRD-PARTY SOFTWARE, IF PRESENT IN THE ORIGINAL SOFTWARE, AND DISTRIBUTES
-- IT "AS IS."
--
-- Waiver and Indemnity: RECIPIENT AGREES TO WAIVE ANY AND ALL CLAIMS AGAINST
-- THE UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS
-- ANY PRIOR RECIPIENT. IF RECIPIENT'S USE OF THE SUBJECT SOFTWARE RESULTS IN
-- ANY LIABILITIES, DEMANDS, DAMAGES, EXPENSES OR LOSSES ARISING FROM SUCH USE,
-- INCLUDING ANY DAMAGES FROM PRODUCTS BASED ON, OR RESULTING FROM, RECIPIENT'S
-- USE OF THE SUBJECT SOFTWARE, RECIPIENT SHALL INDEMNIFY AND HOLD HARMLESS THE
-- UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS ANY
-- PRIOR RECIPIENT, TO THE EXTENT PERMITTED BY LAW. RECIPIENT'S SOLE REMEDY
-- FOR ANY SUCH MATTER SHALL BE THE IMMEDIATE, UNILATERAL TERMINATION OF THIS
-- AGREEMENT.
--

-- | Parser for Ogma specs stored in JSON files.
module Language.JSONSpec.Parser where

-- External imports
import           Data.Aeson            (FromJSON (..), Value (..), decode, (.:))
import           Data.Aeson.Key        (toString)
import qualified Data.Aeson.KeyMap     as M
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.Text             (pack, unpack)
import qualified Data.Text             as T
import qualified Data.Text.Encoding    as T
import qualified Data.Text.IO          as T
import           Text.Megaparsec       (eof, errorBundlePretty, parse)

-- External imports: ogma-spec
import Data.OgmaSpec

data JSONFormat = JSONFormat
  { JSONFormat -> Maybe String
specInternalVars    :: Maybe String
  , JSONFormat -> String
specInternalVarId   :: String
  , JSONFormat -> String
specInternalVarExpr :: String
  , JSONFormat -> Maybe String
specInternalVarType :: Maybe String
  , JSONFormat -> Maybe String
specExternalVars    :: Maybe String
  , JSONFormat -> String
specExternalVarId   :: String
  , JSONFormat -> Maybe String
specExternalVarType :: Maybe String
  , JSONFormat -> String
specRequirements    :: String
  , JSONFormat -> String
specRequirementId   :: String
  , JSONFormat -> Maybe String
specRequirementDesc :: Maybe String
  , JSONFormat -> String
specRequirementExpr :: String
  }

data JSONFormatInternal = JSONFormatInternal
  { JSONFormatInternal -> Maybe [JSONPathElement]
jfiInternalVars    :: Maybe [JSONPathElement]
  , JSONFormatInternal -> [JSONPathElement]
jfiInternalVarId   :: [JSONPathElement]
  , JSONFormatInternal -> [JSONPathElement]
jfiInternalVarExpr :: [JSONPathElement]
  , JSONFormatInternal -> Maybe [JSONPathElement]
jfiInternalVarType :: Maybe [JSONPathElement]
  , JSONFormatInternal -> Maybe [JSONPathElement]
jfiExternalVars    :: Maybe [JSONPathElement]
  , JSONFormatInternal -> [JSONPathElement]
jfiExternalVarId   :: [JSONPathElement]
  , JSONFormatInternal -> Maybe [JSONPathElement]
jfiExternalVarType :: Maybe [JSONPathElement]
  , JSONFormatInternal -> [JSONPathElement]
jfiRequirements    :: [JSONPathElement]
  , JSONFormatInternal -> [JSONPathElement]
jfiRequirementId   :: [JSONPathElement]
  , JSONFormatInternal -> Maybe [JSONPathElement]
jfiRequirementDesc :: Maybe [JSONPathElement]
  , JSONFormatInternal -> [JSONPathElement]
jfiRequirementExpr :: [JSONPathElement]
  }

parseJSONFormat :: JSONFormat -> Either String JSONFormatInternal
parseJSONFormat :: JSONFormat -> Either String JSONFormatInternal
parseJSONFormat JSONFormat
jsonFormat = do
  Maybe [JSONPathElement]
jfi2  <- Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. Show a => Maybe (Either a b) -> Either String (Maybe b)
showErrorsM (Maybe (Either String [JSONPathElement])
 -> Either String (Maybe [JSONPathElement]))
-> Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ (String -> Either String [JSONPathElement])
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> (String -> Text) -> String -> Either String [JSONPathElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (Maybe String -> Maybe (Either String [JSONPathElement]))
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ JSONFormat -> Maybe String
specInternalVars    JSONFormat
jsonFormat
  [JSONPathElement]
jfi3  <- Either String [JSONPathElement] -> Either String [JSONPathElement]
forall a b. Show a => Either a b -> Either String b
showErrors (Either String [JSONPathElement]
 -> Either String [JSONPathElement])
-> Either String [JSONPathElement]
-> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> Text -> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSONFormat -> String
specInternalVarId   JSONFormat
jsonFormat
  [JSONPathElement]
jfi4  <- Either String [JSONPathElement] -> Either String [JSONPathElement]
forall a b. Show a => Either a b -> Either String b
showErrors (Either String [JSONPathElement]
 -> Either String [JSONPathElement])
-> Either String [JSONPathElement]
-> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> Text -> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSONFormat -> String
specInternalVarExpr JSONFormat
jsonFormat
  Maybe [JSONPathElement]
jfi5  <- Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. Show a => Maybe (Either a b) -> Either String (Maybe b)
showErrorsM (Maybe (Either String [JSONPathElement])
 -> Either String (Maybe [JSONPathElement]))
-> Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ (String -> Either String [JSONPathElement])
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> (String -> Text) -> String -> Either String [JSONPathElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (Maybe String -> Maybe (Either String [JSONPathElement]))
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ JSONFormat -> Maybe String
specInternalVarType JSONFormat
jsonFormat
  Maybe [JSONPathElement]
jfi6  <- Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. Show a => Maybe (Either a b) -> Either String (Maybe b)
showErrorsM (Maybe (Either String [JSONPathElement])
 -> Either String (Maybe [JSONPathElement]))
-> Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ (String -> Either String [JSONPathElement])
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> (String -> Text) -> String -> Either String [JSONPathElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (Maybe String -> Maybe (Either String [JSONPathElement]))
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ JSONFormat -> Maybe String
specExternalVars    JSONFormat
jsonFormat
  [JSONPathElement]
jfi7  <- Either String [JSONPathElement] -> Either String [JSONPathElement]
forall a b. Show a => Either a b -> Either String b
showErrors (Either String [JSONPathElement]
 -> Either String [JSONPathElement])
-> Either String [JSONPathElement]
-> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> Text -> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSONFormat -> String
specExternalVarId   JSONFormat
jsonFormat
  Maybe [JSONPathElement]
jfi8  <- Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. Show a => Maybe (Either a b) -> Either String (Maybe b)
showErrorsM (Maybe (Either String [JSONPathElement])
 -> Either String (Maybe [JSONPathElement]))
-> Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ (String -> Either String [JSONPathElement])
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> (String -> Text) -> String -> Either String [JSONPathElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (Maybe String -> Maybe (Either String [JSONPathElement]))
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ JSONFormat -> Maybe String
specExternalVarType JSONFormat
jsonFormat
  [JSONPathElement]
jfi9  <- Either String [JSONPathElement] -> Either String [JSONPathElement]
forall a b. Show a => Either a b -> Either String b
showErrors (Either String [JSONPathElement]
 -> Either String [JSONPathElement])
-> Either String [JSONPathElement]
-> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> Text -> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSONFormat -> String
specRequirements    JSONFormat
jsonFormat
  [JSONPathElement]
jfi10 <- Either String [JSONPathElement] -> Either String [JSONPathElement]
forall a b. Show a => Either a b -> Either String b
showErrors (Either String [JSONPathElement]
 -> Either String [JSONPathElement])
-> Either String [JSONPathElement]
-> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> Text -> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSONFormat -> String
specRequirementId   JSONFormat
jsonFormat
  Maybe [JSONPathElement]
jfi11 <- Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. Show a => Maybe (Either a b) -> Either String (Maybe b)
showErrorsM (Maybe (Either String [JSONPathElement])
 -> Either String (Maybe [JSONPathElement]))
-> Maybe (Either String [JSONPathElement])
-> Either String (Maybe [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ (String -> Either String [JSONPathElement])
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> (String -> Text) -> String -> Either String [JSONPathElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (Maybe String -> Maybe (Either String [JSONPathElement]))
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall a b. (a -> b) -> a -> b
$ JSONFormat -> Maybe String
specRequirementDesc JSONFormat
jsonFormat
  [JSONPathElement]
jfi12 <- Either String [JSONPathElement] -> Either String [JSONPathElement]
forall a b. Show a => Either a b -> Either String b
showErrors (Either String [JSONPathElement]
 -> Either String [JSONPathElement])
-> Either String [JSONPathElement]
-> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ Text -> Either String [JSONPathElement]
parseJSONPath (Text -> Either String [JSONPathElement])
-> Text -> Either String [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSONFormat -> String
specRequirementExpr JSONFormat
jsonFormat
  JSONFormatInternal -> Either String JSONFormatInternal
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSONFormatInternal -> Either String JSONFormatInternal)
-> JSONFormatInternal -> Either String JSONFormatInternal
forall a b. (a -> b) -> a -> b
$ JSONFormatInternal
             { jfiInternalVars :: Maybe [JSONPathElement]
jfiInternalVars    = Maybe [JSONPathElement]
jfi2
             , jfiInternalVarId :: [JSONPathElement]
jfiInternalVarId   = [JSONPathElement]
jfi3
             , jfiInternalVarExpr :: [JSONPathElement]
jfiInternalVarExpr = [JSONPathElement]
jfi4
             , jfiInternalVarType :: Maybe [JSONPathElement]
jfiInternalVarType = Maybe [JSONPathElement]
jfi5
             , jfiExternalVars :: Maybe [JSONPathElement]
jfiExternalVars    = Maybe [JSONPathElement]
jfi6
             , jfiExternalVarId :: [JSONPathElement]
jfiExternalVarId   = [JSONPathElement]
jfi7
             , jfiExternalVarType :: Maybe [JSONPathElement]
jfiExternalVarType = Maybe [JSONPathElement]
jfi8
             , jfiRequirements :: [JSONPathElement]
jfiRequirements    = [JSONPathElement]
jfi9
             , jfiRequirementId :: [JSONPathElement]
jfiRequirementId   = [JSONPathElement]
jfi10
             , jfiRequirementDesc :: Maybe [JSONPathElement]
jfiRequirementDesc = Maybe [JSONPathElement]
jfi11
             , jfiRequirementExpr :: [JSONPathElement]
jfiRequirementExpr = [JSONPathElement]
jfi12
             }

parseJSONSpec :: (String -> Either String a) -> JSONFormat -> Value -> Either String (Spec a)
parseJSONSpec :: forall a.
(String -> Either String a)
-> JSONFormat -> Value -> Either String (Spec a)
parseJSONSpec String -> Either String a
parseExpr JSONFormat
jsonFormat Value
value = do
  JSONFormatInternal
jsonFormatInternal <- JSONFormat -> Either String JSONFormatInternal
parseJSONFormat JSONFormat
jsonFormat

  let values :: [Value]
      values :: [Value]
values = [Value]
-> ([JSONPathElement] -> [Value])
-> Maybe [JSONPathElement]
-> [Value]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([JSONPathElement] -> Value -> [Value]
`executeJSONPath` Value
value) (JSONFormatInternal -> Maybe [JSONPathElement]
jfiInternalVars JSONFormatInternal
jsonFormatInternal)

      internalVarDef :: Value -> Either String InternalVariableDef
      internalVarDef :: Value -> Either String InternalVariableDef
internalVarDef Value
value = do
        let msg :: String
msg = String
"internal variable name"
        String
varId   <- String -> Value -> Either String String
valueToString String
msg (Value -> Either String String)
-> Either String Value -> Either String String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> [Value] -> Either String Value
forall a. String -> [a] -> Either String a
listToEither String
msg ([JSONPathElement] -> Value -> [Value]
executeJSONPath (JSONFormatInternal -> [JSONPathElement]
jfiInternalVarId JSONFormatInternal
jsonFormatInternal) Value
value))

        let msg :: String
msg = String
"internal variable type"
        String
varType <- Either String String
-> ([JSONPathElement] -> Either String String)
-> Maybe [JSONPathElement]
-> Either String String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String String
forall a b. b -> Either a b
Right String
"") (\[JSONPathElement]
e -> String -> Value -> Either String String
valueToString String
msg (Value -> Either String String)
-> Either String Value -> Either String String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> [Value] -> Either String Value
forall a. String -> [a] -> Either String a
listToEither String
msg ([JSONPathElement] -> Value -> [Value]
executeJSONPath [JSONPathElement]
e Value
value))) (JSONFormatInternal -> Maybe [JSONPathElement]
jfiInternalVarType JSONFormatInternal
jsonFormatInternal)

        let msg :: String
msg = String
"internal variable expr"
        String
varExpr <- String -> Value -> Either String String
valueToString String
msg (Value -> Either String String)
-> Either String Value -> Either String String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> [Value] -> Either String Value
forall a. String -> [a] -> Either String a
listToEither String
msg ([JSONPathElement] -> Value -> [Value]
executeJSONPath (JSONFormatInternal -> [JSONPathElement]
jfiInternalVarExpr JSONFormatInternal
jsonFormatInternal) Value
value))

        InternalVariableDef -> Either String InternalVariableDef
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalVariableDef -> Either String InternalVariableDef)
-> InternalVariableDef -> Either String InternalVariableDef
forall a b. (a -> b) -> a -> b
$ InternalVariableDef
                   { internalVariableName :: String
internalVariableName    = String
varId
                   , internalVariableType :: String
internalVariableType    = String
varType
                   , internalVariableExpr :: String
internalVariableExpr    = String
varExpr
                   }

  [InternalVariableDef]
internalVariableDefs <- (Value -> Either String InternalVariableDef)
-> [Value] -> Either String [InternalVariableDef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Either String InternalVariableDef
internalVarDef [Value]
values

  let values :: [Value]
      values :: [Value]
values = [Value]
-> ([JSONPathElement] -> [Value])
-> Maybe [JSONPathElement]
-> [Value]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([JSONPathElement] -> Value -> [Value]
`executeJSONPath` Value
value) (JSONFormatInternal -> Maybe [JSONPathElement]
jfiExternalVars JSONFormatInternal
jsonFormatInternal)

      externalVarDef :: Value -> Either String ExternalVariableDef
      externalVarDef :: Value -> Either String ExternalVariableDef
externalVarDef Value
value = do

        let msg :: String
msg = String
"external variable name"
        String
varId   <- String -> Value -> Either String String
valueToString String
msg (Value -> Either String String)
-> Either String Value -> Either String String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> [Value] -> Either String Value
forall a. String -> [a] -> Either String a
listToEither String
msg ([JSONPathElement] -> Value -> [Value]
executeJSONPath (JSONFormatInternal -> [JSONPathElement]
jfiExternalVarId JSONFormatInternal
jsonFormatInternal) Value
value))

        let msg :: String
msg = String
"external variable type"
        String
varType <- Either String String
-> ([JSONPathElement] -> Either String String)
-> Maybe [JSONPathElement]
-> Either String String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String String
forall a b. b -> Either a b
Right String
"") (\[JSONPathElement]
e -> String -> Value -> Either String String
valueToString String
msg (Value -> Either String String)
-> Either String Value -> Either String String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> [Value] -> Either String Value
forall a. String -> [a] -> Either String a
listToEither String
msg ([JSONPathElement] -> Value -> [Value]
executeJSONPath [JSONPathElement]
e Value
value))) (JSONFormatInternal -> Maybe [JSONPathElement]
jfiExternalVarType JSONFormatInternal
jsonFormatInternal)

        ExternalVariableDef -> Either String ExternalVariableDef
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExternalVariableDef -> Either String ExternalVariableDef)
-> ExternalVariableDef -> Either String ExternalVariableDef
forall a b. (a -> b) -> a -> b
$ ExternalVariableDef
                   { externalVariableName :: String
externalVariableName    = String
varId
                   , externalVariableType :: String
externalVariableType    = String
varType
                   }

  [ExternalVariableDef]
externalVariableDefs <- (Value -> Either String ExternalVariableDef)
-> [Value] -> Either String [ExternalVariableDef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Either String ExternalVariableDef
externalVarDef [Value]
values

  let values :: [Value]
      values :: [Value]
values = [JSONPathElement] -> Value -> [Value]
executeJSONPath (JSONFormatInternal -> [JSONPathElement]
jfiRequirements JSONFormatInternal
jsonFormatInternal) Value
value

      -- requirementDef :: Value -> Either String (Requirement a)
      requirementDef :: Value -> Either String (Requirement a)
requirementDef Value
value = do
        let msg :: String
msg = String
"Requirement name"
        String
reqId <- String -> Value -> Either String String
valueToString String
msg (Value -> Either String String)
-> Either String Value -> Either String String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> [Value] -> Either String Value
forall a. String -> [a] -> Either String a
listToEither String
msg ([JSONPathElement] -> Value -> [Value]
executeJSONPath (JSONFormatInternal -> [JSONPathElement]
jfiRequirementId JSONFormatInternal
jsonFormatInternal) Value
value))

        let msg :: String
msg = String
"Requirement expression"
        String
reqExpr <- String -> Value -> Either String String
valueToString String
msg (Value -> Either String String)
-> Either String Value -> Either String String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> [Value] -> Either String Value
forall a. String -> [a] -> Either String a
listToEither String
msg ([JSONPathElement] -> Value -> [Value]
executeJSONPath (JSONFormatInternal -> [JSONPathElement]
jfiRequirementExpr JSONFormatInternal
jsonFormatInternal) Value
value))
        a
reqExpr' <- String -> Either String a
parseExpr String
reqExpr

        let msg :: String
msg = String
"Requirement description"
        String
reqDesc <- Either String String
-> ([JSONPathElement] -> Either String String)
-> Maybe [JSONPathElement]
-> Either String String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String String
forall a b. b -> Either a b
Right String
"") (\[JSONPathElement]
e -> String -> Value -> Either String String
valueToString String
msg (Value -> Either String String)
-> Either String Value -> Either String String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> [Value] -> Either String Value
forall a. String -> [a] -> Either String a
listToEither String
msg ([JSONPathElement] -> Value -> [Value]
executeJSONPath [JSONPathElement]
e Value
value))) (JSONFormatInternal -> Maybe [JSONPathElement]
jfiRequirementDesc JSONFormatInternal
jsonFormatInternal)

        Requirement a -> Either String (Requirement a)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Requirement a -> Either String (Requirement a))
-> Requirement a -> Either String (Requirement a)
forall a b. (a -> b) -> a -> b
$ Requirement
                   { requirementName :: String
requirementName        = String
reqId
                   , requirementExpr :: a
requirementExpr        = a
reqExpr'
                   , requirementDescription :: String
requirementDescription = String
reqDesc
                   }

  [Requirement a]
requirements <- (Value -> Either String (Requirement a))
-> [Value] -> Either String [Requirement a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Either String (Requirement a)
requirementDef [Value]
values

  Spec a -> Either String (Spec a)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Spec a -> Either String (Spec a))
-> Spec a -> Either String (Spec a)
forall a b. (a -> b) -> a -> b
$ [InternalVariableDef]
-> [ExternalVariableDef] -> [Requirement a] -> Spec a
forall a.
[InternalVariableDef]
-> [ExternalVariableDef] -> [Requirement a] -> Spec a
Spec [InternalVariableDef]
internalVariableDefs [ExternalVariableDef]
externalVariableDefs [Requirement a]
requirements

valueToString :: String -> Value -> Either String String
valueToString :: String -> Value -> Either String String
valueToString String
msg (String Text
x) = String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
x
valueToString String
msg Value
_          = String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"The JSON value provided for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not contain a string"

listToEither :: String -> [a] -> Either String a
listToEither :: forall a. String -> [a] -> Either String a
listToEither String
_   [a
x] = a -> Either String a
forall a b. b -> Either a b
Right a
x
listToEither String
msg []  = String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Failed to find a value for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
listToEither String
msg [a]
_   = String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Unexpectedly found multiple values for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg

-- | Parse a JSONPath expression, returning its element components.
parseJSONPath :: T.Text -> Either String [JSONPathElement]
parseJSONPath :: Text -> Either String [JSONPathElement]
parseJSONPath = (ParseErrorBundle Text Void -> String)
-> Either (ParseErrorBundle Text Void) [JSONPathElement]
-> Either String [JSONPathElement]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle Text Void) [JSONPathElement]
 -> Either String [JSONPathElement])
-> (Text -> Either (ParseErrorBundle Text Void) [JSONPathElement])
-> Text
-> Either String [JSONPathElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text [JSONPathElement]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [JSONPathElement]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser () -> Parsec Void Text [JSONPathElement]
forall a. Parser a -> Parsec Void Text [JSONPathElement]
jsonPath Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
""

showErrors :: Show a => Either a b -> Either String b
showErrors :: forall a b. Show a => Either a b -> Either String b
showErrors (Left a
s)  = String -> Either String b
forall a b. a -> Either a b
Left (a -> String
forall a. Show a => a -> String
show a
s)
showErrors (Right b
x) = b -> Either String b
forall a b. b -> Either a b
Right b
x

showErrorsM :: Show a => Maybe (Either a b) -> Either String (Maybe b)
showErrorsM :: forall a b. Show a => Maybe (Either a b) -> Either String (Maybe b)
showErrorsM Maybe (Either a b)
Nothing          = Maybe b -> Either String (Maybe b)
forall a b. b -> Either a b
Right Maybe b
forall a. Maybe a
Nothing
showErrorsM (Just (Left a
s))  = String -> Either String (Maybe b)
forall a b. a -> Either a b
Left (a -> String
forall a. Show a => a -> String
show a
s)
showErrorsM (Just (Right b
x)) = Maybe b -> Either String (Maybe b)
forall a b. b -> Either a b
Right (b -> Maybe b
forall a. a -> Maybe a
Just b
x)