rds-data 0.1.0.0 → 0.1.1.0
raw patch · 8 files changed
+101/−77 lines, 8 filesdep ~hw-polysemydep ~hw-prelude
Dependency ranges changed: hw-polysemy, hw-prelude
Files
- rds-data.cabal +20/−6
- src/Data/RdsData/Decode/Array.hs +21/−21
- src/Data/RdsData/Decode/Row.hs +2/−2
- src/Data/RdsData/Decode/Value.hs +2/−2
- src/Data/RdsData/Encode/Param.hs +2/−2
- src/Data/RdsData/Encode/Params.hs +8/−3
- src/Data/RdsData/Encode/Row.hs +26/−21
- src/Data/RdsData/Encode/Value.hs +20/−20
rds-data.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.6 name: rds-data-version: 0.1.0.0+version: 0.1.1.0 synopsis: Codecs for use with AWS rds-data description: Codecs for use with AWS rds-data. category: Data@@ -39,11 +39,11 @@ 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.3 && < 0.4 }-common hw-polysemy-core { build-depends: hw-polysemy:core >= 0.3 && < 0.4 }-common hw-polysemy-hedgehog { build-depends: hw-polysemy:hedgehog >= 0.3 && < 0.4 }-common hw-polysemy-testcontainers-localstack { build-depends: hw-polysemy:testcontainers-localstack >= 0.3 && < 0.4 }-common hw-prelude { build-depends: hw-prelude >= 0.0.0.1 && < 0.1 }+common hw-polysemy-amazonka { build-depends: hw-polysemy:amazonka >= 0.3.1 && < 0.4 }+common hw-polysemy-core { build-depends: hw-polysemy:core >= 0.3.1 && < 0.4 }+common hw-polysemy-hedgehog { build-depends: hw-polysemy:hedgehog >= 0.3.1 && < 0.4 }+common hw-polysemy-testcontainers-localstack { build-depends: hw-polysemy:testcontainers-localstack >= 0.3.1 && < 0.4 }+common hw-prelude { build-depends: hw-prelude >= 0.0.1.0 && < 0.1 } 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 }@@ -70,7 +70,21 @@ common project-config default-language: Haskell2010 default-extensions: BlockArguments+ DataKinds+ DeriveGeneric+ DuplicateRecordFields+ FlexibleContexts+ FlexibleInstances ImportQualifiedPost+ LambdaCase+ NoFieldSelectors+ OverloadedRecordDot+ OverloadedStrings+ RankNTypes+ ScopedTypeVariables+ TypeApplications+ TypeOperators+ TypeSynonymInstances ghc-options: -Wall -Wcompat
src/Data/RdsData/Decode/Array.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE LambdaCase #-} {- HLINT ignore "Use <&>" -} @@ -37,16 +37,16 @@ , words ) where -import Control.Applicative-import Data.Int-import Data.RdsData.Internal.Aeson-import Data.RdsData.Types.Array-import Data.Text (Text)-import Data.Time-import Data.ULID (ULID)-import Data.UUID (UUID)-import Data.Word-import Prelude hiding (maybe, null, words)+import Control.Applicative+import Data.Int+import Data.RdsData.Internal.Aeson+import Data.RdsData.Types.Array+import Data.Text (Text)+import Data.Time+import Data.ULID (ULID)+import Data.UUID (UUID)+import Data.Word+import Prelude hiding (maybe, null, words) import qualified Data.Aeson as J import qualified Data.RdsData.Internal.Convert as CONV@@ -72,7 +72,7 @@ instance Monad DecodeArray where DecodeArray a >>= f = DecodeArray \v -> do a' <- a v- decodeArray (f a') v+ (.decodeArray) (f a') v -------------------------------------------------------------------------------- @@ -175,27 +175,27 @@ ts <- texts case traverse (J.eitherDecodeStrict' . T.encodeUtf8) ts of Right js -> pure js- Left e -> DecodeArray \_ -> Left $ "Failed to decode JSON: " <> T.pack e+ Left e -> DecodeArray \_ -> Left $ "Failed to decode JSON: " <> T.pack e timesOfDay :: DecodeArray [TimeOfDay] timesOfDay = do ts <- texts case traverse (parseTimeM True defaultTimeLocale "%H:%M:%S". T.unpack) ts of Just tod -> pure tod- Nothing -> DecodeArray \_ -> Left "Failed to decode TimeOfDay"+ Nothing -> DecodeArray \_ -> Left "Failed to decode TimeOfDay" utcTimes :: DecodeArray [UTCTime] utcTimes = do ts <- texts case traverse (parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S" . T.unpack) ts of Just utct -> pure utct- Nothing -> DecodeArray \_ -> Left "Failed to decode UTCTime"+ Nothing -> DecodeArray \_ -> Left "Failed to decode UTCTime" days :: DecodeArray [Day] days = do ts <- texts case traverse (parseTimeM True defaultTimeLocale "%Y-%m-%d" . T.unpack) ts of- Just d -> pure d+ Just d -> pure d Nothing -> DecodeArray \_ -> Left "Failed to decode Day" -- | Decode an array of ULIDs@@ -205,12 +205,12 @@ ulids = do ts <- texts case traverse CONV.textToUlid ts of- Right u -> pure u+ Right u -> pure u Left msg -> DecodeArray \_ -> Left $ "Failed to decode UUID: " <> msg uuids :: DecodeArray [UUID] uuids = do ts <- texts case traverse (UUID.fromString . T.unpack) ts of- Just u -> pure u+ Just u -> pure u Nothing -> DecodeArray \_ -> Left "Failed to decode UUID"
src/Data/RdsData/Decode/Row.hs view
@@ -84,7 +84,7 @@ -> Value -> m a decodeRowValue decoder v =- case DV.decodeValue decoder v of+ case decoder.decodeValue v of Right a -> pure a Left e -> throwError $ "Failed to decode Value: " <> e @@ -225,7 +225,7 @@ void $ column DV.rdsValue decodeRow :: DecodeRow a -> [Value] -> Either Text a-decodeRow r = evalState (runExceptT (unDecodeRow r))+decodeRow r = evalState (runExceptT r.unDecodeRow) decodeRows :: DecodeRow a -> [[Value]] -> Either Text [a] decodeRows r = traverse (decodeRow r)
src/Data/RdsData/Decode/Value.hs view
@@ -87,7 +87,7 @@ instance Monad DecodeValue where DecodeValue a >>= f = DecodeValue \v -> do a' <- a v- decodeValue (f a') v+ (.decodeValue) (f a') v fail :: Text -> DecodeValue a fail =@@ -125,7 +125,7 @@ array decoder = DecodeValue \v -> case v of- ValueOfArray a -> decodeArray decoder a+ ValueOfArray a -> decoder.decodeArray a _ -> Left $ decodeValueFailedMessage "array" "Array" Nothing v base64 :: DecodeValue Base64
src/Data/RdsData/Encode/Param.hs view
@@ -99,13 +99,13 @@ maybe :: EncodeParam a -> EncodeParam (Maybe a) maybe =- EncodeParam . P.maybe (Param Nothing Nothing ValueOfNull) . encodeParam+ EncodeParam . P.maybe (Param Nothing Nothing ValueOfNull) . (.encodeParam) -------------------------------------------------------------------------------- array :: EncodeArray a -> EncodeParam a array enc =- Param Nothing Nothing . ValueOfArray . encodeArray enc >$< rdsParam+ Param Nothing Nothing . ValueOfArray . enc.encodeArray >$< rdsParam base64 :: EncodeParam AWS.Base64 base64 =
src/Data/RdsData/Encode/Params.hs view
@@ -3,6 +3,7 @@ module Data.RdsData.Encode.Params ( EncodeParams(..) , EncodedParams(..)+ , encodeParams , encode , rdsValue@@ -66,7 +67,7 @@ import qualified Prelude as P newtype EncodedParams = EncodedParams- { unEncodedParams :: [Param] -> [Param]+ { run :: [Param] -> [Param] } instance Semigroup EncodedParams where@@ -78,9 +79,13 @@ EncodedParams id newtype EncodeParams a = EncodeParams- { encodeParams :: a -> [Param] -> [Param]+ { run :: a -> [Param] -> [Param] } +encodeParams :: EncodeParams a -> a -> [Param] -> [Param]+encodeParams =+ (.run)+ encode :: EncodeParams a -> a -> EncodedParams encode (EncodeParams f) a = EncodedParams (f a)@@ -121,7 +126,7 @@ named :: Text -> EncodeParam a -> EncodeParams a named n ep = EncodeParams \a ->- (EP.encodeParam (EP.named n ep) a:)+ ((.encodeParam) (EP.named n ep) a:) --------------------------------------------------------------------------------
src/Data/RdsData/Encode/Row.hs view
@@ -3,6 +3,7 @@ module Data.RdsData.Encode.Row ( EncodeRow(..) + , encodeRow , rdsValue , column@@ -38,27 +39,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.Value (EncodeValue(..))-import Data.RdsData.Types.Value-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 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.Value (EncodeValue (..))+import Data.RdsData.Types.Value+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.Value as EV-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.Value as EV+import qualified Data.Text.Lazy as LT+import qualified Prelude as P newtype EncodeRow a = EncodeRow { encodeRow :: a -> [Value] -> [Value]@@ -80,10 +81,14 @@ choose f (EncodeRow g) (EncodeRow h) = EncodeRow \a -> case f a of- Left b -> g b+ Left b -> g b Right c -> h c lose f = EncodeRow $ absurd . f++encodeRow :: EncodeRow a -> a -> [Value] -> [Value]+encodeRow =+ (.encodeRow) --------------------------------------------------------------------------------
src/Data/RdsData/Encode/Value.hs view
@@ -36,25 +36,25 @@ , word64 ) where -import Data.ByteString (ByteString)-import Data.Functor.Contravariant-import Data.Int-import Data.RdsData.Encode.Array-import Data.RdsData.Types.Value-import Data.Text (Text)-import Data.Time-import Data.ULID (ULID)-import Data.UUID (UUID)-import Data.Word-import Prelude hiding (maybe, null)+import Data.ByteString (ByteString)+import Data.Functor.Contravariant+import Data.Int+import Data.RdsData.Encode.Array+import Data.RdsData.Types.Value+import Data.Text (Text)+import Data.Time+import Data.ULID (ULID)+import Data.UUID (UUID)+import Data.Word+import Prelude hiding (maybe, null) -import qualified Amazonka.Bytes as AWS-import qualified Amazonka.Data.Base64 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.Lazy as LT-import qualified Prelude as P+import qualified Amazonka.Bytes as AWS+import qualified Amazonka.Data.Base64 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.Lazy as LT+import qualified Prelude as P newtype EncodeValue a = EncodeValue { encodeValue :: a -> Value@@ -74,13 +74,13 @@ maybe :: EncodeValue a -> EncodeValue (Maybe a) maybe =- EncodeValue . P.maybe ValueOfNull . encodeValue+ EncodeValue . P.maybe ValueOfNull . (.encodeValue) -------------------------------------------------------------------------------- array :: EncodeArray a -> EncodeValue a array enc =- ValueOfArray . encodeArray enc >$< rdsValue+ ValueOfArray . enc.encodeArray >$< rdsValue base64 :: EncodeValue AWS.Base64 base64 =