Skip to content

Commit

Permalink
Merge pull request #27 from haskell-works/newhoggy/simplified-record-…
Browse files Browse the repository at this point in the history
…decoding

New `ToRows` type class
  • Loading branch information
newhoggy authored Nov 15, 2024
2 parents 6b22ac9 + 87d3fee commit fabec3d
Show file tree
Hide file tree
Showing 3 changed files with 26 additions and 4 deletions.
1 change: 1 addition & 0 deletions rds-data.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -118,6 +118,7 @@ library codecs
Data.RdsData.Aws
Data.RdsData.Decode.Array
Data.RdsData.Decode.Row
Data.RdsData.Decode.ToRows
Data.RdsData.Decode.Value
Data.RdsData.Default
Data.RdsData.Encode.Array
Expand Down
10 changes: 6 additions & 4 deletions src/Data/RdsData/Decode/Row.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@

module Data.RdsData.Decode.Row
( DecodeRow(..)
, ToRows(..)
, integer
, int
, int8
Expand Down Expand Up @@ -55,14 +56,15 @@ import Prelude hiding (maybe)

import qualified Data.Aeson as J
import qualified Data.ByteString.Lazy as LBS
import Data.RdsData.Decode.ToRows
import qualified Data.RdsData.Decode.Value as DV
import qualified Data.RdsData.Internal.Convert as CONV
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.UUID as UUID

newtype DecodeRow a = DecodeRow
{ unDecodeRow :: ExceptT Text (StateT [Value] Identity) a
{ run :: ExceptT Text (StateT [Value] Identity) a
}
deriving (Applicative, Functor, Monad, MonadState [Value], MonadError Text)

Expand Down Expand Up @@ -225,7 +227,7 @@ ignore =
void $ column DV.rdsValue

decodeRow :: DecodeRow a -> [Value] -> Either Text a
decodeRow r = evalState (runExceptT r.unDecodeRow)
decodeRow r = evalState (runExceptT r.run)

decodeRows :: DecodeRow a -> [[Value]] -> Either Text [a]
decodeRows r = traverse (decodeRow r)
decodeRows :: ToRows res => DecodeRow a -> res -> Either Text [a]
decodeRows r = traverse (decodeRow r) . toRows
19 changes: 19 additions & 0 deletions src/Data/RdsData/Decode/ToRows.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
module Data.RdsData.Decode.ToRows
( ToRows(..)
) where

import qualified Amazonka.RDSData as AWS
import Data.Generics.Product.Any
import Data.Maybe
import Data.RdsData.Types
import Lens.Micro ((^.))

class ToRows a where
toRows :: a -> [[Value]]

instance ToRows [[Value]] where
toRows = id

instance ToRows AWS.ExecuteStatementResponse where
toRows res =
fromMaybe [] $ mapM (mapM fromField) =<< res ^. the @"records"

0 comments on commit fabec3d

Please sign in to comment.