Version with megaparsec and attoparsec

This commit is contained in:
Tom McLaughlin
2023-06-26 00:23:43 -07:00
parent 0911424e9a
commit c0e41edccc
5 changed files with 47 additions and 6 deletions

View File

@@ -63,6 +63,7 @@ library
, jose-jwt >=0.8 , jose-jwt >=0.8
, jsonpath >=0.1 && <0.4 , jsonpath >=0.1 && <0.4
, kubernetes-client-core ==0.4.3.0 , kubernetes-client-core ==0.4.3.0
, megaparsec ==9.*
, microlens >=0.4 , microlens >=0.4
, mtl >=2.2 , mtl >=2.2
, oidc-client >=0.4 , oidc-client >=0.4
@@ -110,6 +111,7 @@ test-suite example
, jsonpath >=0.1 && <0.4 , jsonpath >=0.1 && <0.4
, kubernetes-client , kubernetes-client
, kubernetes-client-core ==0.4.3.0 , kubernetes-client-core ==0.4.3.0
, megaparsec ==9.*
, microlens >=0.4 , microlens >=0.4
, mtl >=2.2 , mtl >=2.2
, oidc-client >=0.4 , oidc-client >=0.4
@@ -159,12 +161,14 @@ test-suite spec
, hoauth2 >=1.11 && <=3 , hoauth2 >=1.11 && <=3
, hspec , hspec
, hspec-attoparsec , hspec-attoparsec
, hspec-megaparsec
, http-client >=0.5 && <0.8 , http-client >=0.5 && <0.8
, http-client-tls >=0.3 , http-client-tls >=0.3
, jose-jwt >=0.8 , jose-jwt >=0.8
, jsonpath >=0.1 && <0.4 , jsonpath >=0.1 && <0.4
, kubernetes-client , kubernetes-client
, kubernetes-client-core ==0.4.3.0 , kubernetes-client-core ==0.4.3.0
, megaparsec ==9.*
, microlens >=0.4 , microlens >=0.4
, mtl >=2.2 , mtl >=2.2
, oidc-client >=0.4 , oidc-client >=0.4

View File

@@ -25,6 +25,7 @@ tests:
- kubernetes-client - kubernetes-client
- hspec - hspec
- hspec-attoparsec - hspec-attoparsec
- hspec-megaparsec
- yaml - yaml
- file-embed - file-embed
example: example:
@@ -52,6 +53,7 @@ dependencies:
- http-client-tls >=0.3 - http-client-tls >=0.3
- jose-jwt >=0.8 - jose-jwt >=0.8
- kubernetes-client-core ==0.4.3.0 - kubernetes-client-core ==0.4.3.0
- megaparsec >=9 && <10
- microlens >=0.4 - microlens >=0.4
- mtl >=2.2 - mtl >=2.2
- oidc-client >=0.4 - oidc-client >=0.4

View File

@@ -6,7 +6,6 @@ where
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Exception.Safe (Exception, throwM) import Control.Exception.Safe (Exception, throwM)
import Data.Attoparsec.Text
import Data.Either.Combinators import Data.Either.Combinators
import Data.Function ((&)) import Data.Function ((&))
import Data.JSONPath import Data.JSONPath
@@ -126,7 +125,6 @@ parseGCPAuthInfo authInfo = do
Just expiryText -> Just <$> parseExpiryTime expiryText Just expiryText -> Just <$> parseExpiryTime expiryText
lookupEither key = Map.lookup key authInfo lookupEither key = Map.lookup key authInfo
& maybeToRight (GCPAuthMissingInformation $ Text.unpack key) & maybeToRight (GCPAuthMissingInformation $ Text.unpack key)
parseK8sJSONPath = parseOnly (k8sJSONPath <* endOfInput)
readJSONPath key defaultPath = readJSONPath key defaultPath =
maybe (Right defaultPath) parseK8sJSONPath $ Map.lookup key authInfo maybe (Right defaultPath) parseK8sJSONPath $ Map.lookup key authInfo

View File

