{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Database.Persist.Delta (
    -- * Synopsis
    -- | Manipulating SQL database tables using delta encodings
    -- via the "persistent" package.

    -- * Store
    newEntityStore, newSqlStore
    ) where

import Prelude hiding
    ( all )

import Control.Monad
    ( forM_, void )
import Control.Monad.IO.Class
    ( MonadIO, liftIO )
import Data.Bifunctor
    ( first )
import Data.DBVar
    ( Store (..) )
import Data.Delta
    ( Delta (..) )
import Data.Proxy
    ( Proxy (..) )
import Data.Table
    ( DeltaDB (..), Pile (..), Table (..) )
import Database.Persist
    ( Filter, Key, PersistRecordBackend, ToBackendKey )
import Database.Persist.Sql
    ( SqlBackend, SqlPersistM, fromSqlKey, toSqlKey )
import Database.Schema
    ( (:.) (..), Col (..), IsRow, Primary (..) )
import Say
    ( say, sayShow )

-- FIXME: Replace with IOSim stuff later.
import Data.IORef
    ( newIORef, readIORef, writeIORef )

import qualified Data.Table as Table
import qualified Database.Persist as Persist
import qualified Database.Schema as Sql

{-------------------------------------------------------------------------------
    Database operations
-------------------------------------------------------------------------------}
-- | Helper abstraction for a Database backend
data Database m key row = Database
    { Database m key row -> m [(key, row)]
selectAll   :: m [(key, row)]
    , Database m key row -> m ()
deleteAll   :: m ()
    , Database m key row -> [(key, row)] -> m ()
repsertMany :: [(key, row)] -> m ()
    , Database m key row -> key -> m ()
deleteOne   :: key -> m ()
    , Database m key row -> (key, row) -> m ()
updateOne   :: (key, row) -> m ()
    }

-- | Database table for 'Entity'.
persistDB
    :: forall row. ( PersistRecordBackend row SqlBackend
    , ToBackendKey SqlBackend row )
    => Database SqlPersistM Int row
persistDB :: Database SqlPersistM Int row
persistDB = Database :: forall (m :: * -> *) key row.
m [(key, row)]
-> m ()
-> ([(key, row)] -> m ())
-> (key -> m ())
-> ((key, row) -> m ())
-> Database m key row
Database
    { selectAll :: SqlPersistM [(Int, row)]
selectAll = (Entity row -> (Int, row)) -> [Entity row] -> [(Int, row)]
forall a b. (a -> b) -> [a] -> [b]
map Entity row -> (Int, row)
toPair ([Entity row] -> [(Int, row)])
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) [Entity row]
-> SqlPersistM [(Int, row)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter row]
-> [SelectOpt row]
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) [Entity row]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
Persist.selectList [Filter row]
all []
    , deleteAll :: SqlPersistM ()
deleteAll = [Filter row] -> SqlPersistM ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
Persist.deleteWhere [Filter row]
all
    , repsertMany :: [(Int, row)] -> SqlPersistM ()
repsertMany = [(Key row, row)] -> SqlPersistM ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[(Key record, record)] -> ReaderT backend m ()
Persist.repsertMany ([(Key row, row)] -> SqlPersistM ())
-> ([(Int, row)] -> [(Key row, row)])
-> [(Int, row)]
-> SqlPersistM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, row) -> (Key row, row)) -> [(Int, row)] -> [(Key row, row)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Key row) -> (Int, row) -> (Key row, row)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Key row
toKey)
    , deleteOne :: Int -> SqlPersistM ()
deleteOne = Key row -> SqlPersistM ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
Persist.delete (Key row -> SqlPersistM ())
-> (Int -> Key row) -> Int -> SqlPersistM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Key row
toKey
    , updateOne :: (Int, row) -> SqlPersistM ()
updateOne = \(Int
key,row
val) -> Key row -> row -> SqlPersistM ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
Persist.replace (Int -> Key row
toKey Int
key) row
val
    }
  where
    all :: [Filter row]
