dynamodb-simple 0.2.0.0 → 0.3.0.0

raw patch · 14 files changed

+390/−182 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +4/−2
• changelog.md +7/−0
• dynamodb-simple.cabal +2/−2
• src/Database/DynamoDB.hs +57/−45
• src/Database/DynamoDB/BatchRequest.hs +4/−10
• src/Database/DynamoDB/Class.hs +36/−23
• src/Database/DynamoDB/Filter.hs +1/−1
• src/Database/DynamoDB/QueryRequest.hs +113/−64
• src/Database/DynamoDB/TH.hs +20/−9
• src/Database/DynamoDB/THContains.hs +5/−5
• src/Database/DynamoDB/THConvert.hs +68/−0
• src/Database/DynamoDB/Types.hs +32/−3
• test/BaseSpec.hs +32/−9
• test/NestedSpec.hs +9/−9

@@ -30,7 +30,7 @@       --       putItem (Test "news" "john" "test" 20)       ---      item <- getItem Eventually (tTest, ("news", "john"))+      item <- getItem Eventually tTest ("news", "john")       liftIO $ print item       --       items <- scanCond tTest (replies' >. 15) 10@@ -56,7 +56,9 @@   queries when searching for these empty values. - Compatible with GHC8 `DuplicateRecordFields` - Customizable table and index names. Custom translation of field names to attribute names.-- Streaming settings.+- AWS Dynamo streaming settings.+- Utilities to help with simulated joins or retriving original data from index.+- Both conduit and page-based API.  ### What is planned 

@@ -1,3 +1,10 @@+# 0.3.0.0+- API changes regarding position of `Proxy`+- Added index->table conversion functions+- Added conduits for left/inner join+- Added queryOverIndex+- Simplification of exposed function signatures+ # 0.2.0.0  - Changed API to always include a `Proxy`

@@ -1,5 +1,5 @@ name:                dynamodb-simple-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Typesafe library for working with DynamoDB database description:         Framework for accessing DynamoDB database. The majority of AWS API                      is available to the user in a convenient, simple and typesafe manner.@@ -26,7 +26,7 @@   other-modules:       Database.DynamoDB.Class, Database.DynamoDB.Migration,                        Database.DynamoDB.Internal, Database.DynamoDB.BatchRequest,                        Database.DynamoDB.QueryRequest, Database.DynamoDB.THLens,-                       Database.DynamoDB.THContains+                       Database.DynamoDB.THContains, Database.DynamoDB.THConvert   build-depends:       base >=4.8 && <5, amazonka-dynamodb, generics-sop,                        unordered-containers, text, lens, double-conversion,                        semigroups, bytestring, containers, monad-supply,

@@ -26,6 +26,9 @@     -- * Lens support     -- $lens +    -- * Conversion support+    -- $conversion+     -- * Data types     DynamoException(..)   , Consistency(..)@@ -45,6 +48,8 @@   , querySimple   , queryCond   , querySource+  , querySourceChunks+  , queryOverIndex     -- * Scan options   , ScanOpts   , scanOpts@@ -52,7 +57,11 @@     -- * Performing scan   , scan   , scanSource+  , scanSourceChunks   , scanCond+    -- * Helper conduits+  , leftJoin+  , innerJoin     -- * Data entry   , putItem   , putItemBatch@@ -69,6 +78,13 @@   , deleteTable     -- * Utility functions   , tableKey+    -- * Typeclasses+  , DynamoTable+  , DynamoIndex+  , PrimaryKey+  , ContainsTableKey+  , CanQuery+  , TableScan ) where  import           Control.Lens                        ((%~), (.~), (^.))@@ -79,7 +95,6 @@ import           Data.Proxy import           Data.Semigroup                      ((<>)) import qualified Data.Text                           as T-import           Generics.SOP import           Network.AWS import qualified Network.AWS.DynamoDB.DeleteItem     as D import qualified Network.AWS.DynamoDB.GetItem        as D@@ -97,12 +112,10 @@ import           Database.DynamoDB.QueryRequest  -dDeleteItem :: (DynamoTable a r, HasPrimaryKey a r 'IsTable, Code a ~ '[ hash ': range ': xss ])-          => Proxy a -> PrimaryKey (Code a) r -> D.DeleteItem+dDeleteItem :: DynamoTable a r => Proxy a -> PrimaryKey a r -> D.DeleteItem dDeleteItem p pkey = D.deleteItem (tableName p) & D.diKey .~ dKeyToAttr p pkey -dGetItem :: (DynamoTable a r, HasPrimaryKey a r 'IsTable, Code a ~ '[ hash ': range ': xss ])-          => Proxy a -> PrimaryKey (Code a) r -> D.GetItem+dGetItem :: DynamoTable a r => Proxy a -> PrimaryKey a r -> D.GetItem dGetItem p pkey = D.getItem (tableName p) & D.giKey .~ dKeyToAttr p pkey  -- | Write item into the database; overwrite any previously existing item with the same primary key.@@ -123,31 +136,26 @@   -- | Read item from the database; primary key is either a hash key or (hash,range) tuple depending on the table.-getItem :: forall m a r range hash rest.-    (MonadAWS m, DynamoTable a r, HasPrimaryKey a r 'IsTable, Code a ~ '[ hash ': range ': rest])-    => Consistency -> (Proxy a, PrimaryKey (Code a) r) -> m (Maybe a)-getItem consistency (p, key) = do+getItem :: forall m a r. (MonadAWS m, DynamoTable a r) => Consistency -> Proxy a -> PrimaryKey a r -> m (Maybe a)+getItem consistency p key = do   let cmd = dGetItem p key & D.giConsistentRead . consistencyL .~ consistency   rs <- send cmd   let result = rs ^. D.girsItem   if | null result -> return Nothing      | otherwise ->-          case gsDecode result of+          case dGsDecode result of               Just res -> return (Just res)               Nothing -> throwM (DynamoException $ "Cannot decode item: " <> T.pack (show result))  -- | Delete item from the database by specifying the primary key.-deleteItemByKey :: forall m a r hash range rest.-    (MonadAWS m, HasPrimaryKey a r 'IsTable, DynamoTable a r, Code a ~ '[ hash ': range ': rest])-    => (Proxy a, PrimaryKey (Code a) r) -> m ()-deleteItemByKey (p, pkey) = void $ send (dDeleteItem p pkey)+deleteItemByKey :: forall m a r. (MonadAWS m, DynamoTable a r) => Proxy a -> PrimaryKey a r -> m ()+deleteItemByKey p pkey = void $ send (dDeleteItem p pkey)  -- | Delete item from the database by specifying the primary key and a condition. -- Throws AWS exception if the condition does not succeed.-deleteItemCondByKey :: forall m a r hash range rest.-    (MonadAWS m, HasPrimaryKey a r 'IsTable, DynamoTable a r, Code a ~ '[ hash ': range ': rest])-    => (Proxy a, PrimaryKey (Code a) r) -> FilterCondition a -> m ()-deleteItemCondByKey (p, pkey) cond =+deleteItemCondByKey :: forall m a r.+    (MonadAWS m, DynamoTable a r) => Proxy a -> PrimaryKey a r -> FilterCondition a -> m ()+deleteItemCondByKey p pkey cond =     let (expr, attnames, attvals) = dumpCondition cond         cmd = dDeleteItem p pkey & D.diExpressionAttributeNames .~ attnames                                  & bool (D.diExpressionAttributeValues .~ attvals) id (null attvals) -- HACK; https://github.com/brendanhay/amazonka/issues/332@@ -156,9 +164,8 @@  -- | Generate update item object; automatically adds condition for existence of primary -- key, so that only existing objects are modified-dUpdateItem :: forall a r hash range xss.-            (DynamoTable a r, HasPrimaryKey a r 'IsTable, Code a ~ '[ hash ': range ': xss ])-          => Proxy a -> PrimaryKey (Code a) r -> Action a -> Maybe (FilterCondition a) ->  Maybe D.UpdateItem+dUpdateItem :: forall a r. DynamoTable a r+          => Proxy a -> PrimaryKey a r -> Action a -> Maybe (FilterCondition a) ->  Maybe D.UpdateItem dUpdateItem p pkey actions mcond =     genAction <$> dumpActions actions   where@@ -183,50 +190,48 @@     addCondition Nothing = id -- Cannot happen anyway  --- | Update item in a table+-- | Update item in a table. ----- > updateItem (Proxy :: Proxy Test) (12, "2") [colCount +=. 100]-updateItemByKey_ :: forall a m r hash range rest.-      (MonadAWS m, HasPrimaryKey a r 'IsTable, DynamoTable a r, Code a ~ '[ hash ': range ': rest ])-    => (Proxy a, PrimaryKey (Code a) r) -> Action a -> m ()-updateItemByKey_ (p, pkey) actions+-- > updateItem (Proxy :: Proxy Test) (12, "2") (colCount +=. 100)+updateItemByKey_ :: forall a m r.+      (MonadAWS m, DynamoTable a r) => Proxy a -> PrimaryKey a r -> Action a -> m ()+updateItemByKey_ p pkey actions   | Just cmd <- dUpdateItem p pkey actions Nothing = void $ send cmd   | otherwise = return () -updateItemByKey :: forall a m r hash range rest.-      (MonadAWS m, HasPrimaryKey a r 'IsTable, DynamoTable a r, Code a ~ '[ hash ': range ': rest ])-    => (Proxy a, PrimaryKey (Code a) r) -> Action a -> m a-updateItemByKey (p, pkey) actions+-- | Update item in a database, return an updated version of the item.+updateItemByKey :: forall a m r.+      (MonadAWS m, DynamoTable a r) => Proxy a -> PrimaryKey a r -> Action a -> m a+updateItemByKey p pkey actions   | Just cmd <- dUpdateItem p pkey actions Nothing = do         rs <- send (cmd & D.uiReturnValues .~ Just D.AllNew)-        case gsDecode (rs ^. D.uirsAttributes) of+        case dGsDecode (rs ^. D.uirsAttributes) of             Just res -> return res             Nothing -> throwM (DynamoException $ "Cannot decode item: " <> T.pack (show rs))   | otherwise = do-      rs <- getItem Strongly (p, pkey)+      rs <- getItem Strongly p pkey       case rs of           Just res -> return res           Nothing -> throwM (DynamoException "Cannot decode item.") --- | Update item in a table while specifying a condition-updateItemCond_ :: forall a m r hash range rest.-      (MonadAWS m, DynamoTable a r, HasPrimaryKey a r 'IsTable, Code a ~ '[ hash ': range ': rest ])-    => (Proxy a, PrimaryKey (Code a) r) -> Action a -> FilterCondition a -> m ()-updateItemCond_ (p, pkey) actions cond+-- | Update item in a table while specifying a condition.+updateItemCond_ :: forall a m r. (MonadAWS m, DynamoTable a r)+    => Proxy a -> PrimaryKey a r -> FilterCondition a -> Action a -> m ()+updateItemCond_ p pkey cond actions   | Just cmd <- dUpdateItem p pkey actions (Just cond) = void $ send cmd   | otherwise = return () --- | Delete table from DynamoDB.+-- | Delete a table from DynamoDB. deleteTable :: (MonadAWS m, DynamoTable a r) => Proxy a -> m () deleteTable p = void $ send (D.deleteTable (tableName p)) --- | Extract primary key from a record in a form that can be directly used by other functions.+-- | Extract primary key from a record. -- -- You can use this on both main table or on index tables if they contain the primary key from -- the main table. Table key is always projected to indexes anyway, so just define it in -- every index.-tableKey :: forall a parent key. ContainsTableKey a parent key => a -> (Proxy parent, key)-tableKey a = (Proxy, dTableKey a)+tableKey :: forall a parent key. ContainsTableKey a parent key => a -> key+tableKey = dTableKey  -- $intro --@@ -276,7 +281,7 @@ --        -- Save data to database --        putItem (Test "news" "1-2-3-4" "New subject") --        -- Fetch data given primary key---        item <- getItem Eventually (tTest, ("news", "1-2-3-4"))+--        item <- getItem Eventually tTest ("news", "1-2-3-4") --        liftIO $ print item       -- (item :: Maybe Test) --        -- Scan data using filter condition, return 10 results --        items <- scanCond tTest (subject' ==. "New subejct") 10@@ -307,8 +312,8 @@ --   , _subject :: T.Text -- } deriving (Show) -- data TestIndex = TestIndex {---     _category :: T.Text---   , _messageid :: T.Text+--     i_category :: T.Text+--   , i_messageid :: T.Text -- } -- mkTableDefs "migrate" (tableConfig (''Test, WithRange) [(''TestIndex, NoRange)] []) --@@ -318,3 +323,10 @@ -- doWithItemIdx :: TestIndex -> .. -- getCategoryIdx item = (item ^. category) ... -- @++-- $conversion+--+-- Given a type 'Test' and an index type 'TestIndex',+-- a function 'toTest' is created that converts from 'TestIndex' to 'Test'.+-- Such function is created only if 'TestIndex' projects+-- all fields from 'Test'.

