-- Copyright 2024 United States Government as represented by the Administrator
-- of the National Aeronautics and Space Administration. All Rights Reserved.
--
-- Disclaimers
--
-- Licensed under the Apache License, Version 2.0 (the "License"); you may
-- not use this file except in compliance with the License. You may obtain a
-- copy of the License at
--
--      https://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-- License for the specific language governing permissions and limitations
-- under the License.
--

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

-- External imports
import           Control.Monad.Except  (ExceptT (..), runExceptT)
import           Data.Aeson            (Value (..))
import           Data.Bifunctor        (first)
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           System.FilePath       (takeBaseName, takeFileName)
import           Text.Megaparsec       (eof, errorBundlePretty, parse)

-- External imports: ogma-spec
import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..),
                      Requirement (..), Spec (..))

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 -> FieldSource
specRequirementId         :: FieldSource
    , 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)

-- | 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 (Int -> FieldSource -> ShowS
[FieldSource] -> ShowS
FieldSource -> String
(Int -> FieldSource -> ShowS)
-> (FieldSource -> String)
-> ([FieldSource] -> ShowS)
-> Show FieldSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldSource -> ShowS
showsPrec :: Int -> FieldSource -> ShowS
$cshow :: FieldSource -> String
show :: FieldSource -> String
$cshowList :: [FieldSource] -> ShowS
showList :: [FieldSource] -> ShowS
Show)

-- | Custom instance to read a 'FieldSource' that allows JSON paths to be
-- written down as plain strings.
instance Read FieldSource where
  readsPrec :: Int -> ReadS FieldSource
readsPrec Int
prec String
str =
    case ReadS String
