-- 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           Control.Monad.Except  (ExceptT (..), runExceptT)
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
    , JSONFormat -> Maybe String
specRequirementResultType :: Maybe String
    , JSONFormat -> Maybe String
specRequirementResultExpr :: Maybe String
    }
  deriving (ReadPrec [JSONFormat]
ReadPrec JSONFormat
Int -> ReadS JSONFormat
ReadS [JSONFormat]
(Int -> ReadS JSONFormat)
-> ReadS [JSONFormat]
-> ReadPrec JSONFormat
-> ReadPrec [JSONFormat]
-> Read JSONFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS JSONFormat
readsPrec :: Int -> ReadS JSONFormat
$creadList :: ReadS [JSONFormat]
readList :: ReadS [JSONFormat]
$creadPrec :: ReadPrec JSONFormat
readPrec :: ReadPrec JSONFormat
$creadListPrec :: ReadPrec [JSONFormat]
readListPrec :: ReadPrec [JSONFormat]
Read)

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]
  , JSONFormatInternal -> Maybe [JSONPathElement]
jfiRequirementResultType :: Maybe [JSONPathElement]
  , JSONFormatInternal -> Maybe [JSONPathElement]
jfiRequirementResultExpr :: Maybe [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
  Maybe [JSONPathElement]
jfi13 <- 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
specRequirementResultType JSONFormat
jsonFormat
  Maybe [JSONPathElement]
jfi14 <- 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
specRequirementResultExpr 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
             , jfiRequirementResultType :: Maybe [JSONPathElement]
jfiRequirementResultType = Maybe [JSONPathElement]
jfi13
             , jfiRequirementResultExpr :: Maybe [JSONPathElement]
jfiRequirementResultExpr = Maybe [JSONPathElement]
jfi14
             }

parseJSONSpec :: (String -> IO (Either String a)) -> JSONFormat -> Value -> IO (Either String (Spec a))
parseJSONSpec :: forall a.
(String -> IO (Either String a))
-> JSONFormat -> Value -> IO (Either String (Spec a))
parseJSONSpec String -> IO (Either String a)
parseExpr JSONFormat
jsonFormat Value
value = ExceptT String IO (Spec a) -> IO (Either String (Spec a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO (Spec a) -> IO (Either String (Spec a)))
-> ExceptT String IO (Spec a) -> IO (Either String (Spec a))
forall a b. (a -> b) -> a -> b
$ do
  JSONFormatInternal
jsonFormatInternal <- Either String JSONFormatInternal
-> ExceptT String IO JSONFormatInternal
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either String JSONFormatInternal
 -> ExceptT String IO JSONFormatInternal)
-> Either String JSONFormatInternal
-> ExceptT String IO JSONFormatInternal
forall a b. (a -> b) -> a -> b
$ 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 <- Either String [InternalVariableDef]
-> ExceptT String IO [InternalVariableDef]
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either String [InternalVariableDef]
 -> ExceptT String IO [InternalVariableDef])
-> Either String [InternalVariableDef]
-> ExceptT String IO [InternalVariableDef]
forall a b. (a -> b) -> a -> b
$ (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 <- Either String [ExternalVariableDef]
-> ExceptT String IO [ExternalVariableDef]
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either String [ExternalVariableDef]
 -> ExceptT String IO [ExternalVariableDef])
-> Either String [ExternalVariableDef]
-> ExceptT String IO [ExternalVariableDef]
forall a b. (a -> b) -> a -> b
$ (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 -> ExceptT String IO (Requirement a)
requirementDef Value
value = do
        let msg :: String
msg = String
"Requirement name"
        String
reqId <- Either String String -> ExceptT String IO String
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ 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 <- Either String String -> ExceptT String IO String
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ 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' <- IO (Either String a) -> ExceptT String IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String a) -> ExceptT String IO a)
-> IO (Either String a) -> ExceptT String IO a
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String a)
parseExpr String
reqExpr

        let msg :: String