all = [] :: [Filter row]

    toPair :: Entity row -> (Int, row)
toPair (Persist.Entity Key row
key row
val) = (Key row -> Int
fromKey Key row
key, row
val)

    fromKey :: Key row -> Int
fromKey = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Key row -> Int64) -> Key row -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key row -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey
    toKey :: Int -> Key row
    toKey :: Int -> Key row
toKey = Int64 -> Key row
forall record.
ToBackendKey SqlBackend record =>
Int64 -> Key record
toSqlKey (Int64 -> Key row) -> (Int -> Int64) -> Int -> Key row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | SQL database backend
sqlDB
    :: forall row. (IsRow row, IsRow (row :. Col "id" Primary))
    => Database SqlPersistM Int row
sqlDB :: Database SqlPersistM Int row
sqlDB = Database :: forall (m :: * -> *) key row.
m [(key, row)]
-> m ()
-> ([(key, row)] -> m ())
-> (key -> m ())
-> ((key, row) -> m ())
-> Database m key row
Database
    { selectAll :: SqlPersistM [(Int, row)]
selectAll = ((row :. Col "id" Primary) -> (Int, row))
-> [row :. Col "id" Primary] -> [(Int, row)]
forall a b. (a -> b) -> [a] -> [b]
map (row :. Col "id" Primary) -> (Int, row)
toPair ([row :. Col "id" Primary] -> [(Int, row)])
-> ReaderT
     SqlBackend (NoLoggingT (ResourceT IO)) [row :. Col "id" Primary]
-> SqlPersistM [(Int, row)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query (row :. Col "id" Primary)
-> ReaderT
     SqlBackend (NoLoggingT (ResourceT IO)) [row :. Col "id" Primary]
forall (m :: * -> *) row.
(MonadIO m, IsRow row) =>
Query row -> SqlPersistT m [row]
Sql.callSql Query (row :. Col "id" Primary)
forall row. IsRow row => Query row
Sql.selectAll
    , deleteAll :: SqlPersistM ()
deleteAll = Query () -> SqlPersistM ()
forall (m :: * -> *). MonadIO m => Query () -> SqlPersistT m ()
Sql.runSql (Query () -> SqlPersistM ()) -> Query () -> SqlPersistM ()
forall a b. (a -> b) -> a -> b
$ Proxy row -> Query ()
forall row. IsRow row => Proxy row -> Query ()
Sql.deleteAll Proxy row
proxy
    , repsertMany :: [(Int, row)] -> SqlPersistM ()
repsertMany = \[(Int, row)]
zs -> [(Int, row)] -> ((Int, row) -> SqlPersistM ()) -> SqlPersistM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, row)]
zs (((Int, row) -> SqlPersistM ()) -> SqlPersistM ())
-> ((Int, row) -> SqlPersistM ()) -> SqlPersistM ()
forall a b. (a -> b) -> a -> b
$
        Query () -> SqlPersistM ()
forall (m :: * -> *). MonadIO m => Query () -> SqlPersistT m ()
Sql.runSql (Query () -> SqlPersistM ())
-> ((Int, row) -> Query ()) -> (Int, row) -> SqlPersistM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (row :. Col "id" Primary) -> Query ()
forall row. IsRow row => (row :. Col "id" Primary) -> Query ()
Sql.repsertOne ((row :. Col "id" Primary) -> Query ())
-> ((Int, row) -> row :. Col "id" Primary)
-> (Int, row)
-> Query ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, row) -> row :. Col "id" Primary
fromPair
    , deleteOne :: Int -> SqlPersistM ()