@@ -25,7 +25,6 @@ import           Data.Monoid                         ((<>)) import           Data.Proxy import qualified Data.Text                           as T-import           Generics.SOP import           Network.AWS import qualified Network.AWS.DynamoDB.BatchGetItem   as D import qualified Network.AWS.DynamoDB.BatchWriteItem as D@@ -86,9 +85,7 @@   -- | Get batch of items.-getItemBatch :: forall m a r range hash rest.-    (MonadAWS m, DynamoTable a r, HasPrimaryKey a r 'IsTable, Code a ~ '[ hash ': range ': rest])-    => Consistency -> [PrimaryKey (Code a) r] -> m [a]+getItemBatch :: forall m a r. (MonadAWS m, DynamoTable a r) => Consistency -> [PrimaryKey a r] -> m [a] getItemBatch consistency lst = concat <$> mapM go (chunkBatch 100 lst)   where     go keys = do@@ -100,21 +97,18 @@         tbls <- retryReadBatch cmd         mapM decoder (tbls ^.. ix tblname . traverse)     decoder item =-        case gsDecode item of+        case dGsDecode item of           Just res -> return res           Nothing -> throwM (DynamoException $ "Error decoding item: " <> T.pack (show item)) -dDeleteRequest :: (HasPrimaryKey a r 'IsTable, Code a ~ '[ hash ': range ': xss ])-          => Proxy a -> PrimaryKey (Code a) r -> D.DeleteRequest+dDeleteRequest :: DynamoTable a r => Proxy a -> PrimaryKey a r -> D.DeleteRequest dDeleteRequest p pkey = D.deleteRequest & D.drKey .~ dKeyToAttr p pkey  -- | Batch version of 'deleteItemByKey'. -- -- Note: Because the requests are chunked, the information about which items -- were deleted in case of exception is unavailable.-deleteItemBatchByKey :: forall m a r range hash rest.-    (MonadAWS m, HasPrimaryKey a r 'IsTable, DynamoTable a r, Code a ~ '[ hash ': range ': rest])-    => Proxy a -> [PrimaryKey (Code a) r] -> m ()+deleteItemBatchByKey :: forall m a r. (MonadAWS m, DynamoTable a r) => Proxy a -> [PrimaryKey a r] -> m () deleteItemBatchByKey p lst = mapM_ go (chunkBatch 25 lst)   where     go keys = do

