dynamodb-simple 0.1.0.0 → 0.2.0.0

raw patch · 15 files changed

+417/−186 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +7/−12
• changelog.md +7/−0
• dynamodb-simple.cabal +4/−3
• src/Database/DynamoDB.hs +55/−12
• src/Database/DynamoDB/Class.hs +14/−8
• src/Database/DynamoDB/Filter.hs +5/−1
• src/Database/DynamoDB/Internal.hs +12/−6
• src/Database/DynamoDB/QueryRequest.hs +76/−46
• src/Database/DynamoDB/TH.hs +58/−49
• src/Database/DynamoDB/THContains.hs +31/−0
• src/Database/DynamoDB/THLens.hs +90/−0
• src/Database/DynamoDB/Types.hs +3/−0
• src/Database/DynamoDB/Update.hs +6/−1
• test/BaseSpec.hs +33/−32
• test/NestedSpec.hs +16/−16

@@ -14,7 +14,7 @@   , subject  :: T.Text   , replies  :: Int } deriving (Show)--- Generate instances and colCategory, colUser etc. variables for queries/updates+-- Generate instances and category', user' etc. variables for queries/updates mkTableDefs "migrate" (tableConfig (''Test, WithRange) [] [])  test :: IO ()@@ -30,10 +30,10 @@       --       putItem (Test "news" "john" "test" 20)       ---      (item :: Maybe Test) <- getItem Eventually ("news", "john")+      item <- getItem Eventually (tTest, ("news", "john"))       liftIO $ print item       ---      (items :: [Test]) <- scanCond (colReplies >. 15) 10+      items <- scanCond tTest (replies' >. 15) 10       liftIO $ print items ```` ### Features@@ -42,6 +42,7 @@ - Local secondary indexes. - Tables with only hash keys as well as tables with combined hash and sort key. - Sparse indexes (define the column as `Maybe` in a table, omit the `Maybe` in index definition).+- Automatically generate polymorphic lenses to access fields in main table and index records. - Standard datatypes including `Tagged` and basic default instances for data types supporting   `Show/Read`. - New types can be added easily.@@ -64,7 +65,7 @@ ### Limitations  - Projections are not supported. Using some generic programming on tuples it should be possible.-- You cannot compare attributes between themselves (i.e. `colCurrentAccount >=. colAverageAccount`).+- You cannot compare attributes between themselves (i.e. `currentAccount' >=. averageAccount'`).   I'm not sure this would be currently technically possible. Does anybody need it?  ### Handling of NULLs@@ -79,8 +80,8 @@ * `HashMap Text (Maybe a)` is not a good idea; missing values will disappear. * `Maybe (Set a)` will become `Nothing` on empty set * Don't try to use inequality comparisons (`>.`, `<.`) on empty strings.-* If you use `colMaybeCol == Nothing`, it gets internally replaced-  by `attr_missing(colMaybeCol)`, so it will behave as expected. The same with+* If you use `maybeCol' == Nothing`, it gets internally replaced+  by `attr_missing(maybeCol)`, so it will behave as expected. The same with   empty `String` or `Set`. Keep that in mind when traversing nested structures. * In case of schema change, `Maybe` columns are considered `Nothing`. * In case of schema change, `String` columns are decoded as empty strings, `Set` columns@@ -89,9 +90,3 @@   (i.e. after schema change). * Empty list/empty hashmap is represented as empty list/hashmap; however it is allowed to be decoded   even when the attribute is missing in order to allow better schema migrations.--### Notes--There is a bug in `amazonka-dynamodb` that causes the `Conduit`-based queries/scans not behave correctly-under certain circumstances. It's also why the travis CI build of dynamodb-simple is failing-right now.

@@ -0,0 +1,7 @@+# 0.2.0.0++- Changed API to always include a `Proxy`+- Added proxy generation (`tTable`, `iTableIndex`)+- Added polymorphic lenses for fields starting with underscore+- Changed generated column names from `colColumn` to `column'`+- Overriden buggy amazonka paging

@@ -1,5 +1,5 @@ name:                dynamodb-simple-version:             0.1.0.0+version:             0.2.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.@@ -12,7 +12,7 @@ bug-reports:         https://github.com/ondrap/dynamodb-simple/issues category:            Database build-type:          Simple-extra-source-files:  README.md+extra-source-files:  README.md changelog.md cabal-version:       >=1.10  source-repository head@@ -25,7 +25,8 @@                        Database.DynamoDB.Update   other-modules:       Database.DynamoDB.Class, Database.DynamoDB.Migration,                        Database.DynamoDB.Internal, Database.DynamoDB.BatchRequest,-                       Database.DynamoDB.QueryRequest+                       Database.DynamoDB.QueryRequest, Database.DynamoDB.THLens,+                       Database.DynamoDB.THContains   build-depends:       base >=4.8 && <5, amazonka-dynamodb, generics-sop,                        unordered-containers, text, lens, double-conversion,                        semigroups, bytestring, containers, monad-supply,

@@ -20,6 +20,12 @@     -- * Introduction     -- $intro +    -- * Proxies+    -- $proxy++    -- * Lens support+    -- $lens+     -- * Data types     DynamoException(..)   , Consistency(..)@@ -62,7 +68,7 @@     -- * Delete table   , deleteTable     -- * Utility functions-  , itemToKey+  , tableKey ) where  import           Control.Lens                        ((%~), (.~), (^.))@@ -119,9 +125,9 @@ -- | 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 -> PrimaryKey (Code a) r -> m (Maybe a)-getItem consistency key = do-  let cmd = dGetItem (Proxy :: Proxy a) key & D.giConsistentRead . consistencyL .~ consistency+    => Consistency -> (Proxy a, PrimaryKey (Code 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@@ -156,7 +162,7 @@ dUpdateItem p pkey actions mcond =     genAction <$> dumpActions actions   where-    keyfields = primaryFields (Proxy :: Proxy a)+    keyfields = primaryFields p         -- Create condition attribute_exists(hash_key)     pkeyExists = (AttrExists . nameGenPath . pure . IntraName) (head keyfields) @@ -197,7 +203,7 @@             Just res -> return res             Nothing -> throwM (DynamoException $ "Cannot decode item: " <> T.pack (show rs))   | otherwise = do-      rs <- getItem Strongly pkey+      rs <- getItem Strongly (p, pkey)       case rs of           Just res -> return res           Nothing -> throwM (DynamoException "Cannot decode item.")@@ -216,9 +222,11 @@  -- | Extract primary key from a record in a form that can be directly used by other functions. ----- TODO: this should be callable on index structures containing primary key as well-itemToKey :: (HasPrimaryKey a r t, Code a ~ '[hash ': range ': xss]) => a -> (Proxy a, PrimaryKey (Code a) r)-itemToKey a = (Proxy, dItemToKey a)+-- 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)  -- $intro --@@ -268,10 +276,45 @@ --        -- Save data to database --        putItem (Test "news" "1-2-3-4" "New subject") --        -- Fetch data given primary key---        (item :: Maybe Test) <- getItem Eventually ("news", "1-2-3-4")---        liftIO $ print item+--        item <- getItem Eventually (tTest, ("news", "1-2-3-4"))+--        liftIO $ print item       -- (item :: Maybe Test) --        -- Scan data using filter condition, return 10 results---        (items :: [Test]) <- scanCond (colSubject ==. "New subejct") 10+--        items <- scanCond tTest (subject' ==. "New subejct") 10+--        print items         -- (items :: [Test]) -- @ -- -- See examples/ and test/ directories for more detail examples.++-- $proxy+--+-- In order to avoid ambiguity errors, most API calls need a 'Proxy' argument+-- to find out on which table or index to operate. These proxies are automatically+-- generated as a name of type prepended with "t" for tables and "i" for indexes.+--+-- A proxy for table Test will have name tTest, for index TestIndex the name will+-- be iTestIndex.++-- $lens+--+-- If the field names in the table record start with an underscore, the lens+-- get automatically generated for accessing the fields. The lens are polymorphic,+-- you can use them to access the fields of both main table and all the indexes.+--+-- @+-- data Test = Test {+--     _messageid :: T.Text+--   , _category :: T.Text+--   , _subject :: T.Text+-- } deriving (Show)+-- data TestIndex = TestIndex {+--     _category :: T.Text+--   , _messageid :: T.Text+-- }+-- mkTableDefs "migrate" (tableConfig (''Test, WithRange) [(''TestIndex, NoRange)] [])+--+-- doWithTest :: Test -> ...+-- doWithTest item = (item ^. category) ...+--+-- doWithItemIdx :: TestIndex -> ..+-- getCategoryIdx item = (item ^. category) ...+-- @

@@ -1,6 +1,9 @@+{-# LANGUAGE CPP                    #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -- We have lots of pattern matching for allFieldNames, that is correct because of TH-{-# LANGUAGE CPP                    #-} {-# LANGUAGE DataKinds              #-} {-# LANGUAGE DefaultSignatures      #-} {-# LANGUAGE FlexibleContexts       #-}@@ -39,6 +42,7 @@   , IndexCreate(..)   , HasPrimaryKey(..)   , createLocalIndex+  , ContainsTableKey(..) ) where  import           Control.Lens                     ((.~), sequenceOf, _2)@@ -178,6 +182,10 @@       => IndexCreate a p 'WithRange where   createGlobalIndex = defaultCreateGlobalIndexRange +class ContainsTableKey a parent key | a -> parent key where+  -- | Extract table primary key from an item, if possible+  dTableKey :: a -> key+ -- | Return first field of a datatype gdFirstField :: forall a hash rest. (Generic a, Code a ~ '[ hash ': rest ]) => a -> hash gdFirstField item = firstField (from item)@@ -314,19 +322,17 @@     parentKey = primaryFields (Proxy :: Proxy parent)     attrlist = filter (`notElem` (parentKey ++ [hashname, rangename])) $ allFieldNames (Proxy :: Proxy a) -defaultCreateGlobalIndexRange :: forall a parent r2 hash rest xs rest2 range v1 v2.-  (DynamoIndex a parent 'WithRange, DynamoTable parent r2, Code parent ~ '[ xs ': rest2 ],-    Code a ~ '[hash ': range ': rest ],-    DynamoScalar v1 hash, DynamoScalar v2 range) =>+defaultCreateGlobalIndexRange :: forall a parent r2 hash rest range v1 v2.+  (DynamoIndex a parent 'WithRange, DynamoTable parent r2,+    Code a ~ '[hash ': range ': rest ], DynamoScalar v1 hash, DynamoScalar v2 range) =>   Proxy a -> ProvisionedThroughput -> (D.GlobalSecondaryIndex, [D.AttributeDefinition]) defaultCreateGlobalIndexRange p thr =     (globalSecondaryIndex (indexName p) keyschema proj thr, attrdefs)   where     (keyschema, proj, attrdefs) = mkIndexHelper p -createLocalIndex :: forall a parent r2 hash rest xs rest2 range v1 v2.-  (DynamoIndex a parent 'WithRange, DynamoTable parent r2, Code parent ~ '[ xs ': rest2 ],-    Code a ~ '[hash ': range ': rest ],+createLocalIndex :: forall a parent r2 hash rest range v1 v2.+  (DynamoIndex a parent 'WithRange, DynamoTable parent r2, Code a ~ '[hash ': range ': rest ],     DynamoScalar v1 hash, DynamoScalar v2 range) =>   Proxy a -> (D.LocalSecondaryIndex, [D.AttributeDefinition]) createLocalIndex p =

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif {-# LANGUAGE DataKinds           #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE GADTs               #-}@@ -8,7 +12,7 @@ -- -- Example as used in nested structure for scan: ----- > scanCond (colCtvrty <!:> "a" <.> colInTreti <.> colInnPrvni ==. "x") 20+-- > scanCond (hashitem' <!:> "a" <.> author' <.> name' ==. "x") 20 module Database.DynamoDB.Filter (       -- * Condition datatype       FilterCondition(Not)

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP                   #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif {-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-}@@ -27,10 +31,12 @@ import           Database.DynamoDB.Types  data ColumnType = TypColumn | TypSize+ -- | Representation of a column for filter queries--- typ - datatype of column (Int, Text..)--- coltype - TypColumn or TypSize (result of size(column))--- col - instance of ColumnInfo, uniquely identify a column+--+-- - typ - datatype of column (Int, Text..)+-- - coltype - TypColumn or TypSize (result of size(column))+-- - col - instance of ColumnInfo, uniquely identify a column data Column typ (coltype :: ColumnType) col where     Column :: NonEmpty IntraColName -> Column typ 'TypColumn col     Size :: NonEmpty IntraColName -> Column Int 'TypSize col@@ -196,7 +202,7 @@  -- | Combine attributes from nested structures. ----- > colAddress <.> colStreet+-- > address' <.> street' (<.>) :: (InCollection col2 (UnMaybe typ) 'NestedPath)       => Column typ 'TypColumn col1 -> Column typ2 'TypColumn col2 -> Column typ2 'TypColumn col1 (<.>) (Column a1) (Column a2) = Column (a1 <> a2)@@ -207,14 +213,14 @@  -- | Access an index in a nested list. ----- > colUsers <!> 0 <.> colName+-- > users' <!> 0 <.> name' (<!>) :: Column [typ] 'TypColumn col -> Int -> Column typ 'TypColumn col (<!>) (Column a1) num = Column (a1 <> pure (IntraIndex num)) infixl 8 <!>  -- | Access a key in a nested hashmap. ----- > colPhones <!:> "mobile" <.> colNumber+-- > phones' <!:> "mobile" <.> number' (<!:>) :: IsText key => Column (HashMap key typ) 'TypColumn col -> key -> Column typ 'TypColumn col (<!:>) (Column a1) key = Column (a1 <> pure (IntraName (toText key))) infixl 8 <!:>

@@ -1,14 +1,17 @@+{-# LANGUAGE CPP                    #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif {-# LANGUAGE DataKinds           #-}+{-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE GADTs               #-}+{-# LANGUAGE MultiWayIf          #-} {-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE TypeOperators       #-} {-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE ViewPatterns        #-}-{-# LANGUAGE MultiWayIf          #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE TypeOperators       #-}  module Database.DynamoDB.QueryRequest (   -- * Query@@ -31,28 +34,29 @@ ) where  -import           Control.Arrow                   (first)-import           Control.Lens                    (view, (%~), (.~), (^.), Lens')-import           Control.Lens.TH                 (makeLenses)-import           Control.Monad.Catch             (throwM)-import           Data.Bool                       (bool)-import           Data.Conduit                    (Conduit, Source, runConduit,-                                                  (=$=))-import qualified Data.Conduit.List               as CL-import           Data.Function                   ((&))-import           Data.HashMap.Strict             (HashMap)-import           Data.Monoid                     ((<>))+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           Data.Proxy-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           Numeric.Natural                 (Natural)-import Data.Sequence (Seq)-import qualified Data.Sequence as Seq-import Data.Foldable (toList)+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.Class import           Database.DynamoDB.Filter@@ -113,15 +117,39 @@     addStartKey (Just (key, range)) =         D.qExclusiveStartKey .~ dKeyToAttr (Proxy :: Proxy a) (key, range) +-- | When https://github.com/brendanhay/amazonka/issues/340 is fixed, remove+newtype FixedQuery = FixedQuery D.Query+instance AWSRequest FixedQuery where+  type Rs FixedQuery = D.QueryResponse+  request (FixedQuery a) = coerce (request a)+  response lgr svc _ = response lgr svc (Proxy :: Proxy D.Query)+instance AWSPager FixedQuery where+  page (FixedQuery dq) resp+    | null lastkey = Nothing+    | otherwise = Just $ FixedQuery (dq & D.qExclusiveStartKey .~ lastkey)+    where+      lastkey = resp ^. D.qrsLastEvaluatedKey++newtype FixedScan = FixedScan D.Scan+instance AWSRequest FixedScan where+  type Rs FixedScan = D.ScanResponse+  request (FixedScan a) = coerce (request a)+  response lgr svc _ = response lgr svc (Proxy :: Proxy D.Scan)+instance AWSPager FixedScan where+  page (FixedScan dq) resp+    | null lastkey = Nothing+    | otherwise = Just $ FixedScan (dq & D.sExclusiveStartKey .~ lastkey)+    where+      lastkey = resp ^. D.srsLastEvaluatedKey++ -- | 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.------ Note: see https://github.com/brendanhay/amazonka/issues/340 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)-  => QueryOpts a hash range -> Source m a-querySource q = paginate (queryCmd q) =$= rsDecode (view D.qrsItems)+  => Proxy a -> QueryOpts a hash range -> Source m a+querySource _ q = paginate (FixedQuery (queryCmd q)) =$= rsDecode (view D.qrsItems)  -- | Perform a simple, eventually consistent, query. --@@ -129,31 +157,33 @@ 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)-  => hash        -- ^ Hash key+  => Proxy a -- ^ Proxy type of a table to query+  -> hash        -- ^ Hash key   -> Maybe (RangeOper range) -- ^ Range condition   -> Direction -- ^ Scan direction   -> Int -- ^ Maximum number of items to fetch   -> m [a]-querySimple key range direction limit = do+querySimple p key range direction limit = do   let opts = queryOpts key & qRangeCondition .~ range                            & qDirection .~ direction-  fst <$> query opts limit+  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)-  => hash        -- ^ Hash key+  => Proxy a+  -> hash        -- ^ Hash key   -> Maybe (RangeOper range) -- ^ Range condition   -> FilterCondition a   -> Direction -- ^ Scan direction   -> Int -- ^ Maximum number of items to fetch   -> m [a]-queryCond key range cond direction limit = do+queryCond p key range cond direction limit = do   let opts = queryOpts key & qRangeCondition .~ range                            & qDirection .~ direction                            & qFilterCondition .~ Just cond-  fst <$> query opts limit+  fst <$> query p opts limit  -- | Fetch exactly the required count of items even when -- it means more calls to dynamodb. Return last evaluted key if end of data@@ -161,10 +191,11 @@ 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)-  => QueryOpts a hash range+  => Proxy a+  -> QueryOpts a hash range   -> Int -- ^ Maximum number of items to fetch   -> m ([a], Maybe (PrimaryKey (Code a) 'WithRange))-query opts limit = do+query _ opts limit = do     -- Add qLimit to the opts if not already there - and if there is no condition     let cmd = queryCmd (opts & addQLimit)     boundedFetch D.qExclusiveStartKey (view D.qrsItems) (view D.qrsLastEvaluatedKey) cmd limit@@ -224,20 +255,19 @@ scanOpts = ScanOpts Nothing Eventually Nothing Nothing Nothing  -- | Conduit source for running a scan.------ Note: see https://github.com/brendanhay/amazonka/issues/340 scanSource :: (MonadAWS m, TableScan a r t, HasPrimaryKey a r t, Code a ~ '[hash ': range ': xss])-  => ScanOpts a r -> Source m a-scanSource q = paginate (scanCmd q) =$= rsDecode (view D.srsItems)+  => Proxy a -> ScanOpts a r -> Source m a+scanSource _ q = paginate (FixedScan $ scanCmd q) =$= rsDecode (view D.srsItems)  -- | 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)-  => ScanOpts a r  -- ^ Scan settings+  => 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-scan opts limit = do+scan _ opts limit = do     let cmd = scanCmd (opts & addSLimit)     boundedFetch D.sExclusiveStartKey (view D.srsItems) (view D.srsLastEvaluatedKey) cmd limit   where@@ -278,10 +308,10 @@ -- | Scan table using a given filter condition. -- -- > scanCond (colAddress <!:> "Home" <.> colCity ==. "London") 10--- Note: see https://github.com/brendanhay/amazonka/issues/340 scanCond :: forall a m hash range rest r t.     (MonadAWS m, HasPrimaryKey a r t, Code a ~ '[ hash ': range ': rest], TableScan a r t)-    => FilterCondition a -> Int -> m [a]-scanCond cond limit = do+    => Proxy a -> FilterCondition a -> Int -> m [a]+scanCond _ cond limit = do   let opts = scanOpts & sFilterCondition .~ Just cond-  runConduit $ scanSource opts =$= CL.take limit+      cmd = scanCmd opts+  fst <$> boundedFetch D.sExclusiveStartKey (view D.srsItems) (view D.srsLastEvaluatedKey) cmd limit

@@ -32,6 +32,7 @@ import           Control.Monad                   (forM_, when) import           Control.Monad.Trans.Class       (lift) import           Control.Monad.Trans.Writer.Lazy (WriterT, execWriterT, tell)+import           Data.Bool                       (bool) import           Data.Char                       (toUpper) import           Data.Function                   ((&)) import           Data.Monoid                     ((<>))@@ -48,6 +49,8 @@ import           Database.DynamoDB.Migration     (runMigration) import           Database.DynamoDB.Types import           Database.DynamoDB.Internal+import           Database.DynamoDB.THLens+import           Database.DynamoDB.THContains  -- | Configuration of TH macro for creating table instances data TableConfig = TableConfig {@@ -55,6 +58,7 @@   , globalIndexes :: [(Name, RangeType, String)]  -- ^ Global index type, primary key type, index name   , localIndexes :: [(Name, String)]              -- ^ Local index type, index name   , translateField :: String -> String            -- ^ Translation of haskell field names to DynamoDB attribute names+  , buildLens :: Bool                             -- ^ Builds polymorphic lens for main table and indexes for table fields starting with '_' }  -- | Simple table configuration@@ -69,6 +73,7 @@       , globalIndexes = map (\(n,r) -> (n, r, nameToStr n)) globidx       , localIndexes = map (\n -> (n, nameToStr n)) locidx       , translateField = defaultTranslate+      , buildLens = True     }   where     nameToStr (Name (OccName name) _) = name@@ -108,8 +113,8 @@ -- >     columnName _ = "first" -- > instance InCollection P_First Test 'NestedPath -- For every attribute -- > instance InCollection P_Second TestIndex 'FullPath -- For every non-primary attribute--- > colFirst :: Column Text TypColumn P_First--- > colFirst = Column+-- > first' :: Column Text TypColumn P_First+-- > first' = Column mkTableDefs ::     String -- ^ Name of the migration function   -> TableConfig@@ -119,11 +124,11 @@     let (table, tblrange, tblname) = tableSetup      tblFieldNames <- getFieldNames table translateField-    let tblHashName = fst (head tblFieldNames)     buildColData tblFieldNames     genBaseCollection table tblrange tblname Nothing translateField      -- Check, that hash key name in locindexes == hash key in primary table+    let tblHashName = fst (head tblFieldNames)     forM_ localIndexes $ \(idx, _) -> do         idxHashName <- (fst . head) <$> getFieldNames idx translateField         when (idxHashName /= tblHashName) $@@ -139,17 +144,27 @@         let pkeytable = [True | _ <- [1..(pkeySize idxrange)] ] ++ repeat False         forM_ (zip instfields pkeytable) $ \((fieldname, ltype), isKey) ->             case lookup fieldname tblFieldNames of+                -- Allow sparse index - 'Maybe a' in table, 'a' in index                 Just (AppT (ConT mbtype) inptype)-                  | mbtype == ''Maybe && inptype == ltype && isKey -> return () -- Allow sparse index - 'Maybe a' in table, 'a' in index+                  | mbtype == ''Maybe && inptype == ltype && isKey -> return ()+                -- Check if types differ                 Just ptype                   | ltype /= ptype -> fail $ "Record '" <> fieldname <> "' form index " <> show idx <> " has different type from table " <> show table                                               <> ": " <> show ltype <> " /= " <> show ptype                   | otherwise -> return ()+                -- Unknown field, does not exist in main table                 Nothing ->                   fail ("Record '" <> fieldname <> "' from index " <> show idx <> " is not in present in table " <> show table)-+    -- Create migration function     migfunc <- lift $ mkMigrationFunc migname table (map (view _1) globalIndexes) (map (view _1) localIndexes)     tell migfunc+    -- Lenses+    when buildLens $+        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) $+        createContainsTableKey translateField table pkey  pkeySize :: RangeType -> Int pkeySize WithRange = 2@@ -160,57 +175,48 @@ genBaseCollection coll collrange tblname mparent translate = do     tblFieldNames <- getFieldNames coll translate     let fieldNames = map fst tblFieldNames-    let fieldList = pure (ListE (map (AppE (VarE 'T.pack) . LitE . StringL) fieldNames))+    let fieldList = listE (map (appE (varE 'T.pack) . litE . StringL) fieldNames)     primaryList' <- case (collrange, fieldNames) of                       (NoRange, hashname:_) -> return [hashname]                       (WithRange, h:r:_)-> return [h,r]                       _ -> fail "Table must have at least 1/2 fields based on range key"-    let primaryList = pure (ListE (map (AppE (VarE 'T.pack) . LitE . StringL) primaryList'))-    let tbltype = maybe (PromotedT 'IsTable) (const $ PromotedT 'IsIndex) mparent+    let primaryList = listE (map (appE (varE 'T.pack) . litE . StringL) primaryList')+    let tbltype = maybe (promotedT 'IsTable) (const $ promotedT 'IsIndex) mparent      lift (deriveGenericOnly coll) >>= tell     lift [d|-      instance DynamoCollection $(pure (ConT coll)) $(pure (ConT $ mrange collrange)) $(pure tbltype) where+      instance DynamoCollection $(conT coll) $(conT $ mrange collrange) $(tbltype) where           allFieldNames _ = $(fieldList)           primaryFields _ = $(primaryList)       |] >>= tell     case mparent of-      Nothing ->+      Nothing -> do+         mkCollectionProxy True          lift [d|-             instance DynamoTable $(pure (ConT coll)) $(pure (ConT $ mrange collrange)) where-                tableName _ = $(pure $ AppE (VarE 'T.pack) (LitE (StringL tblname)))+             instance DynamoTable $(conT coll) $(conT $ mrange collrange) where+                tableName _ = $(appE (varE 'T.pack) (litE (StringL tblname)))               |] >>= tell-      Just parent ->+      Just parent -> do+        mkCollectionProxy False         lift [d|-            instance DynamoIndex $(pure (ConT coll)) $(pure (ConT parent)) $(pure (ConT $ mrange collrange)) where-                indexName _ = $(pure $ AppE (VarE 'T.pack) (LitE (StringL tblname)))+            instance DynamoIndex $(conT coll) $(conT parent) $(conT $ mrange collrange) where+                indexName _ = $(appE (varE 'T.pack) (litE (StringL tblname)))               |] >>= tell      -- Skip primary key, we cannot filter by it     let constrNames = mkConstrNames tblFieldNames     forM_ (drop (pkeySize collrange) constrNames) $ \constr ->       lift [d|-        instance InCollection $(pure (ConT constr)) $(pure (ConT coll)) 'FullPath+        instance InCollection $(conT constr) $(conT coll) 'FullPath         |] >>= tell   where     mrange WithRange = 'WithRange     mrange NoRange = 'NoRange+    mkCollectionProxy istable = do+        let proxyName = mkName (bool "i" "t" istable <> nameBase coll)+        say $ SigD proxyName (AppT (ConT ''Proxy) (ConT coll))+        say $ ValD (VarP proxyName) (NormalB (ConE 'Proxy)) [] --- | Reify name and return list of record fields with type-getFieldNames :: Name -> (String -> String) -> WriterT [Dec] Q [(String, Type)]-getFieldNames tbl translate = do-    info <- lift $ reify tbl-    case getRecords info of-      Left err -> fail $ "Table " <> show tbl <> ": " <> err-      Right lst -> return $ map (over _1 translate) lst-  where-    getRecords :: Info -> Either String [(String, Type)]-#if __GLASGOW_HASKELL__ >= 800-    getRecords (TyConI (DataD _ _ _ _ [RecC _ vars] _)) = Right $ map (\(Name (OccName rname) _,_,typ) -> (rname, typ)) vars-#else-    getRecords (TyConI (DataD _ _ _ [RecC _ vars] _)) = Right $ map (\(Name (OccName rname) _,_,typ) -> (rname, typ)) vars-#endif-    getRecords _ = Left "not a record declaration with 1 constructor"  toConstrName :: String -> String toConstrName = ("P_" <>) . over (ix 0) toUpper@@ -218,29 +224,24 @@ mkConstrNames :: [(String,a)] -> [Name] mkConstrNames = map (mkName . toConstrName . fst) --- | Build P_Column0 data, add it to instances and make colColumn variable+-- | Build P_Column data, add it to instances and make column' variable buildColData :: [(String, Type)] -> WriterT [Dec] Q () buildColData fieldlist = do     let constrNames = mkConstrNames fieldlist     forM_ (zip fieldlist constrNames) $ \((fieldname, ltype), constr) -> do-        let pat = mkName (toPatName fieldname)+        let pat = mkName (fieldname <> "'") #if __GLASGOW_HASKELL__ >= 800         say $ DataD [] constr [] Nothing [] [] #else         say $ DataD [] constr [] [] [] #endif         lift [d|-            instance ColumnInfo $(pure (ConT constr)) where+            instance ColumnInfo $(conT constr) where                 columnName _ = T.pack fieldname           |] >>= tell         say $ SigD pat (AppT (AppT (AppT (ConT ''Column) ltype) (ConT 'TypColumn)) (ConT constr))         say $ ValD (VarP pat) (NormalB (VarE 'mkColumn)) []-  where-    toPatName = ("col" <> ) . over (ix 0) toUpper -say :: Monad m => t -> WriterT [t] m ()-say a = tell [a]- -- | Derive 'DynamoEncodable' and prepare column instances for nested structures. deriveCollection :: Name -> (String -> String) -> Q [Dec] deriveCollection table translate =@@ -250,7 +251,7 @@     tblFieldNames <- getFieldNames table translate     buildColData tblFieldNames     -- Create instance DynamoEncodable-    deriveEncodable table translate+    deriveEncodable' table translate  -- | Derive just the 'DynamoEncodable' instance -- for structures that were already derived using 'mkTableDefs'@@ -265,12 +266,15 @@ -- > instance InCollection column_type P_Column1 'NestedPath -- > instance InCollection column_type P_Column2 'NestedPath -- > ...-deriveEncodable :: Name -> (String -> String) -> WriterT [Dec] Q ()-deriveEncodable table translate = do+deriveEncodable :: Name -> (String -> String) -> Q [Dec]+deriveEncodable name trans = execWriterT (deriveEncodable' name trans)++deriveEncodable' :: Name -> (String -> String) -> WriterT [Dec] Q ()+deriveEncodable' table translate = do     tblFieldNames <- getFieldNames table translate-    let fieldList = pure (ListE (map (AppE (VarE 'T.pack) . LitE . StringL . fst) tblFieldNames))+    let fieldList = listE (map (appE (varE 'T.pack) . litE . StringL . fst) tblFieldNames)     lift [d|-      instance DynamoEncodable $(pure (ConT table)) where+      instance DynamoEncodable $(conT table) where           dEncode val = Just (attributeValue & avM .~ gsEncodeG $(fieldList) val)           dDecode (Just attr) = gsDecodeG $(fieldList) (attr ^. avM)           dDecode Nothing = Nothing@@ -278,7 +282,7 @@     let constrs = mkConstrNames tblFieldNames     forM_ constrs $ \constr ->       lift [d|-        instance InCollection $(pure (ConT constr)) $(pure (ConT table)) 'NestedPath+        instance InCollection $(conT constr) $(conT table) 'NestedPath         |] >>= tell  -- | Creates top-leval variable as a call to a migration function with partially applied createIndex@@ -305,17 +309,22 @@ -- -- Use 'mkTableDefs' to derive everything about a table and its indexes. After running the function, -- you will end up with lots of instances, data types for columns ('P_TId', 'P_TBase', 'P_TDescr')--- and smart constructors for column ('colTId', 'colTBase', 'colTDescr', etc.) and one function (migrate)+-- and smart constructors for column (tId', tBase', tDescr', etc.) and one function (migrate) -- that creates table and updates the indexes. ----- The migration function has signature:+-- The migration function has a signature: -- -- >  MonadAWS m => HashMap T.Text ProvisionedThroughput -> Maybe StreamViewType -> m0 () --+-- ProvisionedThroughput hashmap keys are DynamoDB table or index names.+-- -- * 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) -- * Attribute name is a field name from a first underscore ('tId'). This should make it compatibile with lens.--- * Column name is capitalized attribute name with prepended 'col' ('colTId')--- * Attribute names in an index table must be the same as Attribute names in the main table+-- * 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') -- -- @

