packages feed

rds-data-codecs 0.0.0.2 → 0.0.0.3

raw patch · 16 files changed

+126/−34 lines, 16 filesdep +ulid

Dependencies added: ulid

Files

rds-data-codecs.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2  name:                   rds-data-codecs-version:                0.0.0.2+version:                0.0.0.3 synopsis:               Codecs for use with AWS rds-data description:            Codecs for use with AWS rds-data. category:               Data@@ -56,6 +56,7 @@ common text                       { build-depends: text                       >= 2.1        && < 3      } common time                       { build-depends: time                       >= 1.12.2     && < 2      } common transformers               { build-depends: transformers               >= 0.5        && < 0.7    }+common ulid                       { build-depends: ulid                       >= 0.3.2.0    && < 0.4    } common uuid                       { build-depends: uuid                       >= 1.3.15     && < 1.4    }  common rds-data-codecs@@ -89,6 +90,7 @@                       , text                       , time                       , transformers+                      , ulid                       , uuid   exposed-modules:      Data.RdsData                         Data.RdsData.Decode.Array@@ -122,6 +124,7 @@                       , optparse-applicative                       , text                       , time+                      , ulid                       , uuid   main-is:              Main.hs   other-modules:        App.AWS.Env@@ -154,6 +157,7 @@                       , tasty-hedgehog                       , text                       , time+                      , ulid                       , uuid   type:                 exitcode-stdio-1.0   main-is:              Spec.hs
src/Data/RdsData/Decode/Array.hs view
@@ -17,23 +17,24 @@   , integers   , texts -  , ints-  , int8s+  , days   , int16s   , int32s   , int64s-  , words-  , word8s-  , word16s-  , word32s-  , word64s+  , int8s+  , ints+  , jsons   , lazyTexts   , strings-  , jsons   , timesOfDay+  , ulids   , utcTimes-  , days   , uuids+  , word16s+  , word32s+  , word64s+  , word8s+  , words   ) where  import Control.Applicative@@ -42,16 +43,18 @@ 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.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 Data.Aeson                    as J+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  newtype DecodeArray a = DecodeArray   { decodeArray :: Array -> Either Text a@@ -194,6 +197,16 @@   case traverse (parseTimeM True defaultTimeLocale "%Y-%m-%d" . T.unpack) ts of     Just d -> pure d     Nothing -> DecodeArray \_ -> Left "Failed to decode Day"++-- | Decode an array of ULIDs+-- ULIDs are encoded as strings in the database and have have better database performance+-- than UUIDs stored as strings in the database.+ulids :: DecodeArray [ULID]+ulids = do+  ts <- texts+  case traverse CONV.textToUlid ts of+    Right u -> pure u+    Left msg -> DecodeArray \_ -> Left $ "Failed to decode UUID: " <> msg  uuids :: DecodeArray [UUID] uuids = do
src/Data/RdsData/Decode/Row.hs view
@@ -25,6 +25,7 @@   , lazyBytestring   , timeOfDay   , day+  , ulid   , utcTime   , uuid   , ignore@@ -45,16 +46,18 @@ 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-import qualified Data.RdsData.Decode.Value  as DV-import qualified Data.Text                  as T-import qualified Data.Text.Lazy             as LT-import qualified Data.UUID                  as UUID+import qualified Data.Aeson                    as J+import qualified Data.ByteString.Lazy          as LBS+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@@ -178,6 +181,13 @@   case parseTimeM True defaultTimeLocale "%H:%M:%S%Q" (T.unpack t) of     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+    Left msg -> throwError $ "Failed to parse ULID: " <> msg  utcTime :: DecodeRow UTCTime utcTime = do
src/Data/RdsData/Encode/Array.hs view
@@ -11,21 +11,23 @@   , integers   , texts -  , ints-  , int8s+  , days   , int16s   , int32s   , int64s-  , words-  , word8s-  , word16s-  , word32s-  , word64s+  , int8s+  , ints+  , jsons   , lazyTexts   , timesOfDay-  , days-  , jsons+  , ulids+  , uuids   , utcTimes+  , word16s+  , word32s+  , word64s+  , word8s+  , words   ) where  import Data.Functor.Contravariant@@ -34,6 +36,8 @@ import Data.RdsData.Types.Array (Array(..)) import Data.Text (Text) import Data.Time+import Data.ULID+import Data.UUID import Data.Word import Prelude hiding (words) @@ -135,6 +139,14 @@ jsons :: EncodeArray [J.Value] jsons =   fmap jsonToText >$< texts++ulids :: EncodeArray [ULID]+ulids =+  fmap ulidToText >$< texts++uuids :: EncodeArray [UUID]+uuids =+  fmap uuidToText >$< texts  utcTimes :: EncodeArray [UTCTime] utcTimes =
src/Data/RdsData/Encode/Param.hs view
@@ -25,21 +25,22 @@   , base64   , day   , int-  , int8   , int16   , int32   , int64+  , int8   , json   , lazyBytestring   , lazyText   , timeOfDay+  , ulid   , utcTime   , uuid   , word-  , word8   , word16   , word32   , word64+  , word8   ) where  import Control.Lens@@ -52,6 +53,7 @@ import Data.RdsData.Types.Param import Data.Text (Text) import Data.Time+import Data.ULID (ULID) import Data.UUID (UUID) import Data.Word import Prelude hiding (maybe, null)@@ -188,6 +190,10 @@ json :: EncodeParam J.Value json =   CONV.jsonToText >$< text & typed AWS.TypeHint_JSON++ulid :: EncodeParam ULID+ulid =+  CONV.ulidToText >$< text  utcTime :: EncodeParam UTCTime utcTime =
src/Data/RdsData/Encode/Params.hs view
@@ -28,6 +28,7 @@   , lazyBytestring   , lazyText   , timeOfDay+  , ulid   , utcTime   , uuid   , word@@ -47,6 +48,7 @@ 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)@@ -196,6 +198,10 @@ json :: EncodeParams J.Value json =   column EP.json++ulid :: EncodeParams ULID+ulid =+  column EP.ulid  utcTime :: EncodeParams UTCTime utcTime =
src/Data/RdsData/Encode/Row.hs view
@@ -28,6 +28,7 @@   , lazyBytestring   , lazyText   , timeOfDay+  , ulid   , utcTime   , uuid   , word@@ -46,6 +47,7 @@ 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@@ -196,6 +198,10 @@ json :: EncodeRow J.Value json =   column EV.json++ulid :: EncodeRow ULID+ulid =+  column EV.ulid  utcTime :: EncodeRow UTCTime utcTime =
src/Data/RdsData/Encode/Value.hs view
@@ -27,6 +27,7 @@   , lazyText   , timeOfDay   , utcTime+  , ulid   , uuid   , word   , word8@@ -42,6 +43,7 @@ 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)@@ -173,6 +175,10 @@ utcTime :: EncodeValue UTCTime utcTime =   CONV.utcTimeToText >$< text++ulid :: EncodeValue ULID+ulid =+  CONV.ulidToText >$< text  uuid :: EncodeValue UUID uuid =
src/Data/RdsData/Internal/Convert.hs view
@@ -1,23 +1,32 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}  module Data.RdsData.Internal.Convert   ( dayToText   , jsonToText   , timeOfDayToText+  , ulidToText   , uuidToText   , utcTimeToText   , textToDouble+  , textToUlid   ) where +import Data.Bifunctor+import Data.ULID (ULID) import Data.UUID (UUID) import Data.Text (Text) import Data.Time+    ( formatTime, defaultTimeLocale, Day, UTCTime, TimeOfDay ) import Prelude hiding (maybe, null)+import Text.Read  import qualified Data.Aeson           as J import qualified Data.ByteString.Lazy as LBS import qualified Data.Text            as T import qualified Data.Text.Encoding   as T+import qualified Data.ULID            as ULID+import qualified Data.ULID.Base32     as ULID import qualified Data.UUID            as UUID  timeOfDayToText :: TimeOfDay -> Text@@ -35,6 +44,14 @@ utcTimeToText :: UTCTime -> Text utcTimeToText =    T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"++ulidToText :: ULID -> Text+ulidToText = +  ULID.encode 26 . ULID.ulidToInteger++textToUlid :: Text -> Either Text ULID+textToUlid t =+  bimap (const ("Unable to decode ULID: " <> t)) id (readEither @ULID (T.unpack t))  uuidToText :: UUID -> Text uuidToText =
test/Data/RdsData/TestTypes.hs view
@@ -13,6 +13,7 @@ import Data.RdsData.Internal.Aeson () import Data.Text (Text) import Data.Time (Day, TimeOfDay(..), UTCTime)+import Data.ULID (ULID) import Data.UUID (UUID) import GHC.Generics @@ -43,6 +44,7 @@   , times               :: TimeOfDay   , timestamp           :: UTCTime   , timestamps          :: UTCTime+  , ulid                :: ULID   , uuid                :: UUID   }   deriving (Show, Eq, Generic)
test/Data/RdsDataSpec.hs view
@@ -69,6 +69,7 @@             <*> DEC.timeOfDay             <*> DEC.utcTime             <*> DEC.utcTime+            <*> DEC.ulid             <*> DEC.uuid         values     >>= either (\s -> H.noteShow_ s >> H.failure) pure@@ -99,6 +100,7 @@       , TT.times              = TimeOfDay 12 34 56.78       , TT.timestamp          = read "2024-02-04 12:34:56 UTC"       , TT.timestamps         = read "2024-02-04 12:34:56 UTC"+      , TT.ulid               = read "0123456789ABCDEFGHJKMNPQRS"       , TT.uuid               = read "550e8400-e29b-41d4-a716-446655440000"       }     ]@@ -132,6 +134,7 @@       , TT.times              = TimeOfDay 12 34 56.78       , TT.timestamp          = read "2024-02-04 12:34:56 UTC"       , TT.timestamps         = read "2024-02-04 12:34:56 UTC"+      , TT.ulid               = read "0123456789ABCDEFGHJKMNPQRS"       , TT.uuid               = read "550e8400-e29b-41d4-a716-446655440000"       }
test/files/rds-schema.sql view
@@ -23,5 +23,6 @@   the_times                 time(2)               not null,   the_timestamp             timestamp             not null,   the_timestamps            timestamp(2)          not null,-  the_uuid                  uuid                  not null+  the_uuid                  uuid                  not null,+  the_ulid                  char(16)              not null )
test/files/rds-value.sql view
@@ -49,5 +49,6 @@   '12:34:56.78',                          -- the_times   '2024-02-04 12:34:56',                  -- the_timestamp   '2024-02-04 12:34:56',                  -- the_timestamps+  '0123456789ABCDEFGHJKMNPQRS',           -- the_ulid   '550e8400-e29b-41d4-a716-446655440000'  -- the_uuid );
test/files/row.json view
@@ -76,6 +76,9 @@         "stringValue": "2024-02-04 12:34:56"       },       {+        "stringValue": "0123456789ABCDEFGHJKMNPQRS"+      },+      {         "stringValue": "550e8400-e29b-41d4-a716-446655440000"       }     ]
test/files/schema.sql view
@@ -41,6 +41,7 @@   the_timestamps            timestamp(2)          not null,   the_tsquery               tsquery               not null,   the_tsvector              tsvector              not null,+  the_ulid                  char(16)              not null,   the_uuid                  uuid                  not null,   the_xml                   xml                   not null )
test/files/value.sql view
@@ -86,6 +86,7 @@   '2024-02-04 12:34:56',                  -- the_timestamps   to_tsquery('english', 'query'),         -- the_tsquery   to_tsvector('english', 'document'),     -- the_tsvector+  '0123456789ABCDEFGHJKMNPQRS',           -- the_ulid   '550e8400-e29b-41d4-a716-446655440000', -- the_uuid   '<root><element>data</element></root>'  -- the_xml );