@@ -5,7 +5,6 @@ {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -- We have lots of pattern matching for allFieldNames, that is correct because of TH {-# LANGUAGE DataKinds              #-}-{-# LANGUAGE DefaultSignatures      #-} {-# LANGUAGE FlexibleContexts       #-} {-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE FunctionalDependencies #-}@@ -19,6 +18,7 @@ {-# LANGUAGE TypeFamilies           #-} {-# LANGUAGE TypeOperators          #-} {-# LANGUAGE UndecidableInstances   #-}+{-# LANGUAGE DefaultSignatures   #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE UndecidableSuperClasses #-} #endif@@ -27,7 +27,6 @@     DynamoCollection(..)   , DynamoTable(..)   , DynamoIndex(..)-  , dQueryKey   , dScan   , RangeType(..)   , TableType(..)@@ -36,7 +35,7 @@   , gsEncode   , gsEncodeG   , PrimaryKey-  , TableQuery+  , CanQuery(..)   , TableScan   , TableCreate(..)   , IndexCreate(..)@@ -80,18 +79,23 @@   => DynamoCollection a (r :: RangeType) (t :: TableType) | a -> r t where   allFieldNames :: Proxy a -> [T.Text]   primaryFields :: Proxy a -> [T.Text]+  dGsDecode :: HashMap T.Text AttributeValue -> Maybe a+  default dGsDecode :: (Code a ~ '[ xs ]) => HashMap T.Text AttributeValue -> Maybe a+  dGsDecode = gsDecode  class DynamoCollection a r t => HasPrimaryKey a (r :: RangeType) (t :: TableType) where-  dItemToKey :: (Code a ~ '[ hash ': range ': xss ]) => a -> PrimaryKey (Code a) r-  dKeyToAttr :: (Code a ~ '[ hash ': range ': xss ])-            => Proxy a -> PrimaryKey (Code a) r -> HMap.HashMap T.Text D.AttributeValue-  dAttrToKey :: Proxy a -> HMap.HashMap T.Text D.AttributeValue -> Maybe (PrimaryKey (Code a) r)+  dItemToKey :: a -> PrimaryKey a r+  dKeyToAttr :: Proxy a -> PrimaryKey a r -> HMap.HashMap T.Text D.AttributeValue+  dAttrToKey :: Proxy a -> HMap.HashMap T.Text D.AttributeValue -> Maybe (PrimaryKey a r)+  -- | Return True if key is well-defined (i.e. no empty string, no Maybe etc.)+  dKeyIsDefined :: Proxy a -> PrimaryKey a r -> Bool  instance (DynamoCollection a 'NoRange t, Code a ~ '[ hash ': xss ],           DynamoScalar v hash) => HasPrimaryKey a 'NoRange t where   dItemToKey = gdFirstField   dKeyToAttr p key = HMap.singleton (head $ allFieldNames p) (dScalarEncode key)   dAttrToKey p attrs = HMap.lookup (head $ allFieldNames p) attrs >>= dDecode . Just+  dKeyIsDefined _ = not . dIsMissing  instance (DynamoCollection a 'WithRange t, Code a ~ '[ hash ': range ': xss ],           DynamoScalar v1 hash, DynamoScalar v2 range) => HasPrimaryKey a 'WithRange t where@@ -107,9 +111,10 @@       rngkey <- HMap.lookup rangename attrs       rngval <- dDecode (Just rngkey)       return (pval, rngval)+  dKeyIsDefined _ (hash, range) = not (dIsMissing hash) && not (dIsMissing range)  -- | Descritpion of dynamo table-class DynamoCollection a r 'IsTable => DynamoTable a (r :: RangeType) | a -> r where+class (DynamoCollection a r 'IsTable, HasPrimaryKey a r 'IsTable) => DynamoTable a (r :: RangeType) | a -> r where   -- | Dynamo table/index name; default is the constructor name   tableName :: Proxy a -> T.Text   -- | Serialize data, put it into the database@@ -125,47 +130,54 @@     => TableCreate a 'WithRange where   createTable = defaultCreateTableRange --- | Instance for tables that can be queried-class DynamoCollection a 'WithRange t => TableQuery a (t :: TableType) where+-- | Class for tables/indexes that can be queried+class (DynamoCollection a 'WithRange t, HasPrimaryKey a 'WithRange t) => CanQuery a (t :: TableType) hash range | a -> hash range where   -- | Return table name and index name   qTableName :: Proxy a -> T.Text   qIndexName :: Proxy a -> Maybe T.Text   -- | Create a query using both hash key and operation on range key   -- On tables without range key, this degrades to queryKey-  dQueryKey :: (Code a ~ '[ hash ': range ': rest ])-      => Proxy a -> hash -> Maybe (RangeOper range) -> D.Query+  dQueryKey :: Proxy a -> hash -> Maybe (RangeOper range) -> D.Query+  dQueryKeyToAttr :: Proxy a -> (hash, range) -> HMap.HashMap T.Text D.AttributeValue instance  (DynamoCollection a 'WithRange 'IsTable, DynamoTable a 'WithRange,-           Code a ~ '[ hash ': range ': rest ], DynamoScalar v1 hash, DynamoScalar v2 range)-    => TableQuery a 'IsTable where+           Code a ~ '[ hash ': range ': rest ], DynamoScalar v1 hash, DynamoScalar v2 range,+           PrimaryKey a 'WithRange ~ (hash, range))+    => CanQuery a 'IsTable hash range where   dQueryKey = defaultQueryKey   qTableName = tableName   qIndexName _ = Nothing+  dQueryKeyToAttr = dKeyToAttr instance  (DynamoCollection a 'WithRange 'IsIndex, DynamoIndex a parent 'WithRange, DynamoTable parent r1,-            Code a ~ '[ hash ': range ': rest ], DynamoScalar v1 hash, DynamoScalar v2 range)-        => TableQuery a 'IsIndex where+            Code a ~ '[ hash ': range ': rest ], DynamoScalar v1 hash, DynamoScalar v2 range,+            PrimaryKey a 'WithRange ~ (hash, range))+        => CanQuery a 'IsIndex hash range where   dQueryKey = defaultQueryKey   qTableName _ = tableName (Proxy :: Proxy parent)   qIndexName = Just . indexName+  dQueryKeyToAttr = dKeyToAttr -class DynamoCollection a r t => TableScan a (r :: RangeType) (t :: TableType) where+-- | Class for tables/indexes that can be scanned+class (DynamoCollection a r t, HasPrimaryKey a r t) => TableScan a (r :: RangeType) (t :: TableType) where   -- | Return table name and index name   qsTableName :: Proxy a -> T.Text   qsIndexName :: Proxy a -> Maybe T.Text   dScan :: Proxy a -> D.Scan-instance DynamoTable a r => TableScan a r 'IsTable where+instance (DynamoCollection a r 'IsTable, DynamoTable a r) => TableScan a r 'IsTable where   qsTableName = tableName   qsIndexName _ = Nothing   dScan = defaultScan instance (DynamoCollection a r 'IsIndex,-          DynamoIndex a parent r, DynamoTable parent r1) => TableScan a r 'IsIndex where+          DynamoIndex a parent r, DynamoTable parent r1, HasPrimaryKey a r 'IsIndex) => TableScan a r 'IsIndex where   qsTableName _ = tableName (Proxy :: Proxy parent)   qsIndexName = Just . indexName   dScan = defaultScan +-- | Type family that returns a primary key of a table/index depending on the 'RangeType' parameter.+type PrimaryKey a r = PrimaryKey' (Code a) r -- | Parameter type for queryKeyRange-type family PrimaryKey (a :: [[*]]) (r :: RangeType) :: * where-    PrimaryKey ('[ key ': range ': rest ] ) 'WithRange = (key, range)-    PrimaryKey ('[ key ': rest ]) 'NoRange = key+type family PrimaryKey' (a :: [[*]]) (r :: RangeType) :: * where+    PrimaryKey' ('[ key ': range ': rest ] ) 'WithRange = (key, range)+    PrimaryKey' ('[ key ': rest ]) 'NoRange = key  -- | Class representing a Global Secondary Index class DynamoCollection a r 'IsIndex => DynamoIndex a parent (r :: RangeType) | a -> parent r where@@ -182,6 +194,7 @@       => IndexCreate a p 'WithRange where   createGlobalIndex = defaultCreateGlobalIndexRange +-- | Class for indexes that contain primary key of the parent table class ContainsTableKey a parent key | a -> parent key where   -- | Extract table primary key from an item, if possible   dTableKey :: a -> key@@ -266,7 +279,7 @@     keyDefs = [D.attributeDefinition hashname (dType (Proxy :: Proxy hash)),                D.attributeDefinition rangename (dType (Proxy :: Proxy range))] -defaultQueryKey :: (TableQuery a t, Code a ~ '[ hash ': range ': rest ], DynamoScalar v1 hash, DynamoScalar v2 range)+defaultQueryKey :: (CanQuery a t hash range, DynamoScalar v1 hash, DynamoScalar v2 range)     => Proxy a -> hash -> Maybe (RangeOper range) -> D.Query defaultQueryKey p key Nothing =   D.query (qTableName p) & D.qKeyConditionExpression .~ Just "#K = :key"

@@ -106,7 +106,7 @@ -- | > a /= b === Not (a == b) (/=.) :: (InCollection col tbl 'FullPath, DynamoEncodable typ)         => Column typ ctyp col -> typ -> FilterCondition tbl-(/=.) col val = Not (dcomp "=" col val)+(/=.) col val = Not (col ==. val) infix 4 /=.  

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP                    #-}+{-# LANGUAGE CPP                 #-} #if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -Wno-redundant-constraints #-} #endif@@ -19,10 +19,13 @@   , querySimple   , queryCond   , querySource+  , querySourceChunks+  , queryOverIndex   -- * Scan   , scan   , scanCond   , scanSource+  , scanSourceChunks   -- * Query options   , QueryOpts   , queryOpts@@ -31,48 +34,52 @@   , ScanOpts   , scanOpts   , sFilterCondition, sConsistentRead, sLimit, sParallel, sStartKey+  -- * Helper conduits+  , leftJoin+  , innerJoin ) where  -import           Control.Arrow              (first)-import           Control.Lens               (Lens', view, (%~), (.~), (^.))-import           Control.Lens.TH            (makeLenses)-import           Control.Monad.Catch        (throwM)-import           Data.Bool                  (bool)-import           Data.Coerce                (coerce)-import           Data.Conduit               (Conduit, Source, (=$=))-import qualified Data.Conduit.List          as CL-import           Data.Foldable              (toList)-import           Data.Function              ((&))-import           Data.HashMap.Strict        (HashMap)-import           Data.Monoid                ((<>))+import           Control.Arrow                  (first)+import           Control.Arrow                  (second)+import           Control.Lens                   (Lens', sequenceOf, view, (%~),+                                                 (.~), (^.), _2)+import           Control.Lens.TH                (makeLenses)+import           Control.Monad                  ((>=>))+import           Control.Monad.Catch            (throwM)+import           Data.Bool                      (bool)+import           Data.Coerce                    (coerce)+import           Data.Conduit                   (Conduit, Source, (=$=))+import qualified Data.Conduit.List              as CL+import           Data.Foldable                  (toList)+import           Data.Function                  ((&))+import           Data.HashMap.Strict            (HashMap)+import qualified Data.Map                       as Map+import           Data.Maybe                     (mapMaybe)+import           Data.Monoid                    ((<>)) import           Data.Proxy-import           Data.Sequence              (Seq)-import qualified Data.Sequence              as Seq-import qualified Data.Text                  as T+import           Data.Sequence                  (Seq)+import qualified Data.Sequence                  as Seq+import qualified Data.Text                      as T import           Generics.SOP import           Network.AWS-import qualified Network.AWS.DynamoDB.Query as D-import qualified Network.AWS.DynamoDB.Scan  as D-import qualified Network.AWS.DynamoDB.Types as D-import           Network.AWS.Pager          (AWSPager (..))-import           Numeric.Natural            (Natural)+import qualified Network.AWS.DynamoDB.Query     as D+import qualified Network.AWS.DynamoDB.Scan      as D+import qualified Network.AWS.DynamoDB.Types     as D+import           Network.AWS.Pager              (AWSPager (..))+import           Numeric.Natural                (Natural) +import           Database.DynamoDB.BatchRequest (getItemBatch) import           Database.DynamoDB.Class import           Database.DynamoDB.Filter import           Database.DynamoDB.Internal import           Database.DynamoDB.Types ---- | Helper function to decode data from the conduit.-rsDecode :: (MonadAWS m, Code a ~ '[ hash ': range ': rest], DynamoCollection a r t)-    => (i -> [HashMap T.Text D.AttributeValue]) -> Conduit i m a-rsDecode trans = CL.mapFoldable trans =$= CL.mapM rsDecoder--rsDecoder :: (MonadAWS m, Code a ~ '[ hash ': range ': rest], DynamoCollection a r t)+-- | Decode data, throw exception if decoding fails.+rsDecoder :: (MonadAWS m, DynamoCollection a r t)     => HashMap T.Text D.AttributeValue -> m a rsDecoder item =-  case gsDecode item of+  case dGsDecode item of     Just res -> return res     Nothing -> throwM (DynamoException $ "Error decoding item: " <> T.pack (show item)) @@ -94,10 +101,7 @@ queryOpts key = QueryOpts key Nothing Nothing Eventually Forward Nothing Nothing  -- | Generate a "D.Query" object-queryCmd :: forall a t v1 v2 hash range rest.-    (TableQuery a t, Code a ~ '[ hash ': range ': rest],-     DynamoScalar v1 hash, DynamoScalar v2 range)-  => QueryOpts a hash range -> D.Query+queryCmd :: forall a t hash range. CanQuery a t hash range => QueryOpts a hash range -> D.Query queryCmd q =     dQueryKey (Proxy :: Proxy a) (q ^. qHashKey) (q ^. qRangeCondition)                   & D.qConsistentRead . consistencyL .~ (q ^. qConsistentRead)@@ -115,7 +119,7 @@          . (D.qFilterExpression .~ Just expr)     addStartKey Nothing = id     addStartKey (Just (key, range)) =-        D.qExclusiveStartKey .~ dKeyToAttr (Proxy :: Proxy a) (key, range)+        D.qExclusiveStartKey .~ dQueryKeyToAttr (Proxy :: Proxy a) (key, range)  -- | When https://github.com/brendanhay/amazonka/issues/340 is fixed, remove newtype FixedQuery = FixedQuery D.Query@@ -143,20 +147,40 @@       lastkey = resp ^. D.srsLastEvaluatedKey  +-- | Same as 'querySource', but return data in original chunks.+querySourceChunks :: forall a t m hash range. (CanQuery a t hash range, MonadAWS m)+  => Proxy a -> QueryOpts a hash range -> Source m [a]+querySourceChunks _ q = paginate (FixedQuery (queryCmd q)) =$= CL.mapM (\res -> mapM rsDecoder (res ^. D.qrsItems))++ -- | Generic query function. You can query table or indexes that have -- a range key defined. The filter condition cannot access the hash and range keys.-querySource :: forall a t m v1 v2 hash range rest.-    (TableQuery a t, MonadAWS m, Code a ~ '[ hash ': range ': rest],-     DynamoScalar v1 hash, DynamoScalar v2 range)+querySource :: forall a t m hash range. (CanQuery a t hash range, MonadAWS m)   => Proxy a -> QueryOpts a hash range -> Source m a-querySource _ q = paginate (FixedQuery (queryCmd q)) =$= rsDecode (view D.qrsItems)+querySource p q = querySourceChunks p q =$= CL.concat +-- | Query an index, fetch primary key from the result and immediately read+-- full items from the main table.+queryOverIndex :: forall a t m v1 v2 hash r2 range rest parent.+    (CanQuery a t hash range, MonadAWS m,+     Code a ~ '[ hash ': range ': rest],+     DynamoIndex a parent 'WithRange, ContainsTableKey a parent (PrimaryKey parent r2),+     DynamoTable parent r2,+     DynamoScalar v1 hash, DynamoScalar v2 range)+  => Proxy a -> QueryOpts a hash range -> Source m parent+queryOverIndex p q =+   querySourceChunks p q =$= CL.mapFoldableM batchParent+  where+    batchParent vals = do+      let keys = map dTableKey vals+      -- TODO: it would be nice if we could paginate requests from getItemBatch downstraem+      getItemBatch (q ^. qConsistentRead) keys+ -- | Perform a simple, eventually consistent, query. -- -- Simple to use function to query limited amount of data from database.-querySimple :: forall a t v1 v2 m hash range rest.-  (TableQuery a t, MonadAWS m, Code a ~ '[ hash ': range ': rest],-   DynamoScalar v1 hash, DynamoScalar v2 range)+querySimple :: forall a t m hash range.+  (CanQuery a t hash range, MonadAWS m)   => Proxy a -- ^ Proxy type of a table to query   -> hash        -- ^ Hash key   -> Maybe (RangeOper range) -- ^ Range condition@@ -169,9 +193,8 @@   fst <$> query p opts limit  -- | Query with condition-queryCond :: forall a t v1 v2 m hash range rest.-  (TableQuery a t, MonadAWS m, Code a ~ '[ hash ': range ': rest],-   DynamoScalar v1 hash, DynamoScalar v2 range)+queryCond :: forall a t m hash range.+  (CanQuery a t hash range, MonadAWS m)   => Proxy a   -> hash        -- ^ Hash key   -> Maybe (RangeOper range) -- ^ Range condition@@ -188,13 +211,12 @@ -- | Fetch exactly the required count of items even when -- it means more calls to dynamodb. Return last evaluted key if end of data -- was not reached. Use 'qStartKey' to continue reading the query.-query :: forall a t v1 v2 m range hash rest.-  (TableQuery a t, DynamoCollection a 'WithRange t, MonadAWS m, Code a ~ '[ hash ': range ': rest],-   DynamoScalar v1 hash, DynamoScalar v2 range)+query :: forall a t m range hash.+  (CanQuery a t hash range, MonadAWS m)   => Proxy a   -> QueryOpts a hash range   -> Int -- ^ Maximum number of items to fetch-  -> m ([a], Maybe (PrimaryKey (Code a) 'WithRange))+  -> m ([a], Maybe (PrimaryKey a 'WithRange)) query _ opts limit = do     -- Add qLimit to the opts if not already there - and if there is no condition     let cmd = queryCmd (opts & addQLimit)@@ -205,14 +227,14 @@       | otherwise = id  -- | Generic query interface for scanning/querying-boundedFetch :: forall a r t m range hash cmd rest.-  (MonadAWS m, HasPrimaryKey a r t, Code a ~ '[ hash ': range ': rest], AWSRequest cmd)+boundedFetch :: forall a r t m cmd.+  (MonadAWS m, HasPrimaryKey a r t, AWSRequest cmd)   => Lens' cmd (HashMap T.Text D.AttributeValue)   -> (Rs cmd -> [HashMap T.Text D.AttributeValue])   -> (Rs cmd -> HashMap T.Text D.AttributeValue)   -> cmd   -> Int -- ^ Maximum number of items to fetch-  -> m ([a], Maybe (PrimaryKey (Code a) r))+  -> m ([a], Maybe (PrimaryKey a r)) boundedFetch startLens rsResult rsLast startcmd limit = do       (result, nextcmd) <- unfoldLimit fetch startcmd limit       if | length result > limit ->@@ -231,6 +253,7 @@             newquery = bool (Just (cmd & startLens .~ lastkey)) Nothing (null lastkey)         return (items, newquery) +-- | Run command as long as Maybe cmd is Just or the resulting sequence is smaller than limit unfoldLimit :: Monad m => (cmd -> m (Seq a, Maybe cmd)) -> cmd -> Int -> m (Seq a, Maybe cmd) unfoldLimit code = go   where@@ -248,25 +271,28 @@   , _sConsistentRead :: Consistency   , _sLimit :: Maybe Natural   , _sParallel :: Maybe (Natural, Natural) -- ^ (Segment number, TotalSegments)-  , _sStartKey :: Maybe (PrimaryKey (Code a) r)+  , _sStartKey :: Maybe (PrimaryKey a r) } makeLenses ''ScanOpts scanOpts :: ScanOpts a r scanOpts = ScanOpts Nothing Eventually Nothing Nothing Nothing +-- | Conduit source for running scan; the same as 'scanSource', but return results in chunks as they come.+scanSourceChunks :: (MonadAWS m, TableScan a r t) => Proxy a -> ScanOpts a r -> Source m [a]+scanSourceChunks _ q = paginate (FixedScan (scanCmd q)) =$= CL.mapM (\res -> mapM rsDecoder (res ^. D.srsItems))+ -- | Conduit source for running a scan.-scanSource :: (MonadAWS m, TableScan a r t, HasPrimaryKey a r t, Code a ~ '[hash ': range ': xss])-  => Proxy a -> ScanOpts a r -> Source m a-scanSource _ q = paginate (FixedScan $ scanCmd q) =$= rsDecode (view D.srsItems)+scanSource :: (MonadAWS m, TableScan a r t) => Proxy a -> ScanOpts a r -> Source m a+scanSource p q = scanSourceChunks p q =$= CL.concat  -- | Function to call bounded scans. Tries to return exactly requested number of items. -- -- Use 'sStartKey' to continue the scan.-scan :: (MonadAWS m, Code a ~ '[ hash ': range ': rest], TableScan a r t, HasPrimaryKey a r t)+scan :: (MonadAWS m, TableScan a r t)   => Proxy a   -> ScanOpts a r  -- ^ Scan settings   -> Int  -- ^ Required result count-  -> m ([a], Maybe (PrimaryKey (Code a) r)) -- ^ list of results, lastEvalutedKey or Nothing if end of data reached+  -> m ([a], Maybe (PrimaryKey a r)) -- ^ list of results, lastEvalutedKey or Nothing if end of data reached scan _ opts limit = do     let cmd = scanCmd (opts & addSLimit)     boundedFetch D.sExclusiveStartKey (view D.srsItems) (view D.srsLastEvaluatedKey) cmd limit@@ -276,10 +302,8 @@       | Nothing <- opts ^. sLimit, Nothing <- opts ^. sFilterCondition = sLimit .~ Just (fromIntegral limit)       | otherwise = id --- | Generate a "D.Query" object-scanCmd :: forall a r t hash range xss.-    (TableScan a r t, HasPrimaryKey a r t, Code a ~ '[hash ': range ': xss])-  => ScanOpts a r -> D.Scan+-- | Generate a "D.Query" object.+scanCmd :: forall a r t. TableScan a r t => ScanOpts a r -> D.Scan scanCmd q =     dScan (Proxy :: Proxy a)         & D.sConsistentRead . consistencyL .~ (q ^. sConsistentRead)@@ -308,10 +332,35 @@ -- | Scan table using a given filter condition. -- -- > scanCond (colAddress <!:> "Home" <.> colCity ==. "London") 10-scanCond :: forall a m hash range rest r t.-    (MonadAWS m, HasPrimaryKey a r t, Code a ~ '[ hash ': range ': rest], TableScan a r t)-    => Proxy a -> FilterCondition a -> Int -> m [a]+scanCond :: forall a m r t. (MonadAWS m, TableScan a r t) => Proxy a -> FilterCondition a -> Int -> m [a] scanCond _ cond limit = do   let opts = scanOpts & sFilterCondition .~ Just cond       cmd = scanCmd opts   fst <$> boundedFetch D.sExclusiveStartKey (view D.srsItems) (view D.srsLastEvaluatedKey) cmd limit++-- | Conduit to do a left join on the items being sent; supposed to be used with querySourceChunks.+--+-- The 'foreign key' must have an 'Ord' to facilitate faster searching.+leftJoin :: forall a b m r.+    (MonadAWS m, DynamoTable a r, Ord (PrimaryKey a r), ContainsTableKey a a (PrimaryKey a r))+    => Consistency+    -> Proxy a -- ^ Proxy type for the right table+    -> (b -> Maybe (PrimaryKey a r))+    -> Conduit [b] m [(b, Maybe a)]+leftJoin consistency p getkey = CL.mapM doJoin+  where+    doJoin input = do+      let keys = filter (dKeyIsDefined p) $ mapMaybe getkey input+      rightTbl <- getItemBatch consistency keys+      let resultMap = Map.fromList $ map (\res -> (dTableKey res,res)) rightTbl+      return $ map (second (id >=> (`Map.lookup` resultMap))) $ zip input $ map getkey input++-- | The same as 'leftJoin', but discard items that do not exist in the right table.+innerJoin :: forall a b m r.+    (MonadAWS m, DynamoTable a r, Ord (PrimaryKey a r), ContainsTableKey a a (PrimaryKey a r))+    => Consistency+    -> Proxy a -- ^ Proxy type for the right table+    -> (b -> Maybe (PrimaryKey a r))+    -> Conduit [b] m [(b, a)]+innerJoin consistency p getkey =+    leftJoin consistency p getkey =$= CL.map (mapMaybe (sequenceOf _2))

@@ -28,8 +28,8 @@   , RangeType(..) ) where -import           Control.Lens                    (ix, over, (.~), (^.), _1, view)-import           Control.Monad                   (forM_, when)+import           Control.Lens                    (ix, over, (.~), (^.), _1, view, (^..))+import           Control.Monad                   (forM_, unless, when) import           Control.Monad.Trans.Class       (lift) import           Control.Monad.Trans.Writer.Lazy (WriterT, execWriterT, tell) import           Data.Bool                       (bool)@@ -51,6 +51,7 @@ import           Database.DynamoDB.Internal import           Database.DynamoDB.THLens import           Database.DynamoDB.THContains+import           Database.DynamoDB.THConvert  -- | Configuration of TH macro for creating table instances data TableConfig = TableConfig {@@ -91,8 +92,8 @@ -- -- Example of what gets created: ----- > data Test { first :: Text, second :: Text, third :: Int }--- > data TestIndex { third :: Int, second :: T.Text}+-- > data Test { _first :: Text, _second :: Text, _third :: Int }+-- > data TestIndex { u_third :: Int, i_second :: T.Text} -- > -- > mkTableDefs (tableConfig (''Test, WithRange) [(''TestIndex, NoRange)] []) -- >@@ -115,6 +116,11 @@ -- > instance InCollection P_Second TestIndex 'FullPath -- For every non-primary attribute -- > first' :: Column Text TypColumn P_First -- > first' = Column+-- > -- Polymorphic lenses+-- > class Test_lens_first a b | a -> b where+-- >    first :: Functor f => (a -> f b) -> a -> f b+-- > instance Test_lens_first TestIndex Text where+-- >    first = ... mkTableDefs ::     String -- ^ Name of the migration function   -> TableConfig@@ -163,8 +169,11 @@         createPolyLenses translateField table (map (view _1) allindexes)     -- Create ContainsTableKey instances to easily extract     let pkey = map fst $ take (pkeySize tblrange) tblFieldNames-    forM_ (table : map (\(a,_,_) -> a) allindexes) $+    forM_ (table : (allindexes ^.. traverse . _1)) $         createContainsTableKey translateField table pkey+    -- Create toTable instances/classes+    unless (null allindexes) $+        createTableConversions translateField table (allindexes ^.. traverse . _1)  pkeySize :: RangeType -> Int pkeySize WithRange = 2@@ -320,12 +329,14 @@ -- -- * Table by default equals name of the type. -- * Attribute names in an index table must be the same as attribute names in the main table---   (translateField tableFieldName == translateField indexFieldName)+--   (translateField tableFieldName == translateField indexFieldName). -- * Attribute name is a field name from a first underscore ('tId'). This should make it compatibile with lens. -- * Column name is an attribute name with appended tick: tId'--- * Predefined proxies starting with "t" for tables and "i" for indexes (e.g. 'tTest', 'iTestIndex')--- * Polymorphic lens to access fields in both tables and indexes--- * Auxiliary datatype for column is P_ followed by capitalized attribute name ('P_TId')+-- * Predefined proxies starting with "t" for tables and "i" for indexes (e.g. 'tTest', 'iTestIndex').+-- * Polymorphic lens to access fields in both tables and indexes.+-- * For indexes with the same dataset as the base table, the conversion function (e.g. 'toTest')+--   gets created for easy conversion between index and base type.+-- * Auxiliary datatype for column is P_ followed by capitalized attribute name ('P_TId'). -- -- @ -- data Test = Test {

@@ -2,13 +2,13 @@ module Database.DynamoDB.THContains where  import           Control.Monad.Trans.Class       (lift)-import Data.List (find)-import Language.Haskell.TH-import Data.Function ((&)) import           Control.Monad.Trans.Writer.Lazy (WriterT, tell)+import           Data.Function                   ((&))+import           Data.List                       (find)+import           Language.Haskell.TH -import Database.DynamoDB.THLens (getFieldNames, whenJust)-import Database.DynamoDB.Class (ContainsTableKey(..))+import           Database.DynamoDB.Class         (ContainsTableKey (..))+import           Database.DynamoDB.THLens        (getFieldNames, whenJust)  -- | Create ContainsTableKey instance createContainsTableKey :: (String -> String) -> Name -> [String] -> Name -> WriterT [Dec] Q ()

@@ -0,0 +1,68 @@+{-# LANGUAGE CPP             #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE LambdaCase #-}++-- | Module generating 'toTable' class/instance for converting from index to main table type+module Database.DynamoDB.THConvert (+  createTableConversions+) where++import           Control.Monad                   (replicateM, when)+import           Control.Monad.Trans.Class       (lift)+import           Control.Monad.Trans.Writer.Lazy (WriterT, pass)+import           Data.List                       (elemIndex, sort)+import           Data.Monoid                     ((<>))+import           Language.Haskell.TH++import           Database.DynamoDB.THLens        (getFieldNames, say)++getConstructor :: Name -> Q Name+getConstructor tbl = do+    info <- reify tbl+    case info of+#if __GLASGOW_HASKELL__ >= 800+        (TyConI (DataD _ _ _ _ [RecC name _] _)) -> return name+#else+        (TyConI (DataD _ _ _ [RecC name _] _)) -> return name+#endif+        _ -> fail "not a record declaration with 1 constructor"++-- | Create function that converts complete structure from index back to table.+--+-- DynamoDB limits total number of attribute projections to 20, so this may+-- not be as useful as it appears.+createTableConversions :: (String -> String) -> Name -> [Name] -> WriterT [Dec] Q ()+createTableConversions translate table idxes = do+    tblFields <- getFieldNames table translate+    tblConstr <- lift $ getConstructor table+    clsname <- lift $ newName $ "IndexToTable_" <> nameBase tblConstr+    a <- lift $ newName "a"+    let clsdef = ClassD [] clsname [PlainTV a] [] [SigD funcname (AppT (AppT ArrowT (VarT a)) (ConT table))]+    let instth = mapM_ (mkInstance tblFields tblConstr clsname) idxes+    -- Create a typeclass only if something got created+    pass (instth >> return ((), \case {[] -> []; lst -> clsdef:lst}))+  where+    funcname = mkName ("to" <> nameBase table)++    mkInstance tblFields tblConstr clsname idxname = do+        let tblNames = map fst tblFields+        idxFields <- getFieldNames idxname translate+        let idxNames = map fst idxFields+        idxConstr <- lift $ getConstructor idxname++        when (sort tblNames == sort idxNames) $+          case mapM (`elemIndex` idxNames) tblNames of+              Nothing -> return ()+              Just varidxmap -> do+                  varnames <- lift $ replicateM (length idxNames) (newName "a")+                  let ivars = map varP varnames+                  let toJust = zipWith makeJust (map snd tblFields) (map (snd . (idxFields !!)) varidxmap)+                      olist = zipWith ($) toJust $ map (varnames !!) varidxmap+                      ovars = foldl appE (conE tblConstr) olist+                  let func = funD funcname [clause [conP idxConstr ivars] (normalB ovars) []]+                  lift (instanceD (pure []) (appT (conT clsname) (conT idxname))+                        [func]) >>= say++    makeJust (AppT (ConT mbtype) dsttype) srctype+        | mbtype == ''Maybe && dsttype == srctype = appE (conE 'Just) . varE+    makeJust _ _ = varE

@@ -59,6 +59,7 @@                                               attributeValue) import qualified Network.AWS.DynamoDB.Types  as D import           Text.Read                   (readMaybe)+import Data.Int (Int16, Int32, Int64)   -- | Exceptions thrown by some dynamodb-simple actions.@@ -110,7 +111,7 @@ -- > instance DynamoScalar Network.AWS.DynamoDB.Types.S T.Text where -- >    scalarEncode = ScS -- >    scalarDecode (ScS txt) = Just txt-class (ScalarAuto v, DynamoEncodable a) => DynamoScalar (v :: D.ScalarAttributeType) a | a -> v where+class ScalarAuto v => DynamoScalar (v :: D.ScalarAttributeType) a | a -> v where   -- | Scalars must have total encoding function   scalarEncode :: a -> ScalarValue v   default scalarEncode :: (Show a, Read a) => a -> ScalarValue 'D.S@@ -130,13 +131,22 @@ instance DynamoScalar 'D.N Int where   scalarEncode = ScN . fromIntegral   scalarDecode (ScN num) = toBoundedInteger num+instance DynamoScalar 'D.N Int16 where+  scalarEncode = ScN . fromIntegral+  scalarDecode (ScN num) = toBoundedInteger num+instance DynamoScalar 'D.N Int32 where+  scalarEncode = ScN . fromIntegral+  scalarDecode (ScN num) = toBoundedInteger num+instance DynamoScalar 'D.N Int64 where+  scalarEncode = ScN . fromIntegral+  scalarDecode (ScN num) = toBoundedInteger num  instance DynamoScalar 'D.N Word where   scalarEncode = ScN . fromIntegral   scalarDecode (ScN num) = toBoundedInteger num  -- | Helper for tagged values-instance DynamoScalar v a => DynamoScalar v (Tagged x a) where+instance {-# OVERLAPPABLE #-} DynamoScalar v a => DynamoScalar v (Tagged x a) where   scalarEncode = scalarEncode . unTagged   scalarDecode a = Tagged <$> scalarDecode a @@ -174,6 +184,7 @@   dDecode Nothing = Nothing   -- | Aid for searching for empty list and hashmap; these can be represented   -- both by empty list and by missing value, if this returns true, enhance search.+  -- Also used by joins to weed out empty foreign keys   dIsMissing :: a -> Bool   dIsMissing _ = False @@ -193,6 +204,18 @@   dEncode = Just . dScalarEncode   dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8   dDecode Nothing = Nothing -- Fail on missing attr+instance DynamoEncodable Int16 where+  dEncode = Just . dScalarEncode+  dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8+  dDecode Nothing = Nothing -- Fail on missing attr+instance DynamoEncodable Int32 where+  dEncode = Just . dScalarEncode+  dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8+  dDecode Nothing = Nothing -- Fail on missing attr+instance DynamoEncodable Int64 where+  dEncode = Just . dScalarEncode+  dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8+  dDecode Nothing = Nothing -- Fail on missing attr instance DynamoEncodable Double where   dEncode num = Just $ attributeValue & D.avN .~ (Just $ toShortest num)   dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8@@ -208,11 +231,15 @@     | Just True <- attr ^. D.avNULL = Just ""     | otherwise = attr ^. D.avS   dDecode Nothing = Just ""+  dIsMissing "" = True+  dIsMissing _ = False instance DynamoEncodable BS.ByteString where   dEncode "" = Nothing   dEncode bs = Just (dScalarEncode bs)   dDecode (Just attr) = attr ^. D.avB   dDecode Nothing = Just ""+  dIsMissing "" = True+  dIsMissing _ = False  -- | 'Maybe' ('Maybe' a) will not work well; it will 'join' the value in the database. instance DynamoEncodable a => DynamoEncodable (Maybe a) where@@ -220,6 +247,8 @@   dEncode (Just key) = dEncode key   dDecode Nothing = Just Nothing   dDecode (Just attr) = Just <$> dDecode (Just attr)+  dIsMissing Nothing = True+  dIsMissing _ = False instance (Ord a, DynamoScalar v a) => DynamoEncodable (Set.Set a) where   dEncode (Set.null -> True) = Nothing   dEncode dta = Just $ dSetEncode dta@@ -241,7 +270,7 @@   dDecode Nothing = Just mempty   dIsMissing = null -instance DynamoEncodable a => DynamoEncodable (Tagged v a) where+instance {-# OVERLAPPABLE #-} DynamoEncodable a => DynamoEncodable (Tagged v a) where   dEncode = dEncode . unTagged   dDecode a = Tagged <$> dDecode a   dIsMissing = dIsMissing . unTagged

@@ -44,6 +44,12 @@ } deriving (Show, Eq, Ord) mkTableDefs "migrateTest" (tableConfig (''Test, WithRange) [] []) +data TestSecond = TestSecond {+    tHashKey :: T.Text+  , tInt :: Int+} deriving (Show, Eq)+mkTableDefs "migrateTest2" (tableConfig (''TestSecond, NoRange) [] [])+ withDb :: Example (IO b) => String -> AWS b -> SpecWith (Arg (IO b)) withDb msg code = it msg runcode   where@@ -58,6 +64,7 @@       runResourceT $ runAWS newenv $ do           deleteTable (Proxy :: Proxy Test) `catchAny` (\_ -> return ())           migrateTest mempty Nothing+          migrateTest2 mempty Nothing           code `finally` deleteTable (Proxy :: Proxy Test)  spec :: Spec@@ -68,8 +75,8 @@             testitem2 = Test "2" 3 "text" False 4.15 3 (Just "text")         putItem testitem1         putItem testitem2-        it1 <- getItem Strongly (tTest, ("1", 2))-        it2 <- getItem Strongly (tTest, ("2", 3))+        it1 <- getItem Strongly tTest ("1", 2)+        it2 <- getItem Strongly tTest ("2", 3)         liftIO $ Just testitem1 `shouldBe` it1         liftIO $ Just testitem2 `shouldBe` it2     withDb "getItemBatch/putItemBatch work" $ do@@ -77,7 +84,7 @@             newItems = map template [1..300]         putItemBatch newItems         ---        let keys = map (snd . tableKey) newItems+        let keys = map tableKey newItems         items <- getItemBatch Strongly keys         liftIO $ sort items `shouldBe` sort newItems     withDb "insertItem doesn't overwrite items" $ do@@ -154,9 +161,9 @@     withDb "updateItemByKey works" $ do         let testitem1 = Test "1" 2 "text" False 3.14 2 (Just "something")         putItem testitem1-        new1 <- updateItemByKey (tableKey testitem1)+        new1 <- updateItemByKey tTest (tableKey testitem1)                                 ((iInt' +=. 5) <> (iText' =. "updated") <> (iMText' =. Nothing))-        Just new2 <- getItem Strongly (tableKey testitem1)+        Just new2 <- getItem Strongly tTest (tableKey testitem1)         liftIO $ do             new1 `shouldBe` new2             iInt new1 `shouldBe` 7@@ -166,8 +173,8 @@     withDb "update fails on non-existing item" $ do         let testitem1 = Test "1" 2 "text" False 3.14 2 (Just "something")         putItem testitem1-        updateItemByKey_ (tTest, ("1", 2)) (iBool' =. True)-        (res :: Either SomeException ()) <- try $ updateItemByKey_ (tTest, ("2", 3)) (iBool' =. True)+        updateItemByKey_ tTest ("1", 2) (iBool' =. True)+        (res :: Either SomeException ()) <- try $ updateItemByKey_ tTest ("2", 3) (iBool' =. True)         liftIO $ res `shouldSatisfy` isLeft      withDb "scan continuation works" $ do@@ -198,12 +205,28 @@         putItem testitem1         putItem testitem2         (items, _) <- scan tTest scanOpts 10-        deleteItemByKey (tableKey testitem1)-        deleteItemByKey (tableKey testitem2)+        deleteItemByKey tTest (tableKey testitem1)+        deleteItemByKey tTest (tableKey testitem2)         (items2, _) <- scan tTest scanOpts 10         liftIO $ do           length items `shouldBe` 2           length items2 `shouldBe` 0++    withDb "test left join" $ do+        let testitem1 = Test "1" 2 "" False 3.14 2 Nothing+        let testitem2 = Test "1" 3 "aaa" False 3.14 2 (Just "aaa")+        let testsecond = TestSecond "aaa" 3+        putItem testitem1+        putItem testitem2+        putItem testsecond+        res <- runConduit $ querySourceChunks tTest (queryOpts "1")+                              =$= leftJoin Strongly tTestSecond (Just . iText)+                              =$= CL.concat =$= CL.consume+        liftIO $ res `shouldBe` [(testitem1, Nothing), (testitem2, Just testsecond)]+        res2 <- runConduit $ querySourceChunks tTest (queryOpts "1")+                              =$= leftJoin Strongly tTestSecond iMText+                              =$= CL.concat =$= CL.consume+        liftIO $ res2 `shouldBe` [(testitem1, Nothing), (testitem2, Just testsecond)]   main :: IO ()

@@ -14,7 +14,7 @@  import           Control.Exception.Safe   (catchAny, finally) import           Control.Monad.IO.Class   (liftIO)-import           Control.Lens             (set, makeLenses, (^.), (^?), ix, (^..))+import           Control.Lens             (makeLenses, (^.), (^?), ix, (^..)) import           Data.Function            ((&)) import           Data.Hashable import           Data.HashMap.Strict      (HashMap)@@ -83,8 +83,8 @@             testitem2 = Test "hash" 2 inner1 Nothing Set.empty [] HMap.empty         putItem testitem1         putItem testitem2-        Just ritem1 <- getItem Strongly (tTest, ("hash", 1))-        Just ritem2 <- getItem Strongly (tTest, ("hash", 2))+        Just ritem1 <- getItem Strongly tTest ("hash", 1)+        Just ritem2 <- getItem Strongly tTest ("hash", 2)         liftIO $ testitem1 `shouldBe` ritem1         liftIO $ testitem2 `shouldBe` ritem2     withDb "Scan conditions" $ do@@ -124,23 +124,23 @@         putItem testitem1         putItem testitem2         ---        newitem1 <- updateItemByKey (tableKey testitem1) (iInner' <.> nFirst' =. "updated")+        newitem1 <- updateItemByKey tTest (tableKey testitem1) (iInner' <.> nFirst' =. "updated")         liftIO $ newitem1 ^. iInner . nFirst `shouldBe` "updated"         ---        newitem2 <- updateItemByKey (tableKey testitem1) (add iSet' (Set.singleton (Tagged "test2")))+        newitem2 <- updateItemByKey tTest (tableKey testitem1) (add iSet' (Set.singleton (Tagged "test2")))         liftIO $ newitem2 ^. iSet `shouldBe` Set.fromList [Tagged "test", Tagged "test2"]         ---        newitem3 <- updateItemByKey (tableKey testitem1) (prepend iList' [inner2, inner1])+        newitem3 <- updateItemByKey tTest (tableKey testitem1) (prepend iList' [inner2, inner1])         liftIO $ newitem3 ^. iList `shouldBe` [inner2, inner1, inner1]         ---        newitem4 <- updateItemByKey (tableKey testitem1) (delListItem iList' 1)+        newitem4 <- updateItemByKey tTest (tableKey testitem1) (delListItem iList' 1)         liftIO $ newitem4 ^. iList `shouldBe` [inner2, inner1]         ---        newitem5 <- updateItemByKey (tableKey testitem2) (iMap' <!:> Tagged "test" =. inner1)+        newitem5 <- updateItemByKey tTest (tableKey testitem2) (iMap' <!:> Tagged "test" =. inner1)         liftIO $ newitem5 ^.. iMap . traverse `shouldBe` [inner1]         liftIO $ newitem5 ^? iMap . ix (Tagged "test")  `shouldBe` Just inner1         ---        newitem6 <- updateItemByKey (tableKey testitem2) (delHashKey iMap' (Tagged "test"))+        newitem6 <- updateItemByKey tTest (tableKey testitem2) (delHashKey iMap' (Tagged "test"))         liftIO $ newitem6 ^. iMap `shouldBe` HMap.empty