rds-data 0.0.0.8 → 0.0.0.9
raw patch · 6 files changed
+138/−82 lines, 6 filesdep ~hw-polysemy
Dependency ranges changed: hw-polysemy
Files
- rds-data.cabal +6/−5
- src/Data/RdsData/Decode/Row.hs +33/−23
- src/Data/RdsData/Decode/Value.hs +53/−32
- src/Data/RdsData/Default.hs +1/−1
- src/Data/RdsData/Encode/Param.hs +14/−0
- src/Data/RdsData/Encode/Params.hs +31/−21
rds-data.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.6 name: rds-data-version: 0.0.0.8+version: 0.0.0.9 synopsis: Codecs for use with AWS rds-data description: Codecs for use with AWS rds-data. category: Data@@ -39,10 +39,10 @@ common hedgehog { build-depends: hedgehog >= 1.4 && < 2 } common hedgehog-extras { build-depends: hedgehog-extras >= 0.6.0.2 && < 0.7 } common http-client { build-depends: http-client >= 0.5.14 && < 0.8 }-common hw-polysemy-amazonka { build-depends: hw-polysemy:amazonka >= 0.2.14.6 && < 0.3 }-common hw-polysemy-core { build-depends: hw-polysemy:core >= 0.2.14.6 && < 0.3 }-common hw-polysemy-hedgehog { build-depends: hw-polysemy:hedgehog >= 0.2.14.6 && < 0.3 }-common hw-polysemy-testcontainers-localstack { build-depends: hw-polysemy:testcontainers-localstack >= 0.2.14.6 && < 0.3 }+common hw-polysemy-amazonka { build-depends: hw-polysemy:amazonka >= 0.2.14.7 && < 0.3 }+common hw-polysemy-core { build-depends: hw-polysemy:core >= 0.2.14.7 && < 0.3 }+common hw-polysemy-hedgehog { build-depends: hw-polysemy:hedgehog >= 0.2.14.7 && < 0.3 }+common hw-polysemy-testcontainers-localstack { build-depends: hw-polysemy:testcontainers-localstack >= 0.2.14.7 && < 0.3 } common microlens { build-depends: microlens >= 0.4.13 && < 0.5 } common mtl { build-depends: mtl >= 2 && < 3 } common optparse-applicative { build-depends: optparse-applicative >= 0.18.1.0 && < 0.19 }@@ -87,6 +87,7 @@ , amazonka-rds , amazonka-rds-data , amazonka-secretsmanager+ , base64-bytestring , bytestring , contravariant , generic-lens
src/Data/RdsData/Decode/Row.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-} module Data.RdsData.Decode.Row ( DecodeRow(..)@@ -23,6 +23,8 @@ , word64 , bytestring , lazyBytestring+ , base64Text+ , lazyBase64Text , timeOfDay , day , ulid@@ -36,20 +38,20 @@ , decodeRows ) where -import Control.Monad.Except-import Control.Monad.State-import Data.ByteString (ByteString)-import Control.Monad-import Data.Functor.Identity ( Identity )-import Data.Int-import Data.RdsData.Decode.Value (DecodeValue)-import Data.RdsData.Types.Value-import Data.Text-import Data.Time-import Data.ULID (ULID)-import Data.UUID (UUID)-import Data.Word-import Prelude hiding (maybe)+import Control.Monad+import Control.Monad.Except+import Control.Monad.State+import Data.ByteString (ByteString)+import Data.Functor.Identity (Identity)+import Data.Int+import Data.RdsData.Decode.Value (DecodeValue)+import Data.RdsData.Types.Value+import Data.Text+import Data.Time+import Data.ULID (ULID)+import Data.UUID (UUID)+import Data.Word+import Prelude hiding (maybe) import qualified Data.Aeson as J import qualified Data.ByteString.Lazy as LBS@@ -84,7 +86,7 @@ decodeRowValue decoder v = case DV.decodeValue decoder v of Right a -> pure a- Left e -> throwError $ "Failed to decode Value: " <> e+ Left e -> throwError $ "Failed to decode Value: " <> e column :: () => DecodeValue a@@ -167,6 +169,14 @@ lazyBytestring = column DV.lazyBytestring +base64Text :: DecodeRow ByteString+base64Text =+ column DV.base64Text++lazyBase64Text :: DecodeRow LBS.ByteString+lazyBase64Text =+ column DV.lazyBase64Text+ string :: DecodeRow String string = column DV.string@@ -179,35 +189,35 @@ timeOfDay = do t <- text case parseTimeM True defaultTimeLocale "%H:%M:%S%Q" (T.unpack t) of- Just a -> pure a+ Just a -> pure a Nothing -> throwError $ "Failed to parse TimeOfDay: " <> T.pack (show t) ulid :: DecodeRow ULID ulid = do t <- text case CONV.textToUlid t of- Right a -> pure a+ Right a -> pure a Left msg -> throwError $ "Failed to parse ULID: " <> msg utcTime :: DecodeRow UTCTime utcTime = do t <- text case parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack t) of- Just a -> pure a+ Just a -> pure a Nothing -> throwError $ "Failed to parse UTCTime: " <> T.pack (show t) uuid :: DecodeRow UUID uuid = do t <- text case UUID.fromString (T.unpack t) of- Just a -> pure a+ Just a -> pure a Nothing -> throwError $ "Failed to parse UUID: " <> T.pack (show t) day :: DecodeRow Day day = do t <- text case parseTimeM True defaultTimeLocale "%Y-%m-%d" (T.unpack t) of- Just a -> pure a+ Just a -> pure a Nothing -> throwError $ "Failed to parse Day: " <> T.pack (show t) ignore :: DecodeRow ()
src/Data/RdsData/Decode/Value.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} {- HLINT ignore "Use <&>" -}@@ -32,6 +32,8 @@ , bytestring , lazyText , lazyBytestring+ , base64Text+ , lazyBase64Text , string , json , timeOfDay@@ -41,28 +43,31 @@ ) where -import Amazonka.Data.Base64-import Control.Applicative-import Data.ByteString (ByteString)-import Data.Int-import Data.RdsData.Decode.Array (DecodeArray(..))-import Data.RdsData.Internal.Aeson-import Data.RdsData.Types.Value-import Data.Text (Text)-import Data.Time-import Data.UUID (UUID)-import Data.Word-import Prelude hiding (maybe, null)+import Amazonka.Data.Base64+import Control.Applicative+import Data.ByteString (ByteString)+import Data.Int+import Data.RdsData.Decode.Array (DecodeArray (..))+import Data.RdsData.Internal.Aeson+import Data.RdsData.Types.Value+import Data.Text (Text)+import Data.Time+import Data.UUID (UUID)+import Data.Word+import Prelude hiding (maybe, null) -import qualified Amazonka.Data.ByteString as AWS-import qualified Data.Aeson as J-import qualified Data.ByteString.Lazy as LBS-import qualified Data.RdsData.Internal.Convert as CONV-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as LT-import qualified Data.UUID as UUID-import qualified Prelude as P+import qualified Amazonka.Data.ByteString as AWS+import qualified Data.Aeson as J+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Base64.Lazy as LB64+import qualified Data.ByteString.Lazy as LBS+import qualified Data.RdsData.Internal.Convert as CONV+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT+import qualified Data.UUID as UUID+import qualified Prelude as P newtype DecodeValue a = DecodeValue { decodeValue :: Value -> Either Text a@@ -106,7 +111,7 @@ DecodeValue \v -> case v of ValueOfNull -> Right Nothing- _ -> Just <$> f v + _ -> Just <$> f v -------------------------------------------------------------------------------- @@ -129,7 +134,7 @@ DecodeValue \v -> case v of ValueOfBool b -> Right b- _ -> Left $ decodeValueFailedMessage "bool" "Bool" Nothing v+ _ -> Left $ decodeValueFailedMessage "bool" "Bool" Nothing v double :: DecodeValue Double double =@@ -147,7 +152,7 @@ DecodeValue \v -> case v of ValueOfText s -> Right s- _ -> Left $ decodeValueFailedMessage "text" "Text" Nothing v+ _ -> Left $ decodeValueFailedMessage "text" "Text" Nothing v integer :: DecodeValue Integer integer =@@ -161,7 +166,7 @@ DecodeValue \v -> case v of ValueOfNull -> Right ()- _ -> Left $ decodeValueFailedMessage "null" "()" Nothing v+ _ -> Left $ decodeValueFailedMessage "null" "()" Nothing v -------------------------------------------------------------------------------- @@ -243,6 +248,22 @@ lazyText = LT.fromStrict <$> text +base64Text :: DecodeValue ByteString+base64Text = do+ t <- text+ let b64 = T.encodeUtf8 t+ case B64.decode b64 of+ Right a -> pure a+ Left e -> decodeValueFailed "base64-text" "Text" (Just (T.pack e))++lazyBase64Text :: DecodeValue LBS.ByteString+lazyBase64Text = do+ t <- lazyText+ let b64 = LT.encodeUtf8 t+ case LB64.decode b64 of+ Right a -> pure a+ Left e -> decodeValueFailed "base64-text" "Text" (Just (T.pack e))+ lazyBytestring :: DecodeValue LBS.ByteString lazyBytestring = LBS.fromStrict <$> bytestring@@ -256,7 +277,7 @@ t <- text case J.eitherDecode (LBS.fromStrict (T.encodeUtf8 t)) of Right v -> pure v- Left e -> decodeValueFailed "json" "Value" (Just (T.pack e))+ Left e -> decodeValueFailed "json" "Value" (Just (T.pack e)) timeOfDay :: DecodeValue TimeOfDay timeOfDay = do@@ -269,19 +290,19 @@ utcTime = do t <- text case parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack t) of- Just a -> pure a+ Just a -> pure a Nothing -> decodeValueFailed "utcTime" "UTCTime" Nothing uuid :: DecodeValue UUID uuid = do t <- text case UUID.fromString (T.unpack t) of- Just a -> pure a+ Just a -> pure a Nothing -> decodeValueFailed "uuid" "UUID" Nothing day :: DecodeValue Day day = do t <- text case parseTimeM True defaultTimeLocale "%Y-%m-%d" (T.unpack t) of- Just a -> pure a+ Just a -> pure a Nothing -> decodeValueFailed "day" "Day" Nothing
src/Data/RdsData/Default.hs view
@@ -7,4 +7,4 @@ import Data.Text projectDefaultLocalStack :: Text-projectDefaultLocalStack = "localstack/localstack-pro:3.7.2"+projectDefaultLocalStack = "localstack/localstack-pro:latest"
src/Data/RdsData/Encode/Param.hs view
@@ -31,6 +31,8 @@ , int8 , json , lazyBytestring+ , base64Text+ , lazyBase64Text , lazyText , timeOfDay , ulid@@ -62,9 +64,13 @@ import qualified Amazonka.Data.Base64 as AWS import qualified Amazonka.RDSData as AWS import qualified Data.Aeson as J+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Base64.Lazy as LB64 import qualified Data.ByteString.Lazy as LBS import qualified Data.RdsData.Internal.Convert as CONV+import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT import qualified Prelude as P newtype EncodeParam a = EncodeParam@@ -178,6 +184,14 @@ lazyBytestring :: EncodeParam LBS.ByteString lazyBytestring = LBS.toStrict >$< bytestring++base64Text :: EncodeParam ByteString+base64Text =+ (T.decodeUtf8 . B64.encode) >$< text++lazyBase64Text :: EncodeParam LBS.ByteString+lazyBase64Text =+ (LT.decodeUtf8 . LB64.encode) >$< lazyText timeOfDay :: EncodeParam TimeOfDay timeOfDay =
src/Data/RdsData/Encode/Params.hs view
@@ -26,6 +26,8 @@ , int64 , json , lazyBytestring+ , base64Text+ , lazyBase64Text , lazyText , timeOfDay , ulid@@ -38,27 +40,27 @@ , word64 ) where -import Data.ByteString (ByteString)-import Data.Functor.Contravariant-import Data.Functor.Contravariant.Divisible-import Data.Int-import Data.RdsData.Encode.Array (EncodeArray(..))-import Data.RdsData.Encode.Param (EncodeParam(..))-import Data.RdsData.Types.Param-import Data.Text (Text)-import Data.Time-import Data.UUID (UUID)-import Data.ULID (ULID)-import Data.Void-import Data.Word-import Prelude hiding (maybe, null)+import Data.ByteString (ByteString)+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Divisible+import Data.Int+import Data.RdsData.Encode.Array (EncodeArray (..))+import Data.RdsData.Encode.Param (EncodeParam (..))+import Data.RdsData.Types.Param+import Data.Text (Text)+import Data.Time+import Data.ULID (ULID)+import Data.UUID (UUID)+import Data.Void+import Data.Word+import Prelude hiding (maybe, null) -import qualified Amazonka.Data.Base64 as AWS-import qualified Data.Aeson as J-import qualified Data.ByteString.Lazy as LBS-import qualified Data.RdsData.Encode.Param as EP-import qualified Data.Text.Lazy as LT-import qualified Prelude as P+import qualified Amazonka.Data.Base64 as AWS+import qualified Data.Aeson as J+import qualified Data.ByteString.Lazy as LBS+import qualified Data.RdsData.Encode.Param as EP+import qualified Data.Text.Lazy as LT+import qualified Prelude as P newtype EncodeParams a = EncodeParams { encodeParams :: a -> [Param] -> [Param]@@ -80,7 +82,7 @@ choose f (EncodeParams g) (EncodeParams h) = EncodeParams \a -> case f a of- Left b -> g b+ Left b -> g b Right c -> h c lose f = EncodeParams $ absurd . f@@ -186,6 +188,14 @@ lazyBytestring :: EncodeParams LBS.ByteString lazyBytestring = column EP.lazyBytestring++base64Text :: EncodeParams ByteString+base64Text =+ column EP.base64Text++lazyBase64Text :: EncodeParams LBS.ByteString+lazyBase64Text =+ column EP.lazyBase64Text timeOfDay :: EncodeParams TimeOfDay timeOfDay =