{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Kubernetes.Data.K8sJSONPath where

import Control.Applicative  ((<|>))
import Data.Aeson
import Data.Aeson.Text
import Data.Bifunctor
import Data.JSONPath
import Data.Text       as Text
import Data.Text.Lazy       (toStrict)

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif

#if MIN_VERSION_jsonpath(0,3,0)
import Data.Void (Void)
import Text.Megaparsec ( Parsec, eof, runParser, some, takeWhile1P )
import Text.Megaparsec.Char ( char )
type Parser a = Parsec Void Text a
#else
import Data.Attoparsec.Text ( Parser, char, endOfInput, many1, parseOnly, takeWhile1 )
#endif


data K8sPathElement = PlainText Text
                    | JSONPath [JSONPathElement]
  deriving  (Int -> K8sPathElement -> ShowS
[K8sPathElement] -> ShowS
K8sPathElement -> String
(Int -> K8sPathElement -> ShowS)
-> (K8sPathElement -> String)
-> ([K8sPathElement] -> ShowS)
-> Show K8sPathElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> K8sPathElement -> ShowS
showsPrec :: Int -> K8sPathElement -> ShowS
$cshow :: K8sPathElement -> String
show :: K8sPathElement -> String
$cshowList :: [K8sPathElement] -> ShowS
showList :: [K8sPathElement] -> ShowS
Show, K8sPathElement -> K8sPathElement -> Bool
(K8sPathElement -> K8sPathElement -> Bool)
-> (K8sPathElement -> K8sPathElement -> Bool) -> Eq K8sPathElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: K8sPathElement -> K8sPathElement -> Bool
== :: K8sPathElement -> K8sPathElement -> Bool
$c/= :: K8sPathElement -> K8sPathElement -> Bool
/= :: K8sPathElement -> K8sPathElement -> Bool
Eq)

parseK8sJSONPath :: Text -> Either String [K8sPathElement]
#if MIN_VERSION_jsonpath(0,3,0)
parseK8sJSONPath :: Text -> Either String [K8sPathElement]
parseK8sJSONPath = (ParseErrorBundle Text Void -> String)
-> Either (ParseErrorBundle Text Void) [K8sPathElement]
-> Either String [K8sPathElement]
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 a. Show a => a -> String
show (Either (ParseErrorBundle Text Void) [K8sPathElement]
 -> Either String [K8sPathElement])
-> (Text -> Either (ParseErrorBundle Text Void) [K8sPathElement])
-> Text
-> Either String [K8sPathElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text [K8sPathElement]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [K8sPathElement]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec Void Text [K8sPathElement]
k8sJSONPath Parsec Void Text [K8sPathElement]
-> ParsecT Void Text Identity ()
-> Parsec Void Text [K8sPathElement]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"nothing"
#else
parseK8sJSONPath = parseOnly (k8sJSONPath <* endOfInput)
#endif

k8sJSONPath :: Parser [K8sPathElement]
#if MIN_VERSION_jsonpath(0,3,0)
k8sJSONPath :: Parsec Void Text [K8sPathElement]
k8sJSONPath = ParsecT Void Text Identity K8sPathElement
-> Parsec Void Text [K8sPathElement]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity K8sPathElement
pathElementParser
#else
k8sJSONPath = many1 pathElementParser
#endif

pathElementParser :: Parser K8sPathElement
pathElementParser :: ParsecT Void Text Identity K8sPathElement
pathElementParser = ParsecT Void Text Identity K8sPathElement
jsonpathParser ParsecT Void Text Identity K8sPathElement
-> ParsecT Void Text Identity K8sPathElement
-> ParsecT Void Text Identity K8sPathElement
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity K8sPathElement
plainTextParser

plainTextParser :: Parser K8sPathElement
#if MIN_VERSION_jsonpath(0,3,0)
plainTextParser :: ParsecT Void Text Identity K8sPathElement
plainTextParser = Text -> K8sPathElement
PlainText (Text -> K8sPathElement)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity K8sPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"non_open_brace") (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'{')
#else
plainTextParser = PlainText <$> takeWhile1 (/= '{')
#endif

jsonpathParser :: Parser K8sPathElement
#if MIN_VERSION_jsonpath(0,3,0)
jsonpathParser :: ParsecT Void Text Identity K8sPathElement
jsonpathParser = [JSONPathElement] -> K8sPathElement
JSONPath ([JSONPathElement] -> K8sPathElement)
-> ParsecT Void Text Identity [JSONPathElement]
-> ParsecT Void Text Identity K8sPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [JSONPathElement]
-> ParsecT Void Text Identity [JSONPathElement]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [JSONPathElement]
forall a. Parser a -> ParsecT Void Text Identity [JSONPathElement]
jsonPath (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}') ParsecT Void Text Identity [JSONPathElement]
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [JSONPathElement]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}')
#else
jsonpathParser = JSONPath <$> (char '{' *> jsonPath <* char '}')
#endif

runJSONPath :: [K8sPathElement] -> Value -> Either String Text
runJSONPath :: [K8sPathElement] -> Value -> Either String Text
runJSONPath [] Value
_ = Text -> Either String Text
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
runJSONPath (K8sPathElement
e:[K8sPathElement]
es) Value
v = do
  Text
res <- K8sPathElement -> Value -> Either String Text
runPathElement K8sPathElement
e Value
v
  Text
rest <- [K8sPathElement] -> Value -> Either String Text
runJSONPath [K8sPathElement]
es Value
v
  Text -> Either String Text
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ Text
res Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest

runPathElement :: K8sPathElement -> Value -> Either String Text
runPathElement :: K8sPathElement -> Value -> Either String Text
runPathElement (PlainText Text
t) Value
_ = Text -> Either String Text
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
runPathElement (JSONPath [JSONPathElement]
p) Value
v  = [Value] -> Either String Text
encodeResult ([Value] -> Either String Text) -> [Value] -> Either String Text
forall a b. (a -> b) -> a -> b
$ [JSONPathElement] -> Value -> [Value]
executeJSONPath [JSONPathElement]
p Value
v

#if MIN_VERSION_jsonpath(0,3,0)
encodeResult :: [Value] -> Either String Text
encodeResult :: [Value] -> Either String Text
encodeResult  [Value]
vals = Text -> Either String Text
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ (Text -> [Text] -> Text
intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Value -> Text
jsonToText [Value]
vals)
#else
encodeResult :: ExecutionResult Value -> Either String Text
encodeResult (ResultValue val) = return $ jsonToText val
encodeResult (ResultList vals) = return $ (intercalate " " $ Prelude.map jsonToText vals)
encodeResult (ResultError err) = Left err
#endif

jsonToText :: Value -> Text
jsonToText :: Value -> Text
jsonToText (String Text
t) = Text
t
jsonToText Value
x          = Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText Value
x