msg = String
"Requirement description"
        String
reqDesc <- Either String String -> ExceptT String IO String
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ 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)

        let msg :: String
msg = String
"Requirement result type"
            ty :: Maybe (Either String String)
            ty :: Maybe (Either String String)
ty = (\[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))) ([JSONPathElement] -> Either String String)
-> Maybe [JSONPathElement] -> Maybe (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSONFormatInternal -> Maybe [JSONPathElement]
jfiRequirementResultType JSONFormatInternal
jsonFormatInternal)
        Maybe String
reqResType <- Either String (Maybe String) -> ExceptT String IO (Maybe String)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either String (Maybe String) -> ExceptT String IO (Maybe String))
-> Either String (Maybe String) -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe (Either String String) -> Either String (Maybe String)
forall a b. Maybe (Either a b) -> Either a (Maybe b)
maybeEither Maybe (Either String String)
ty

        let msg :: String
msg = String
"Requirement result expression"
            resultExpr :: Maybe (Either String String)
            resultExpr :: Maybe (Either String String)
resultExpr = (\[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))) ([JSONPathElement] -> Either String String)
-> Maybe [JSONPathElement] -> Maybe (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSONFormatInternal -> Maybe [JSONPathElement]
jfiRequirementResultExpr JSONFormatInternal
jsonFormatInternal)

        Maybe String
reqResExpr  <- Either String (Maybe String) -> ExceptT String IO (Maybe String)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either String (Maybe String) -> ExceptT String IO (Maybe String))
-> Either String (Maybe String) -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe (Either String String) -> Either String (Maybe String)
forall a b. Maybe (Either a b) -> Either a (Maybe b)
maybeEither Maybe (Either String String)
resultExpr
        Maybe a
reqResExpr' <- IO (Either String (Maybe a)) -> ExceptT String IO (Maybe a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String (Maybe a)) -> ExceptT String IO (Maybe a))
-> IO (Either String (Maybe a)) -> ExceptT String IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ case Maybe String
reqResExpr of
                                   Maybe String
Nothing -> Either String (Maybe a) -> IO (Either String (Maybe a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Maybe a) -> IO (Either String (Maybe a)))
-> Either String (Maybe a) -> IO (Either String (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
                                   Just String
x  -> (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Either String (Maybe a))
-> IO (Either String a) -> IO (Either String (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either String a)
parseExpr String
x

        Requirement a -> ExceptT String IO (Requirement a)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Requirement a -> ExceptT String IO (Requirement a))
-> Requirement a -> ExceptT String IO (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
                   , requirementResultType :: Maybe String
requirementResultType  = Maybe String
reqResType
                   , requirementResultExpr :: Maybe a
requirementResultExpr  = Maybe a
reqResExpr'
                   }

  [Requirement a]
requirements <- (Value -> ExceptT String IO (Requirement a))
-> [Value] -> ExceptT String IO [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 -> ExceptT String IO (Requirement a)
requirementDef [Value]
values

  Spec a -> ExceptT String IO (Spec a)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Spec a -> ExceptT String IO (Spec a))
-> Spec a -> ExceptT String IO (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)

-- | Wrap an 'Either' value in an @ExceptT m@ monad.
except :: Monad m => Either e a -> ExceptT e m a
except :: forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> (Either e a -> m (Either e a)) -> Either e a -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e a -> m (Either e a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Swap the order in a Maybe and an Either monad.
maybeEither :: Maybe (Either a b) -> Either a (Maybe b)
maybeEither :: forall a b. Maybe (Either a b) -> Either a (Maybe b)
maybeEither Maybe (Either a b)
Nothing  = Maybe b -> Either a (Maybe b)
forall a b. b -> Either a b
Right Maybe b
forall a. Maybe a
Nothing
maybeEither (Just Either a b
e) = (b -> Maybe b) -> Either a b -> Either a (Maybe b)
forall a b. (a -> b) -> Either a a -> Either a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just Either a b
e