deleteOne = Query () -> SqlPersistM ()
forall (m :: * -> *). MonadIO m => Query () -> SqlPersistT m ()
Sql.runSql (Query () -> SqlPersistM ())
-> (Int -> Query ()) -> Int -> SqlPersistM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy row -> Col "id" Primary -> Query ()
forall row. IsRow row => Proxy row -> Col "id" Primary -> Query ()
Sql.deleteOne Proxy row
proxy (Col "id" Primary -> Query ())
-> (Int -> Col "id" Primary) -> Int -> Query ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Primary -> Col "id" Primary
forall (name :: Symbol) a. a -> Col name a
Col (Primary -> Col "id" Primary)
-> (Int -> Primary) -> Int -> Col "id" Primary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Primary
Primary
    , updateOne :: (Int, row) -> SqlPersistM ()
updateOne = Query () -> SqlPersistM ()
forall (m :: * -> *). MonadIO m => Query () -> SqlPersistT m ()
Sql.runSql (Query () -> SqlPersistM ())
-> ((Int, row) -> Query ()) -> (Int, row) -> SqlPersistM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (row :. Col "id" Primary) -> Query ()
forall row. IsRow row => (row :. Col "id" Primary) -> Query ()
Sql.updateOne ((row :. Col "id" Primary) -> Query ())
-> ((Int, row) -> row :. Col "id" Primary)
-> (Int, row)
-> Query ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, row) -> row :. Col "id" Primary
fromPair
    }
  where
    proxy :: Proxy row
proxy = Proxy row
forall k (t :: k). Proxy t
Proxy :: Proxy row

    fromPair :: (Int,row) -> (row :. Col "id" Primary)
    fromPair :: (Int, row) -> row :. Col "id" Primary
fromPair (Int
key,row
row) = row
row row -> Col "id" Primary -> row :. Col "id" Primary
forall a b. a -> b -> a :. b
:. (Primary -> Col "id" Primary
forall (name :: Symbol) a. a -> Col name a
Col (Int -> Primary
Primary Int
key) :: Col "id" Primary)

    toPair :: (row :. Col "id" Primary) -> (Int,row)
    toPair :: (row :. Col "id" Primary) -> (Int, row)
toPair (row
row :. Col (Primary Int
key)) = (Int
key,row
row)

{-------------------------------------------------------------------------------
    Database operations
-------------------------------------------------------------------------------}
-- | Construct a 'Store' from an SQL table.
--
-- The unique IDs will be stored in a column "id" at the end of
-- each row in the database table.
newSqlStore
    :: (MonadIO m, IsRow row, IsRow (row :. Col "id" Primary), Show row)
    => m (Store SqlPersistM [DeltaDB Int row])
newSqlStore :: m (Store SqlPersistM [DeltaDB Int row])
newSqlStore = Database SqlPersistM Int row
-> m (Store SqlPersistM [DeltaDB Int row])
forall (m :: * -> *) (n :: * -> *) row.
(MonadIO m, MonadIO n, Show row) =>
Database m Int row -> n (Store m [DeltaDB Int row])
newDatabaseStore Database SqlPersistM Int row
forall row.
(IsRow row, IsRow (row :. Col "id" Primary)) =>
Database SqlPersistM Int row
sqlDB

-- | Construct a 'Store' for 'Entity'.
--
-- FIXME: This function should also do \"migrations\", i.e.
-- create the database table in the first place.
newEntityStore
    :: forall row m.
    ( PersistRecordBackend row SqlBackend
    , ToBackendKey SqlBackend row, Show row
    , MonadIO m )
    => m (Store SqlPersistM [DeltaDB Int row])
newEntityStore :: m (Store SqlPersistM [DeltaDB Int row])
newEntityStore = Database SqlPersistM Int row
-> m (Store SqlPersistM [DeltaDB Int row])
forall (m :: * -> *) (n :: * -> *) row.
(MonadIO m, MonadIO n, Show row) =>
Database m Int row -> n (Store m [DeltaDB Int row])
newDatabaseStore Database SqlPersistM Int row
forall row.
(PersistRecordBackend row SqlBackend,
 ToBackendKey SqlBackend row) =>
Database SqlPersistM Int row
persistDB