@@ -5,29 +5,53 @@ module Kubernetes.Data.K8sJSONPath where
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Data.Aeson import Data.Aeson
import Data.Aeson.Text import Data.Aeson.Text
import Data.Attoparsec.Text ( many1, char, takeWhile1, Parser ) import Data.Bifunctor
import Data.JSONPath import Data.JSONPath
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Text as Text import Data.Text as Text
import Data.Text.Lazy (toStrict) import Data.Text.Lazy (toStrict)
#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 ( many1, char, takeWhile1, Parser )
#endif
data K8sPathElement = PlainText Text data K8sPathElement = PlainText Text
| JSONPath [JSONPathElement] | JSONPath [JSONPathElement]
deriving (Show, Eq) deriving (Show, Eq)
parseK8sJSONPath :: Text -> Either String [K8sPathElement]
#if MIN_VERSION_jsonpath(0,3,0)
parseK8sJSONPath = first show . runParser (k8sJSONPath <* eof) "nothing"
#else
parseK8sJSONPath = parseOnly (k8sJSONPath <* endOfInput)
#endif
k8sJSONPath :: Parser [K8sPathElement] k8sJSONPath :: Parser [K8sPathElement]
#if MIN_VERSION_jsonpath(0,3,0)
k8sJSONPath = some pathElementParser
#else
k8sJSONPath = many1 pathElementParser k8sJSONPath = many1 pathElementParser
#endif
pathElementParser :: Parser K8sPathElement pathElementParser :: Parser K8sPathElement
pathElementParser = jsonpathParser <|> plainTextParser pathElementParser = jsonpathParser <|> plainTextParser
plainTextParser :: Parser K8sPathElement plainTextParser :: Parser K8sPathElement
#if MIN_VERSION_jsonpath(0,3,0)
plainTextParser = PlainText <$> takeWhile1P (Just "non_open_brace") (/= '{')
#else
plainTextParser = PlainText <$> takeWhile1 (/= '{') plainTextParser = PlainText <$> takeWhile1 (/= '{')
#endif
jsonpathParser :: Parser K8sPathElement jsonpathParser :: Parser K8sPathElement
#if MIN_VERSION_jsonpath(0,3,0) #if MIN_VERSION_jsonpath(0,3,0)
jsonpathParser = JSONPath <$> (char '{' *> jsonPath undefined <* char '}') jsonpathParser = JSONPath <$> (char '{' *> jsonPath (char '}') <* char '}')
#else #else
jsonpathParser = JSONPath <$> (char '{' *> jsonPath <* char '}') jsonpathParser = JSONPath <$> (char '{' *> jsonPath <* char '}')
#endif #endif

View File

@@ -1,14 +1,28 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Kubernetes.Data.K8sJSONPathSpec where module Kubernetes.Data.K8sJSONPathSpec where
import Test.Hspec import Test.Hspec
import Test.Hspec.Attoparsec
import Kubernetes.Data.K8sJSONPath import Kubernetes.Data.K8sJSONPath
import Data.Text import Data.Text
import Data.JSONPath import Data.JSONPath
import Data.Aeson import Data.Aeson
#if MIN_VERSION_jsonpath(0,3,0)
import Data.Void (Void)
import Test.Hspec.Megaparsec
import Text.Megaparsec (runParser)
import Text.Megaparsec.Error (ParseErrorBundle)
(~>) :: Text -> Parser [K8sPathElement] -> Either (ParseErrorBundle Text Void) [K8sPathElement]
(~>) text parser = runParser parser "nothing" text
#else
import Test.Hspec.Attoparsec
#endif
spec :: Spec spec :: Spec
spec = do spec = do
describe "K8sJSONPath" $ do describe "K8sJSONPath" $ do
@@ -30,4 +44,3 @@ spec = do
let path = [PlainText "kind is ", JSONPath [KeyChild "kind"]] let path = [PlainText "kind is ", JSONPath [KeyChild "kind"]]
val = (object ["kind" .= ("Pod" :: Text)]) val = (object ["kind" .= ("Pod" :: Text)])
runJSONPath path val `shouldBe` Right "kind is Pod" runJSONPath path val `shouldBe` Right "kind is Pod"