@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell #-}+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 Database.DynamoDB.THLens (getFieldNames, whenJust)+import Database.DynamoDB.Class (ContainsTableKey(..))++-- | Create ContainsTableKey instance+createContainsTableKey :: (String -> String) -> Name -> [String] -> Name -> WriterT [Dec] Q ()+createContainsTableKey translate parent pkeyfields item = do+    tblFieldNames <- getFieldNames item id+    let pfields = pkeyfields & map (\pname -> (find (\(n,_) -> translate n == pname) tblFieldNames))+                             & sequence+    whenJust pfields $ \pkey -> do+        case pkey of+          [(fname, typ)] ->+              lift [d|+                instance ContainsTableKey $(conT item) $(conT parent) $(pure typ) where+                    dTableKey = $(varE (mkName fname))+                |] >>= tell+          [(fname1, typ1), (fname2, typ2)] ->+              lift [d|+                instance ContainsTableKey $(conT item) $(conT parent) ($(pure typ1), $(pure typ2)) where+                    dTableKey a = ($(varE (mkName fname1)) a, $(varE (mkName fname2)) a)+                |] >>= tell+          _ -> fail "Unexpected pkey length, internal error"

@@ -0,0 +1,90 @@+{-# LANGUAGE CPP             #-}+{-# LANGUAGE TemplateHaskell #-}++-- | Create polymorphic lens to access table & indexes+module Database.DynamoDB.THLens where++import           Control.Lens                    (over, _1)+import           Control.Monad                   (forM_)+import           Control.Monad.Trans.Class       (lift)+import           Control.Monad.Trans.Writer.Lazy (WriterT, tell)+import           Data.Function                   ((&))+import           Data.List                       (isPrefixOf)+import           Data.Monoid                     ((<>))+import           Language.Haskell.TH+import           Language.Haskell.TH.Syntax      (Name (..), OccName (..))++-- | Create lenses if the field in the primary table starts with _.+--+-- class Test_lens_field00 a b | a -> b where+--   _field :: Functor f => (b -> f b) -> a -> f a+-- instance Test_lens_field00 Test (Maybe T.Text) where+--   field f t = (\txt -> t{_field=txt}) <$> f (_field t)+createPolyLenses :: (String -> String) -> Name -> [Name] -> WriterT [Dec] Q ()+createPolyLenses translate table indexes = do+    -- Get fields that can be lenses+    tblfields <- getFieldNames table id+    fields <- tblfields & map fst+                        & filter ("_" `isPrefixOf`)+                        & map ((,) <$> translate <*> drop 1)+                        & mapM mkLensClass+    mapM_ createClass fields+    createInstances fields table+    mapM_ (createInstances fields) indexes+  where+    mkLensClass (field, lens) = do+        clsname <- lift $ newName (nameBase table ++ "_lens_" ++ field)+        return (field, (mkName lens, clsname))+    createClass (_, (lensname, clsname)) = do+        a <- lift $ newName "a"+        b <- lift $ newName "b"+        f <- lift $ newName "f"+        lift (pure $ ClassD [] clsname [PlainTV a,PlainTV b] [FunDep [a] [b]]+            [SigD lensname (ForallT [PlainTV f] [AppT (ConT ''Functor) (VarT f)]+              (AppT (AppT ArrowT (AppT (AppT ArrowT (VarT b))+              (AppT (VarT f) (VarT b)))) (AppT (AppT ArrowT (VarT a))+              (AppT (VarT f) (VarT a)))))]) >>= say+    createInstances lensfields idx = do+        tblfields <- getFieldNames idx id+        forM_ tblfields $ \(fieldname, ftype) ->+            whenJust (lookup (translate fieldname) lensfields) $ \(lensname, clsname) -> do+                f <- lift $ newName "f"+                t <- lift $ newName "t"+                val <- lift $ newName "val"+                let fieldSel = mkName fieldname+#if __GLASGOW_HASKELL__ >= 800+                lift (pure $ InstanceD Nothing [] (AppT (AppT (ConT clsname) (ConT idx)) ftype)+                  [FunD lensname [Clause [VarP f,VarP t] (NormalB (InfixE (Just (LamE [VarP val]+                      (RecUpdE (VarE t) [(fieldSel,VarE val)]))) (VarE 'fmap)+                                  (Just (AppE (VarE f) (AppE (VarE fieldSel) (VarE t)))))) []]])+#else+                lift (pure $ InstanceD [] (AppT (AppT (ConT clsname) (ConT idx)) ftype)+                  [FunD lensname [Clause [VarP f,VarP t] (NormalB (InfixE (Just (LamE [VarP val]+                      (RecUpdE (VarE t) [(fieldSel,VarE val)]))) (VarE 'fmap)+                                  (Just (AppE (VarE f) (AppE (VarE fieldSel) (VarE t)))))) []]])+#endif+                    >>= say++whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()+whenJust (Just a) f = f a+whenJust Nothing _ = return ()++say :: Monad m => t -> WriterT [t] m ()+say a = tell [a]+++-- | Reify name and return list of record fields with type+getFieldNames :: Name -> (String -> String) -> WriterT [Dec] Q [(String, Type)]+getFieldNames tbl translate = do+    info <- lift $ reify tbl+    case getRecords info of+      Left err -> fail $ "Table " <> show tbl <> ": " <> err+      Right lst -> return $ map (over _1 translate) lst+  where+    getRecords :: Info -> Either String [(String, Type)]+#if __GLASGOW_HASKELL__ >= 800+    getRecords (TyConI (DataD _ _ _ _ [RecC _ vars] _)) = Right $ map (\(Name (OccName rname) _,_,typ) -> (rname, typ)) vars+#else+    getRecords (TyConI (DataD _ _ _ [RecC _ vars] _)) = Right $ map (\(Name (OccName rname) _,_,typ) -> (rname, typ)) vars+#endif+    getRecords _ = Left "not a record declaration with 1 constructor"

@@ -1,4 +1,7 @@ {-# LANGUAGE CPP                    #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif {-# LANGUAGE DataKinds              #-} {-# LANGUAGE DefaultSignatures      #-} {-# LANGUAGE FlexibleContexts       #-}

@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif+ {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -8,7 +13,7 @@ -- Example as used in nested structure for scan: -- -- > updateItemByKey_ (Proxy :: Proxy Test, ("hashkey", "sortkey"))--- >                  ((colIInt +=. 5) <> (colIText =. "updated") <> (colIMText =. Nothing))+-- >                  ((iInt' +=. 5) <> (iText' =. "updated") <> (iMText' =. Nothing)) -- -- The unique "Action" can be added together using the '<>' operator. You are not supposed -- to operate on the same attribute simultaneously using multiple actions.

@@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE FlexibleInstances     #-}  module BaseSpec where @@ -67,8 +68,8 @@             testitem2 = Test "2" 3 "text" False 4.15 3 (Just "text")         putItem testitem1         putItem testitem2-        it1 <- getItem Strongly ("1", 2)-        it2 <- getItem Strongly ("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@@ -76,7 +77,7 @@             newItems = map template [1..300]         putItemBatch newItems         ---        let keys = map (snd . itemToKey) newItems+        let keys = map (snd . tableKey) newItems         items <- getItemBatch Strongly keys         liftIO $ sort items `shouldBe` sort newItems     withDb "insertItem doesn't overwrite items" $ do@@ -89,73 +90,73 @@         let template i = Test (T.pack $ show i) i "text" False 3.14 i Nothing             newItems = map template [1..55]         putItemBatch newItems-        let squery = scanOpts & sFilterCondition .~ Just (colIInt >. 50)+        let squery = scanOpts & sFilterCondition .~ Just (iInt' >. 50)                               & sLimit .~ Just 1-        res <- runConduit $ scanSource squery =$= CL.consume-        liftIO $ res `shouldBe` drop 50 newItems+        res <- runConduit $ scanSource tTest squery =$= CL.consume+        liftIO $ sort res `shouldBe` sort (drop 50 newItems)     withDb "querySource works correctly with qLimit" $ do         let template i = Test "hashkey" i "text" False 3.14 i Nothing             newItems = map template [1..55]         putItemBatch newItems-        let squery = queryOpts "hashkey" & qFilterCondition .~ Just (colIInt >. 50)+        let squery = queryOpts "hashkey" & qFilterCondition .~ Just (iInt' >. 50)                                          & qLimit .~ Just 1-        res <- runConduit $ querySource squery =$= CL.consume+        res <- runConduit $ querySource tTest squery =$= CL.consume         liftIO $ res `shouldBe` drop 50 newItems     withDb "queryCond works correctly with qLimit" $ do         let template i = Test "hashkey" i "text" False 3.14 i Nothing             newItems = map template [1..55]         putItemBatch newItems-        items <- queryCond "hashkey" Nothing (colIInt >. 50) Forward 5+        items <- queryCond tTest "hashkey" Nothing (iInt' >. 50) Forward 5         liftIO $ items `shouldBe` drop 50 newItems     withDb "scanCond works correctly" $ do         let template i = Test "hashkey" i "text" False 3.14 i Nothing             newItems = map template [1..55]         putItemBatch newItems-        items <- scanCond (colIInt >. 50) 5+        items <- scanCond tTest (iInt' >. 50) 5         liftIO $ items `shouldBe` drop 50 newItems     withDb "scan works correctly with qlimit" $ do       let template i = Test "hashkey" i "text" False 3.14 i Nothing           newItems = map template [1..55]       putItemBatch newItems-      (items, _) <- scan (scanOpts & sLimit .~ Just 1 & sFilterCondition .~ Just (colIInt >. 50)) 5+      (items, _) <- scan tTest (scanOpts & sLimit .~ Just 1 & sFilterCondition .~ Just (iInt' >. 50)) 5       liftIO $ items `shouldBe` drop 50 newItems     withDb "scan works correctly with `valIn`" $ do       let template i = Test "hashkey" i "text" False 3.14 i Nothing           newItems = map template [1..55]       putItemBatch newItems-      (items, _) <- scan (scanOpts & sLimit .~ Just 1 & sFilterCondition .~ Just (colIInt `valIn` [20..30])) 50+      (items, _) <- scan tTest (scanOpts & sLimit .~ Just 1 & sFilterCondition .~ Just (iInt' `valIn` [20..30])) 50       liftIO $ map iInt items `shouldBe` [20..30]     withDb "scan works correctly with BETWEEN" $ do       let template i = Test "hashkey" i "text" False 3.14 i Nothing           newItems = map template [1..55]       putItemBatch newItems-      (items, _) <- scan (scanOpts & sLimit .~ Just 1 & sFilterCondition .~ Just (colIInt `between` (20, 30))) 50+      (items, _) <- scan tTest (scanOpts & sLimit .~ Just 1 & sFilterCondition .~ Just (iInt' `between` (20, 30))) 50       liftIO $ map iInt items `shouldBe` [20..30]     withDb "scan works correctly with SIZE" $ do       let testitem1 = Test "1" 2 "very very very very very long" False 3.14 2 Nothing           testitem2 = Test "1" 3 "short" False 3.14 2 Nothing       putItem testitem1       putItem testitem2-      (items, _) <- scan (scanOpts & sLimit .~ Just 1 & sFilterCondition .~ Just (size colIText >. 10)) 50+      (items, _) <- scan tTest (scanOpts & sLimit .~ Just 1 & sFilterCondition .~ Just (size iText' >. 10)) 50       liftIO $ items `shouldBe` [testitem1]     withDb "querySimple works correctly with RangeOper" $ do         let template i = Test "hashkey" i "text" False 3.14 i Nothing             newItems = map template [1..55]         putItemBatch newItems-        items <- querySimple "hashkey" (Just $ RangeLessThan 30) Backward 5+        items <- querySimple tTest "hashkey" (Just $ RangeLessThan 30) Backward 5         liftIO $ map iRangeKey items `shouldBe` [29,28..25]     withDb "queryCond works correctly with -1 limit" $ do         let template i = Test "hashkey" i "text" False 3.14 i Nothing             newItems = map template [1..55]         putItemBatch newItems-        (items :: [Test]) <- queryCond "hashkey" Nothing (colIInt >. 50) Backward (-1)+        (items :: [Test]) <- queryCond tTest "hashkey" Nothing (iInt' >. 50) Backward (-1)         liftIO $ items `shouldBe` []     withDb "updateItemByKey works" $ do         let testitem1 = Test "1" 2 "text" False 3.14 2 (Just "something")         putItem testitem1-        new1 <- updateItemByKey (itemToKey testitem1)-                                ((colIInt +=. 5) <> (colIText =. "updated") <> (colIMText =. Nothing))-        Just new2 <- getItem Strongly (snd (itemToKey testitem1))+        new1 <- updateItemByKey (tableKey testitem1)+                                ((iInt' +=. 5) <> (iText' =. "updated") <> (iMText' =. Nothing))+        Just new2 <- getItem Strongly (tableKey testitem1)         liftIO $ do             new1 `shouldBe` new2             iInt new1 `shouldBe` 7@@ -165,8 +166,8 @@     withDb "update fails on non-existing item" $ do         let testitem1 = Test "1" 2 "text" False 3.14 2 (Just "something")         putItem testitem1-        updateItemByKey_ (Proxy :: Proxy Test, ("1", 2)) (colIBool =. True)-        (res :: Either SomeException ()) <- try $ updateItemByKey_ (Proxy :: Proxy Test, ("2", 3)) (colIBool =. 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@@ -174,11 +175,11 @@             newItems = map template [1..55]         putItemBatch newItems -        (it1 :: [Test], next) <- scan (scanOpts & sFilterCondition .~ Just (colIInt >. 20)-                                                & sLimit .~ Just 2) 5-        (it2, _) <- scan (scanOpts & sFilterCondition .~ Just (colIInt >. 20)-                                                & sLimit .~ Just 1-                                                & sStartKey .~ next) 5+        (it1, next) <- scan tTest (scanOpts & sFilterCondition .~ Just (iInt' >. 20)+                                            & sLimit .~ Just 2) 5+        (it2, _) <- scan tTest (scanOpts & sFilterCondition .~ Just (iInt' >. 20)+                                         & sLimit .~ Just 1+                                         & sStartKey .~ next) 5         liftIO $ map iInt (it1 ++ it2) `shouldBe` [21..30]      withDb "searching empty strings" $ do@@ -186,8 +187,8 @@         let testitem2 = Test "1" 3 "aaa" False 3.14 2 (Just "test")         putItem testitem1         putItem testitem2-        (items1 :: [Test]) <- queryCond "1" Nothing (colIText ==. "") Forward 10-        (items2 :: [Test]) <- queryCond "1" Nothing (colIMText ==. Nothing) Forward 10+        items1 <- queryCond tTest "1" Nothing (iText' ==. "") Forward 10+        items2 <- queryCond tTest "1" Nothing (iMText' ==. Nothing) Forward 10         liftIO $ items1 `shouldBe` [testitem1]         liftIO $ items2 `shouldBe` [testitem1] @@ -196,10 +197,10 @@         let testitem2 = Test "1" 3 "aaa" False 3.14 2 (Just "test")         putItem testitem1         putItem testitem2-        (items :: [Test], _) <- scan scanOpts 10-        deleteItemByKey (itemToKey testitem1)-        deleteItemByKey (itemToKey testitem2)-        (items2 :: [Test], _) <- scan scanOpts 10+        (items, _) <- scan tTest scanOpts 10+        deleteItemByKey (tableKey testitem1)+        deleteItemByKey (tableKey testitem2)+        (items2, _) <- scan tTest scanOpts 10         liftIO $ do           length items `shouldBe` 2           length items2 `shouldBe` 0

@@ -2,6 +2,7 @@ {-# LANGUAGE EmptyDataDecls        #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE ScopedTypeVariables   #-}@@ -55,7 +56,6 @@   , _iMap      :: HashMap Name Inner } deriving (Show, Eq) mkTableDefs "migrateTest" (tableConfig (''Test, WithRange) [] [])-makeLenses ''Test  withDb :: Example (IO b) => String -> AWS b -> SpecWith (Arg (IO b)) withDb msg code = it msg runcode@@ -83,8 +83,8 @@             testitem2 = Test "hash" 2 inner1 Nothing Set.empty [] HMap.empty         putItem testitem1         putItem testitem2-        Just ritem1 <- getItem Strongly ("hash", 1)-        Just ritem2 <- getItem Strongly ("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@@ -95,25 +95,25 @@         putItem testitem1         putItem testitem2         ---        items1 <- scanCond (colIInner <.> colNFirst ==. "test") 10+        items1 <- scanCond tTest (iInner' <.> nFirst' ==. "test") 10         liftIO $ items1 `shouldBe` [testitem1]         ---        items2 <- scanCond (colIInner <.> colNFirst ==. "") 10+        items2 <- scanCond tTest (iInner' <.> nFirst' ==. "") 10         liftIO $ items2 `shouldBe` [testitem2]         ---        items3 <- scanCond (colIMInner <.> colNThird ==. "test") 10+        items3 <- scanCond tTest (iMInner' <.> nThird' ==. "test") 10         liftIO $ items3 `shouldBe` [testitem1]         ---        items4 <- scanCond (colIMInner ==. Nothing) 10+        items4 <- scanCond tTest (iMInner' ==. Nothing) 10         liftIO $ items4 `shouldBe` [testitem2]         ---        items5 <- scanCond (colISet `setContains` Tagged "test") 10+        items5 <- scanCond tTest (iSet' `setContains` Tagged "test") 10         liftIO $ items5 `shouldBe` [testitem1]         ---        items6 <- scanCond (colIList <!> 0 <.> colNFirst ==. "test") 10+        items6 <- scanCond tTest (iList' <!> 0 <.> nFirst' ==. "test") 10         liftIO $ items6 `shouldBe` [testitem1]         ---        items7 <- scanCond (colIMap <!:> Tagged "test" <.> colNThird ==. "test") 10+        items7 <- scanCond tTest (iMap' <!:> Tagged "test" <.> nThird' ==. "test") 10         liftIO $ items7 `shouldBe` [testitem1]      withDb "Nested updates" $ do@@ -124,23 +124,23 @@         putItem testitem1         putItem testitem2         ---        newitem1 <- updateItemByKey (itemToKey testitem1) (colIInner <.> colNFirst =. "updated")+        newitem1 <- updateItemByKey (tableKey testitem1) (iInner' <.> nFirst' =. "updated")         liftIO $ newitem1 ^. iInner . nFirst `shouldBe` "updated"         ---        newitem2 <- updateItemByKey (itemToKey testitem1) (add colISet (Set.singleton (Tagged "test2")))+        newitem2 <- updateItemByKey (tableKey testitem1) (add iSet' (Set.singleton (Tagged "test2")))         liftIO $ newitem2 ^. iSet `shouldBe` Set.fromList [Tagged "test", Tagged "test2"]         ---        newitem3 <- updateItemByKey (itemToKey testitem1) (prepend colIList [inner2, inner1])+        newitem3 <- updateItemByKey (tableKey testitem1) (prepend iList' [inner2, inner1])         liftIO $ newitem3 ^. iList `shouldBe` [inner2, inner1, inner1]         ---        newitem4 <- updateItemByKey (itemToKey testitem1) (delListItem colIList 1)+        newitem4 <- updateItemByKey (tableKey testitem1) (delListItem iList' 1)         liftIO $ newitem4 ^. iList `shouldBe` [inner2, inner1]         ---        newitem5 <- updateItemByKey (itemToKey testitem2) (colIMap <!:> Tagged "test" =. inner1)+        newitem5 <- updateItemByKey (tableKey testitem2) (iMap' <!:> Tagged "test" =. inner1)         liftIO $ newitem5 ^.. iMap . traverse `shouldBe` [inner1]         liftIO $ newitem5 ^? iMap . ix (Tagged "test")  `shouldBe` Just inner1         ---        newitem6 <- updateItemByKey (itemToKey testitem2) (delHashKey colIMap (Tagged "test"))+        newitem6 <- updateItemByKey (tableKey testitem2) (delHashKey iMap' (Tagged "test"))         liftIO $ newitem6 ^. iMap `shouldBe` HMap.empty