-- | Helper function to create a 'Store' using a 'Database' backend.
newDatabaseStore
    :: forall m n row. (MonadIO m, MonadIO n, Show row)
    => Database m Int row
    -> n (Store m [DeltaDB Int row])
newDatabaseStore :: Database m Int row -> n (Store m [DeltaDB Int row])
newDatabaseStore Database m Int row
db = do
    IORef (Maybe Supply)
ref <- IO (IORef (Maybe Supply)) -> n (IORef (Maybe Supply))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe Supply)) -> n (IORef (Maybe Supply)))
-> IO (IORef (Maybe Supply)) -> n (IORef (Maybe Supply))
forall a b. (a -> b) -> a -> b
$ Maybe Supply -> IO (IORef (Maybe Supply))
forall a. a -> IO (IORef a)
newIORef Maybe Supply
forall a. Maybe a
Nothing
    let rememberSupply :: Table row -> m ()
rememberSupply Table row
table = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Supply) -> Maybe Supply -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Supply)
ref (Maybe Supply -> IO ()) -> Maybe Supply -> IO ()
forall a b. (a -> b) -> a -> b
$ Supply -> Maybe Supply
forall a. a -> Maybe a
Just (Supply -> Maybe Supply) -> Supply -> Maybe Supply
forall a b. (a -> b) -> a -> b
$ Table row -> Supply
forall row. Table row -> Supply
uids Table row
table
    Store m [DeltaDB Int row] -> n (Store m [DeltaDB Int row])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Store m [DeltaDB Int row] -> n (Store m [DeltaDB Int row]))
-> Store m [DeltaDB Int row] -> n (Store m [DeltaDB Int row])
forall a b. (a -> b) -> a -> b
$ Store :: forall (m :: * -> *) da.
m (Either SomeException (Base da))
-> (Base da -> m ()) -> (Base da -> da -> m ()) -> Store m da
Store
        { loadS :: m (Either SomeException (Base [DeltaDB Int row]))
loadS   = do
            m () -> m ()
forall (f :: * -> *). Applicative f => f () -> f ()
debug (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
say Text
"\n** loadS"
                IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> ([(Int, row)] -> IO ()) -> [(Int, row)] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, row)] -> IO ()
forall a. Show a => a -> IO ()
print ([(Int, row)] -> m ()) -> m [(Int, row)] -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Database m Int row -> m [(Int, row)]
forall (m :: * -> *) key row. Database m key row -> m [(key, row)]
selectAll Database m Int row
db
            -- read database table, preserve keys
            Table row
table <- [(Int, row)] -> Table row
forall row. [(Int, row)] -> Table row
Table.fromRows ([(Int, row)] -> Table row) -> m [(Int, row)] -> m (Table row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database m Int row -> m [(Int, row)]
forall (m :: * -> *) key row. Database m key row -> m [(key, row)]
selectAll Database m Int row
db
            -- but use our own unique ID supply
            IO (Maybe Supply) -> m (Maybe Supply)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Supply) -> IO (Maybe Supply)
forall a. IORef a -> IO a
readIORef IORef (Maybe Supply)
ref) m (Maybe Supply)
-> (Maybe Supply -> m (Either SomeException (Table row)))
-> m (Either SomeException (Table row))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Supply
supply  -> Either SomeException (Table row)
-> m (Either SomeException (Table row))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Table row)
 -> m (Either SomeException (Table row)))
-> Either SomeException (Table row)
-> m (Either SomeException (Table row))
forall a b. (a -> b) -> a -> b
$ Table row -> Either SomeException (Table row)
forall a b. b -> Either a b
Right Table row
table{uids :: Supply
uids = Supply
supply}
                Maybe Supply
Nothing      -> do
                    Table row -> m ()
rememberSupply Table row
table
                    Either SomeException (Table row)
-> m (Either SomeException (Table row))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Table row)
 -> m (Either SomeException (Table row)))