lex String
str of
      [(String
"JSONPath", String
rest)] -> (String -> FieldSource)
-> (String, String) -> (FieldSource, String)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> FieldSource
JSONPath ((String, String) -> (FieldSource, String))
-> [(String, String)] -> [(FieldSource, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
prec String
rest
      [(String
"FileName", String
rest)] -> [(FieldSource
FileName, String
rest)]
      [(String
"BaseName", String
rest)] -> [(FieldSource
BaseName, String
rest)]
      -- If it doesn't match a constructor, we attempt to read a string and
      -- treat it as a JSONPath.
      [(String, String)]
_                    -> (String -> FieldSource)
-> (String, String) -> (FieldSource, String)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> FieldSource
JSONPath ((String, String) -> (FieldSource, String))
-> [(String, String)] -> [(FieldSource, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
prec String
str

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 -> FieldSourceInternal
jfiRequirementId         :: FieldSourceInternal
  , JSONFormatInternal -> Maybe [JSONPathElement]
jfiRequirementDesc       :: Maybe [JSONPathElement]
  , JSONFormatInternal -> [JSONPathElement]
jfiRequirementExpr       :: [JSONPathElement]
  , JSONFormatInternal -> Maybe [JSONPathElement]
jfiRequirementResultType :: Maybe [JSONPathElement]
  , JSONFormatInternal -> 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 (Int -> FieldSourceInternal -> ShowS
[FieldSourceInternal] -> ShowS
FieldSourceInternal -> String
(Int -> FieldSourceInternal -> ShowS)
-> (FieldSourceInternal -> String)
-> ([FieldSourceInternal] -> ShowS)
-> Show FieldSourceInternal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldSourceInternal -> ShowS
showsPrec :: Int -> FieldSourceInternal -> ShowS
$cshow :: FieldSourceInternal -> String
show :: FieldSourceInternal -> String
$cshowList :: [FieldSourceInternal] -> ShowS
showList :: [FieldSourceInternal] -> ShowS
Show)

parseJSONFormat :: JSONFormat -> Either String JSONFormatInternal
parseJSONFormat :: JSONFormat -> Either String JSONFormatInternal
parseJSONFormat JSONFormat
jsonFormat = do
  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
$
            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 (String -> Either String [JSONPathElement])
-> Maybe String -> Maybe (Either String [JSONPathElement])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSONFormat -> Maybe String
specInternalVars JSONFormat
jsonFormat
  jfi3 <- showErrors $
            parseJSONPath $ pack $ specInternalVarId jsonFormat
  jfi4 <- showErrors $
            parseJSONPath $ pack $ specInternalVarExpr jsonFormat
  jfi5 <- showErrorsM $
            parseJSONPath . pack <$> specInternalVarType jsonFormat
  jfi6 <- showErrorsM $
            parseJSONPath . pack <$> specExternalVars jsonFormat
  jfi7 <- showErrors $
            parseJSONPath $ pack $ specExternalVarId jsonFormat
  jfi8 <- showErrorsM $
            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
    FieldSource
FileName   -> FieldSourceInternal -> Either String FieldSourceInternal
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return FieldSourceInternal
FSIFileName
    FieldSource
BaseName   -> FieldSourceInternal -> Either String FieldSourceInternal
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return FieldSourceInternal
FSIBaseName
    JSONPath String
p -> Either String FieldSourceInternal
-> Either String FieldSourceInternal
forall a b. Show a => Either a b -> Either String b
showErrors (Either String FieldSourceInternal
 -> Either String FieldSourceInternal)
-> Either String FieldSourceInternal
-> Either String FieldSourceInternal
forall a b. (a -> b) -> a -> b
$ ([JSONPathElement] -> FieldSourceInternal)
-> Either String [JSONPathElement]
-> Either String FieldSourceInternal
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [JSONPathElement] -> FieldSourceInternal
FSIJSONPath (Either String [JSONPathElement]
 -> Either String FieldSourceInternal)
-> Either String [JSONPathElement]
-> Either String FieldSourceInternal
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
p

  jfi11 <- showErrorsM $
             parseJSONPath . pack <$> specRequirementDesc jsonFormat
  jfi12 <- showErrors $
             parseJSONPath $ pack $ specRequirementExpr jsonFormat
  jfi13 <- showErrorsM $
             parseJSONPath . pack <$> specRequirementResultType jsonFormat
  jfi14 <- showErrorsM $
             parseJSONPath . pack <$> specRequirementResultExpr jsonFormat
  return $ JSONFormatInternal
             { jfiInternalVars          = jfi2
             , jfiInternalVarId         = jfi3
             , jfiInternalVarExpr       = jfi4
             , jfiInternalVarType       = jfi5
             , jfiExternalVars          = jfi6
             , jfiExternalVarId         = jfi7
             , jfiExternalVarType       = jfi8
             , jfiRequirements          = jfi9
             , jfiRequirementId         = jfi10
             , jfiRequirementDesc       = jfi11
             , jfiRequirementExpr       = jfi12
             , jfiRequirementResultType = jfi13
             , jfiRequirementResultExpr = jfi14
             }

parseJSONSpec :: (String -> IO (Either String a))
              -> JSONFormat
              -> FilePath
              -> Value
              -> IO (Either String (Spec a))
parseJSONSpec :: forall a.
(String -> IO (Either String a))
-> JSONFormat -> String -> Value -> IO (Either String (Spec a))
parseJSONSpec String -> IO (Either String a)
parseExpr JSONFormat
jsonFormat String
filepath 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 <- 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]
-> ([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
value = do
        let msg :: String
msg = String
"internal variable name"
        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
"internal variable type"
        varType <- maybe
                     (Right "")
                     (\[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)
                     )
                     (jfiInternalVarType jsonFormatInternal)

        let msg = String
"internal variable expr"
        varExpr <- valueToString msg =<<
                     listToEither
                       msg
                       ( executeJSONPath
                           (jfiInternalVarExpr jsonFormatInternal)
                           value
                       )

        return $ InternalVariableDef
                   { internalVariableName = varId
                   , internalVariableType = varType
                   , internalVariableExpr = varExpr
                   }

  internalVariableDefs <- except $ mapM internalVarDef values

  let 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
value = do

        let msg :: String
msg = String
"external variable name"
        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
"external variable type"
        varType <-
          maybe
            (Right "")
            (\[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)
            )
            (jfiExternalVarType jsonFormatInternal)

        return $ ExternalVariableDef
                   { externalVariableName = varId
                   , externalVariableType = varType
                   }

  externalVariableDefs <- except $ mapM externalVarDef values

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

      -- requirementDef :: Value -> Either String (Requirement a)
      requirementDef Value
value = do
        let msg :: String
msg = String
"Requirement name"

        -- Handle the case where the requirement ID is the file name, with or
        -- without extension.
        reqId <- case JSONFormatInternal -> FieldSourceInternal
jfiRequirementId JSONFormatInternal
jsonFormatInternal of
          FieldSourceInternal
FSIFileName   -> String -> ExceptT String IO String
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ExceptT String IO String)
-> String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
filepath
          FieldSourceInternal
FSIBaseName   -> String -> ExceptT String IO String
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ExceptT String IO String)
-> String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ ShowS
takeBaseName String
filepath
          FSIJSONPath [JSONPathElement]
p -> 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 [JSONPathElement]
p Value
value)

        let msg = String
"Requirement expression"
        reqExpr <- except $ valueToString msg =<<
                              listToEither
                                msg
                                ( executeJSONPath
                                    (jfiRequirementExpr jsonFormatInternal)
                                    value
                                )
        reqExpr' <- ExceptT $ parseExpr reqExpr

        let msg = String
"Requirement description"
        reqDesc <- except $ maybe
                     (Right "")
                     (\[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)
                     )
                     (jfiRequirementDesc jsonFormatInternal)

        let msg = String
"Requirement result type"
            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
        reqResType <- except $ maybeEither ty

        let msg = String
"Requirement result expression"
            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

        reqResExpr  <- except $ maybeEither resultExpr
        reqResExpr' <- ExceptT $ case 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

        return $ Requirement
                   { requirementName        = reqId
                   , requirementExpr        = reqExpr'
                   , requirementDescription = reqDesc
                   , requirementResultType  = reqResType
                   , requirementResultExpr  = reqResExpr'
                   }

  requirements <- mapM requirementDef values

  return $ Spec internalVariableDefs externalVariableDefs 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
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 -> ShowS
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 -> ShowS
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