diff --git a/rds-data.cabal b/rds-data.cabal --- a/rds-data.cabal +++ b/rds-data.cabal @@ -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 diff --git a/src/Data/RdsData/Decode/Array.hs b/src/Data/RdsData/Decode/Array.hs --- a/src/Data/RdsData/Decode/Array.hs +++ b/src/Data/RdsData/Decode/Array.hs @@ -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" diff --git a/src/Data/RdsData/Decode/Row.hs b/src/Data/RdsData/Decode/Row.hs --- a/src/Data/RdsData/Decode/Row.hs +++ b/src/Data/RdsData/Decode/Row.hs @@ -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) diff --git a/src/Data/RdsData/Decode/Value.hs b/src/Data/RdsData/Decode/Value.hs --- a/src/Data/RdsData/Decode/Value.hs +++ b/src/Data/RdsData/Decode/Value.hs @@ -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 diff --git a/src/Data/RdsData/Encode/Param.hs b/src/Data/RdsData/Encode/Param.hs --- a/src/Data/RdsData/Encode/Param.hs +++ b/src/Data/RdsData/Encode/Param.hs @@ -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 = diff --git a/src/Data/RdsData/Encode/Params.hs b/src/Data/RdsData/Encode/Params.hs --- a/src/Data/RdsData/Encode/Params.hs +++ b/src/Data/RdsData/Encode/Params.hs @@ -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:) -------------------------------------------------------------------------------- diff --git a/src/Data/RdsData/Encode/Row.hs b/src/Data/RdsData/Encode/Row.hs --- a/src/Data/RdsData/Encode/Row.hs +++ b/src/Data/RdsData/Encode/Row.hs @@ -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) -------------------------------------------------------------------------------- diff --git a/src/Data/RdsData/Encode/Value.hs b/src/Data/RdsData/Encode/Value.hs --- a/src/Data/RdsData/Encode/Value.hs +++ b/src/Data/RdsData/Encode/Value.hs @@ -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 =