-> Either SomeException (Table row)
-> m (Either SomeException (Table row))
forall a b. (a -> b) -> a -> b
$ Table row -> Either SomeException (Table row)
forall a b. b -> Either a b
Right Table row
table
        , writeS :: Base [DeltaDB Int row] -> m ()
writeS  = \Base [DeltaDB Int row]
table -> m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            Database m Int row -> m ()
forall (m :: * -> *) key row. Database m key row -> m ()
deleteAll Database m Int row
db -- delete any old data in the table first
            Database m Int row -> [(Int, row)] -> m ()
forall (m :: * -> *) key row.
Database m key row -> [(key, row)] -> m ()
repsertMany Database m Int row
db ([(Int, row)] -> m ()) -> [(Int, row)] -> m ()
forall a b. (a -> b) -> a -> b
$ Pile (Int, row) -> [(Int, row)]
forall a. Pile a -> [a]
getPile (Pile (Int, row) -> [(Int, row)])
-> Pile (Int, row) -> [(Int, row)]
forall a b. (a -> b) -> a -> b
$ Table row -> Pile (Int, row)
forall row. Table row -> Pile (Int, row)
Table.toRows Base [DeltaDB Int row]
Table row
table
            Table row -> m ()
rememberSupply Base [DeltaDB Int row]
Table row
table
        , updateS :: Base [DeltaDB Int row] -> [DeltaDB Int row] -> m ()
updateS = \Base [DeltaDB Int row]
table [DeltaDB Int row]
ds -> do
            m () -> m ()
forall (f :: * -> *). Applicative f => f () -> f ()
debug (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
say Text
"\n** updateS table deltas"
                Table row -> m ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
sayShow Base [DeltaDB Int row]
Table row
table
                [DeltaDB Int row] -> m ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
sayShow [DeltaDB Int row]
ds
            (DeltaDB Int row -> m ()) -> [DeltaDB Int row] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Table row -> DeltaDB Int row -> m ()
update1 Base [DeltaDB Int row]
Table row
table) [DeltaDB Int row]
ds
            Table row -> m ()
rememberSupply ([DeltaDB Int row]
-> Base [DeltaDB Int row] -> Base [DeltaDB Int row]
forall delta. Delta delta => delta -> Base delta -> Base delta
apply [DeltaDB Int row]
ds Base [DeltaDB Int row]
table) -- need to use updated supply
        }
  where
    debug :: f () -> f ()
debug f ()
m = if Bool
False then f ()
m else () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    update1 :: Table row -> DeltaDB Int row -> m ()
update1 Table row
_ (InsertManyDB [(Int, row)]
zs) = m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Database m Int row -> [(Int, row)] -> m ()
forall (m :: * -> *) key row.
Database m key row -> [(key, row)] -> m ()
repsertMany Database m Int row
db [(Int, row)]
zs
    update1 Table row
_ (DeleteManyDB [Int]
ks) = [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
ks ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Database m Int row -> Int -> m ()
forall (m :: * -> *) key row. Database m key row -> key -> m ()
deleteOne Database m Int row
db
    update1 Table row
_ (UpdateManyDB [(Int, row)]
zs) = [(Int, row)] -> ((Int, row) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, row)]
zs (((Int, row) -> m ()) -> m ()) -> ((Int, row) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Database m Int row -> (Int, row) -> m ()
forall (m :: * -> *) key row.
Database m key row -> (key, row) -> m ()
updateOne Database m Int row
db

{- Note [Unique ID supply in newDBStore]

We expect that updating the store and loading the value
is the same as first loading the value and then apply the delta,
i.e. we expect that the two actions

    loadS >>= \a -> updateS a da >>= loadS
    loadS >>= \a -> pure $ apply da a

are operationally equivalent.
However, this is only the case if we keep track of the supply
of unique IDs for the table! Otherwise, loading the table
from the database again can mess up the supply.
-}
-- FIXME: For clarity, we may want to implement this in terms
-- of a product of stores ("semidirect product").