{- | This module implements an experimental typed query language for TCache build on pure
haskell. It is minimally intrusive (no special data definitions, no special syntax, no template
haskell). It uses the same register fields from the data definitions. Both for query conditions
 and selections. It is executed in haskell, no external database support is needed.

it includes

 - A method for triggering the 'index'-ation of the record fields that you want to query

 - A typed query language of these record fields, with:

     - Relational operators:  '.==.' '.>.' '.>=.' '.<=.' '.<.' '.&&.' '.||.' to compare fields with
       values (returning lists of DBRefs) or fields between them, returning joins (lists of pairs of
       lists of DBRefs that meet the condition).

     - a 'select' method to extract tuples of field values from the  DBRefs

     - a 'recordsWith' clause to extract entire registers

An example that register the owner and name fields fo the Car register and the
name of the Person register, create the Bruce register, return the Bruce DBRef, create two Car registers with bruce as owner
and query for the registers with bruce as owner and its name alpabeticaly higuer than \"Bat mobile\"

@
import "Data.TCache"
import "Data.TCache.IndexQuery"
import "Data.TCache.DefaultPersistence"
import "Data.Typeable"

data Person= Person {pname :: String} deriving  (Show, Read, Eq, Typeable)
data Car= Car{owner :: DBRef Person , cname:: String} deriving (Show, Read, Eq, Typeable)

instance 'Indexable' Person where key Person{pname= n} = \"Person \" ++ n
instance 'Indexable' Car where key Car{cname= n} = \"Car \" ++ n

main =  do
   'index' owner
   'index' pname
   'index' cname
   bruce <- atomically $ 'newDBRef' $ Person \"bruce\"
   atomically $  mapM_ 'newDBRef' [Car bruce \"Bat Mobile\", Car bruce \"Porsche\"]
   r \<- atomically $ cname '.==.' \"Porsche\"
   print r
   r \<- atomically $ 'select' (cname, owner) $  owner '.==.' bruce '.&&.' cname '.>=.' \"Bat Mobile\"
   print r
@

Will produce:

> [DBRef "Car Porsche"]
> [("Porsche",DBRef "Person bruce")]

NOTES:

* the index is instance of 'Indexable' and 'Serializable'. This can be used to
persist in the user-defined storage using DefaultPersistence

* The Join feature has not been properly tested

* Record fields are recognized by its type, so if we define two record fields
with the same type:

> data Person = Person {name , surname :: String}

then a query for @name '.==.' "Bruce"@  is indistinguishable from @surname '.==.' "Bruce"@

Will return indexOf the registers with surname "Bruce" as well. So if two or more
fields in a registers are to be indexed, they must have different types.

-}

{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances,
 FlexibleContexts, UndecidableInstances, TypeSynonymInstances, IncoherentInstances, MonoLocalBinds #-}

module Data.TCache.IndexQuery(
  index
, (.==.)
, (.<.)
, (.<=.)
, (.>=.)
, (.>.)
, indexOf
, recordsWith
, (.&&.)
, (.||.)
, select
, Queriable)
where

import Data.TCache
import Data.TCache.Defs
import Data.List
import Data.Typeable
import Data.Maybe (catMaybes, fromMaybe)
import qualified Data.Map  as M
import Data.ByteString.Lazy.Char8(pack, unpack)


class (Read a,  Show a
      , IResource reg,Typeable reg
      , Typeable a,Ord a,PersistIndex reg)
      => Queriable reg a

instance (Read a,  Show a
      , IResource reg,Typeable reg
      , Typeable a,Ord a,PersistIndex reg)
      => Queriable reg a

instance  Queriable reg a => IResource (Index reg a) where
  keyResource :: Index reg a -> String
keyResource = forall a. Indexable a => a -> String
key
  writeResource :: Index reg a -> IO ()
writeResource =forall a. (Indexable a, Serializable a, Typeable a) => a -> IO ()
defWriteResource
  readResourceByKey :: String -> IO (Maybe (Index reg a))
readResourceByKey = forall a.
(Indexable a, Serializable a, Typeable a) =>
String -> IO (Maybe a)
defReadResourceByKey
  delResource :: Index reg a -> IO ()
delResource = forall a. (Indexable a, Serializable a, Typeable a) => a -> IO ()
defDelResource


-- was data before hlint suggested to use a newtype here
newtype Index reg a= Index (M.Map a [DBRef reg]) deriving ( Int -> Index reg a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall reg a. Show a => Int -> Index reg a -> ShowS
forall reg a. Show a => [Index reg a] -> ShowS
forall reg a. Show a => Index reg a -> String
showList :: [Index reg a] -> ShowS
$cshowList :: forall reg a. Show a => [Index reg a] -> ShowS
show :: Index reg a -> String
$cshow :: forall reg a. Show a => Index reg a -> String
showsPrec :: Int -> Index reg a -> ShowS
$cshowsPrec :: forall reg a. Show a => Int -> Index reg a -> ShowS
Show, Typeable)

instance (IResource reg, Typeable reg, Ord a, Read a)
   => Read (Index reg a) where
  readsPrec :: Int -> ReadS (Index reg a)
readsPrec Int
n (Char
'I':Char
'n':Char
'd':Char
'e':Char
'x':Char
' ':String
str)
     = forall a b. (a -> b) -> [a] -> [b]
map (\(Map a [DBRef reg]
r,String
s) -> (forall reg a. Map a [DBRef reg] -> Index reg a
Index Map a [DBRef reg]
r, String
s)) [(Map a [DBRef reg], String)]
rs where rs :: [(Map a [DBRef reg], String)]
rs= forall a. Read a => Int -> ReadS a
readsPrec Int
n String
str
  readsPrec Int
_ String
s= forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"indexQuery: can not read index: \""forall a. [a] -> [a] -> [a]
++String
sforall a. [a] -> [a] -> [a]
++String
"\""

instance (Queriable reg a) => Serializable (Index reg a)  where
  serialize :: Index reg a -> ByteString
serialize= String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
  deserialize :: ByteString -> Index reg a
deserialize= forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpack
  setPersist :: Index reg a -> Maybe Persist
setPersist Index reg a
index1= forall a. PersistIndex a => a -> Maybe Persist
persistIndex forall a b. (a -> b) -> a -> b
$ forall reg a. Index reg a -> reg
getType Index reg a
index1
    where
    getType :: Index reg a -> reg
    getType :: forall reg a. Index reg a -> reg
getType= forall a. HasCallStack => a
undefined -- type level



keyIndex :: (Show a1, Show a2) => a1 -> a2 -> String
keyIndex :: forall a1 a2. (Show a1, Show a2) => a1 -> a2 -> String
keyIndex a1
treg a2
tv= String
"index-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a1
treg forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a2
tv

instance (Typeable reg, Typeable a) => Indexable (Index reg a) where
   key :: Index reg a -> String
key Index reg a
map1= forall a1 a2. (Show a1, Show a2) => a1 -> a2 -> String
keyIndex TypeRep
typeofreg TypeRep
typeofa
       where
       [TypeRep
typeofreg, TypeRep
typeofa]= TypeRep -> [TypeRep]
typeRepArgs forall a b. (a -> b) -> a -> b
$! forall a. Typeable a => a -> TypeRep
typeOf Index reg a
map1
--   defPath index= defPath $ ofRegister index
--       where
--       ofRegister :: Index reg a -> reg
--       ofRegister = undefined -- type level
-- instance (Queriable reg a, Typeable reg, Typeable a) => IResource (Index reg a) where
--  keyResource = key
--  writeResource =defWriteResource
--  readResourceByKey = defReadResourceByKey
--  delResource = defDelResource

getIndex :: (Queriable reg a)
   => ( reg -> a) -> a -> STM(DBRef (Index reg a), Index reg a,[DBRef reg])
getIndex :: forall reg a.
Queriable reg a =>
(reg -> a)
-> a -> STM (DBRef (Index reg a), Index reg a, [DBRef reg])
getIndex reg -> a
selector a
val= do
   let [TypeRep
one, TypeRep
two]= TypeRep -> [TypeRep]
typeRepArgs forall a b. (a -> b) -> a -> b
$! forall a. Typeable a => a -> TypeRep
typeOf reg -> a
selector
   let rindex :: DBRef (Index reg a)
rindex= forall a. (Typeable a, IResource a) => String -> DBRef a
getDBRef forall a b. (a -> b) -> a -> b
$! forall a1 a2. (Show a1, Show a2) => a1 -> a2 -> String
keyIndex TypeRep
one TypeRep
two
   forall reg a.
Queriable reg a =>
DBRef (Index reg a)
-> a -> STM (DBRef (Index reg a), Index reg a, [DBRef reg])
getIndexr DBRef (Index reg a)
rindex a
val


getIndexr :: (Queriable reg a)
   => DBRef(Index reg a) -> a -> STM(DBRef (Index reg a), Index reg a,[DBRef reg])
getIndexr :: forall reg a.
Queriable reg a =>
DBRef (Index reg a)
-> a -> STM (DBRef (Index reg a), Index reg a, [DBRef reg])
getIndexr DBRef (Index reg a)
rindex a
val= do
   Maybe (Index reg a)
mindex <- forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef DBRef (Index reg a)
rindex

   let index :: Map a [DBRef reg]
index = case Maybe (Index reg a)
mindex of 
        Just (Index Map a [DBRef reg]
index) ->  Map a [DBRef reg]
index
        Maybe (Index reg a)
_ -> do
             let fields :: String
fields= forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => a -> TypeRep
typeOf  DBRef (Index reg a)
rindex
             forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"the index for "forall a. [a] -> [a] -> [a]
++ String
fields forall a. [a] -> [a] -> [a]
++String
" do not exist. At main, use \"Data.TCache.IdexQuery.index\" to start indexing this field"

   let dbrefs :: [DBRef reg]
dbrefs= case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup  a
val Map a [DBRef reg]
index of
        Just  [DBRef reg]
dbrefs -> [DBRef reg]
dbrefs
        Maybe [DBRef reg]
Nothing      -> []

   forall (m :: * -> *) a. Monad m => a -> m a
return (DBRef (Index reg a)
rindex, forall reg a. Map a [DBRef reg] -> Index reg a
Index Map a [DBRef reg]
index, [DBRef reg]
dbrefs)

selectorIndex
  :: (Queriable reg a, IResource reg
      ) =>
     (reg -> a) -> DBRef (Index reg a) -> DBRef reg -> Maybe reg -> STM ()

selectorIndex :: forall reg a.
(Queriable reg a, IResource reg) =>
(reg -> a)
-> DBRef (Index reg a) -> DBRef reg -> Maybe reg -> STM ()
selectorIndex reg -> a
selector DBRef (Index reg a)
rindex1 DBRef reg
pobject Maybe reg
mobj1 = do
   Maybe reg
moldobj <- forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef DBRef reg
pobject
   Maybe reg -> Maybe reg -> STM ()
choice Maybe reg
moldobj Maybe reg
mobj1
   where
   choice :: Maybe reg -> Maybe reg -> STM ()
choice Maybe reg
moldobj Maybe reg
mobj=
    case (Maybe reg
moldobj, Maybe reg
mobj) of
     (Maybe reg
Nothing, Maybe reg
Nothing) -> forall (m :: * -> *) a. Monad m => a -> m a
return()
     (Just reg
oldobj, Just reg
obj) ->
       if reg -> a
selector reg
oldobjforall a. Eq a => a -> a -> Bool
==reg -> a
selector reg
obj
        then forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else do
          Maybe reg -> Maybe reg -> STM ()
choice Maybe reg
moldobj forall a. Maybe a
Nothing
          Maybe reg -> Maybe reg -> STM ()
choice forall a. Maybe a
Nothing Maybe reg
mobj

     (Just reg
oldobj, Maybe reg
Nothing) -> do  -- delete the old selector value from the index
          let val :: a
val= reg -> a
selector reg
oldobj
          (DBRef (Index reg a)
rindex,Index Map a [DBRef reg]
index2, [DBRef reg]
dbrefs) <-  forall reg a.
Queriable reg a =>
DBRef (Index reg a)
-> a -> STM (DBRef (Index reg a), Index reg a, [DBRef reg])
getIndexr DBRef (Index reg a)
rindex1 a
val
          let dbrefs' :: [DBRef reg]
dbrefs'=   forall a. Eq a => a -> [a] -> [a]
Data.List.delete DBRef reg
pobject  [DBRef reg]
dbrefs
          forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef DBRef (Index reg a)
rindex forall a b. (a -> b) -> a -> b
$ forall reg a. Map a [DBRef reg] -> Index reg a
Index (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert  a
val [DBRef reg]
dbrefs' Map a [DBRef reg]
index2)

     (Maybe reg
Nothing, Just reg
obj) ->  do      -- add the new value to the index
          let val :: a
val= reg -> a
selector reg
obj
          (DBRef (Index reg a)
rindex,Index Map a [DBRef reg]
index2, [DBRef reg]
dbrefs) <-  forall reg a.
Queriable reg a =>
DBRef (Index reg a)
-> a -> STM (DBRef (Index reg a), Index reg a, [DBRef reg])
getIndexr DBRef (Index reg a)
rindex1 a
val
          let dbrefs' :: [DBRef reg]
dbrefs'=   forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> [a] -> [a]
Data.List.insert DBRef reg
pobject  [DBRef reg]
dbrefs
          forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef DBRef (Index reg a)
rindex forall a b. (a -> b) -> a -> b
$ forall reg a. Map a [DBRef reg] -> Index reg a
Index (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert  a
val [DBRef reg]
dbrefs' Map a [DBRef reg]
index2)

{- | Register a trigger for indexing the values of the field passed as parameter.
 the indexed field can be used to perform relational-like searches
-}

index :: (Queriable reg a) => (reg -> a) -> IO ()
index :: forall reg a. Queriable reg a => (reg -> a) -> IO ()
index reg -> a
sel= do
   let [TypeRep
one, TypeRep
two]= TypeRep -> [TypeRep]
typeRepArgs forall a b. (a -> b) -> a -> b
$! forall a. Typeable a => a -> TypeRep
typeOf reg -> a
sel
       rindex :: DBRef (Index reg a)
rindex= forall a. (Typeable a, IResource a) => String -> DBRef a
getDBRef forall a b. (a -> b) -> a -> b
$! forall a1 a2. (Show a1, Show a2) => a1 -> a2 -> String
keyIndex TypeRep
one TypeRep
two
   forall a.
(IResource a, Typeable a) =>
(DBRef a -> Maybe a -> STM ()) -> IO ()
addTrigger forall a b. (a -> b) -> a -> b
$ forall reg a.
(Queriable reg a, IResource reg) =>
(reg -> a)
-> DBRef (Index reg a) -> DBRef reg -> Maybe reg -> STM ()
selectorIndex reg -> a
sel DBRef (Index reg a)
rindex
   let proto :: Index reg a
proto= forall reg a. Map a [DBRef reg] -> Index reg a
Index forall k a. Map k a
M.empty  forall a. a -> a -> a
`asTypeOf` forall reg a. (reg -> a) -> Index reg a
indexsel reg -> a
sel
   forall a.
(IResource a, Typeable a) =>
[a] -> ([Maybe a] -> [a]) -> IO ()
withResources [Index reg a
proto]  forall a b. (a -> b) -> a -> b
$ forall {a} {a}. a -> [Maybe a] -> [a]
init1 Index reg a
proto
   where
   init1 :: a -> [Maybe a] -> [a]
init1 a
proto [Maybe a
Nothing]  =  [a
proto]
   init1 a
_ [Just a
_] = []
   init1 a
_ (Maybe a
Nothing:Maybe a
_:[Maybe a]
_) = forall a. HasCallStack => String -> a
error String
"this will never happen(?)"
   init1 a
_ (Just a
_:Maybe a
_:[Maybe a]
_) = forall a. HasCallStack => String -> a
error String
"this will never happen(?)"
   init1 a
_ [] = forall a. HasCallStack => String -> a
error String
"this will never happen(?)"

   indexsel :: (reg-> a)  -> Index reg a
   indexsel :: forall reg a. (reg -> a) -> Index reg a
indexsel= forall a. HasCallStack => a
undefined

-- | implement the relational-like operators, operating on record fields
class RelationOps field1 field2 res | field1 field2 -> res  where
    (.==.) :: field1 -> field2 -> STM  res
    (.>.) :: field1 -> field2 ->  STM  res
    (.>=.):: field1 -> field2 ->  STM  res
    (.<=.) :: field1 -> field2 -> STM  res
    (.<.) :: field1 -> field2 ->  STM  res

-- Instance of relations betweeen fields and values
-- field .op. value
instance (Queriable reg a) => RelationOps (reg -> a) a  [DBRef reg] where
    .==. :: (reg -> a) -> a -> STM [DBRef reg]
(.==.) reg -> a
field a
value= do
       (DBRef (Index reg a)
_ ,Index reg a
_ ,[DBRef reg]
dbrefs) <- forall reg a.
Queriable reg a =>
(reg -> a)
-> a -> STM (DBRef (Index reg a), Index reg a, [DBRef reg])
getIndex reg -> a
field a
value
       forall (m :: * -> *) a. Monad m => a -> m a
return [DBRef reg]
dbrefs

    .>. :: (reg -> a) -> a -> STM [DBRef reg]
(.>.)  reg -> a
field a
value= forall reg a.
Queriable reg a =>
(reg -> a) -> a -> (a -> a -> Bool) -> STM [DBRef reg]
retrieve reg -> a
field a
value forall a. Ord a => a -> a -> Bool
(>)
    .<. :: (reg -> a) -> a -> STM [DBRef reg]
(.<.)  reg -> a
field a
value= forall reg a.
Queriable reg a =>
(reg -> a) -> a -> (a -> a -> Bool) -> STM [DBRef reg]
retrieve reg -> a
field a
value forall a. Ord a => a -> a -> Bool
(<)
    .<=. :: (reg -> a) -> a -> STM [DBRef reg]
(.<=.) reg -> a
field a
value= forall reg a.
Queriable reg a =>
(reg -> a) -> a -> (a -> a -> Bool) -> STM [DBRef reg]
retrieve reg -> a
field a
value forall a. Ord a => a -> a -> Bool
(<=)

    .>=. :: (reg -> a) -> a -> STM [DBRef reg]
(.>=.) reg -> a
field a
value= forall reg a.
Queriable reg a =>
(reg -> a) -> a -> (a -> a -> Bool) -> STM [DBRef reg]
retrieve reg -> a
field a
value forall a. Ord a => a -> a -> Bool
(>=)

join:: (Queriable rec v, Queriable rec' v)
       =>(v->v-> Bool) -> (rec -> v) -> (rec' -> v) -> STM[([DBRef rec], [DBRef rec'])]
join :: forall rec v rec'.
(Queriable rec v, Queriable rec' v) =>
(v -> v -> Bool)
-> (rec -> v) -> (rec' -> v) -> STM [([DBRef rec], [DBRef rec'])]
join v -> v -> Bool
op rec -> v
field1 rec' -> v
field2 =do
  [(v, [DBRef rec])]
idxs   <- forall reg a.
Queriable reg a =>
(reg -> a) -> STM [(a, [DBRef reg])]
indexOf rec -> v
field1
  [(v, [DBRef rec'])]
idxs' <- forall reg a.
Queriable reg a =>
(reg -> a) -> STM [(a, [DBRef reg])]
indexOf rec' -> v
field2
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(v, [DBRef rec])]
-> [(v, [DBRef rec'])] -> [([DBRef rec], [DBRef rec'])]
mix  [(v, [DBRef rec])]
idxs  [(v, [DBRef rec'])]
idxs'
  where
  opv :: (v, [DBRef rec]) -> (v, [DBRef rec']) -> Bool
opv (v
v, [DBRef rec]
_ )(v
v', [DBRef rec']
_)= v
v v -> v -> Bool
`op` v
v'
  mix :: [(v, [DBRef rec])]
-> [(v, [DBRef rec'])] -> [([DBRef rec], [DBRef rec'])]
mix [(v, [DBRef rec])]
xs1  [(v, [DBRef rec'])]
ys1 =
      let zlist :: [((v, [DBRef rec]), (v, [DBRef rec']))]
zlist= [((v, [DBRef rec])
x,(v, [DBRef rec'])
y) |  (v, [DBRef rec])
x <- [(v, [DBRef rec])]
xs1 , (v, [DBRef rec'])
y <- [(v, [DBRef rec'])]
ys1, (v, [DBRef rec])
x (v, [DBRef rec]) -> (v, [DBRef rec']) -> Bool
`opv` (v, [DBRef rec'])
y]
      in forall a b. (a -> b) -> [a] -> [b]
map ( \(( v
_, [DBRef rec]
xs2),(v
_ ,[DBRef rec']
ys2)) ->([DBRef rec]
xs2, [DBRef rec']
ys2)) [((v, [DBRef rec]), (v, [DBRef rec']))]
zlist

type JoinData reg reg'=[([DBRef reg],[DBRef reg'])]

-- Instance of relations betweeen fields
-- field1 .op. field2
instance (Queriable reg a ,Queriable reg' a ) =>RelationOps (reg -> a) (reg' -> a)  (JoinData reg reg') where

    .==. :: (reg -> a) -> (reg' -> a) -> STM (JoinData reg reg')
(.==.)= forall rec v rec'.
(Queriable rec v, Queriable rec' v) =>
(v -> v -> Bool)
-> (rec -> v) -> (rec' -> v) -> STM [([DBRef rec], [DBRef rec'])]
join forall a. Eq a => a -> a -> Bool
(==)
    .>. :: (reg -> a) -> (reg' -> a) -> STM (JoinData reg reg')
(.>.) = forall rec v rec'.
(Queriable rec v, Queriable rec' v) =>
(v -> v -> Bool)
-> (rec -> v) -> (rec' -> v) -> STM [([DBRef rec], [DBRef rec'])]
join forall a. Ord a => a -> a -> Bool
(>)
    .>=. :: (reg -> a) -> (reg' -> a) -> STM (JoinData reg reg')
(.>=.)= forall rec v rec'.
(Queriable rec v, Queriable rec' v) =>
(v -> v -> Bool)
-> (rec -> v) -> (rec' -> v) -> STM [([DBRef rec], [DBRef rec'])]
join forall a. Ord a => a -> a -> Bool
(>=)
    .<=. :: (reg -> a) -> (reg' -> a) -> STM (JoinData reg reg')
(.<=.)= forall rec v rec'.
(Queriable rec v, Queriable rec' v) =>
(v -> v -> Bool)
-> (rec -> v) -> (rec' -> v) -> STM [([DBRef rec], [DBRef rec'])]
join forall a. Ord a => a -> a -> Bool
(<=)
    .<. :: (reg -> a) -> (reg' -> a) -> STM (JoinData reg reg')
(.<.) = forall rec v rec'.
(Queriable rec v, Queriable rec' v) =>
(v -> v -> Bool)
-> (rec -> v) -> (rec' -> v) -> STM [([DBRef rec], [DBRef rec'])]
join forall a. Ord a => a -> a -> Bool
(<)

infixr 5 .==., .>., .>=., .<=., .<.

class SetOperations set set'  setResult | set set' -> setResult where
  (.||.) :: STM set -> STM set' -> STM setResult
  (.&&.) :: STM set -> STM set' -> STM setResult


instance SetOperations  [DBRef a] [DBRef a] [DBRef a] where
    .&&. :: STM [DBRef a] -> STM [DBRef a] -> STM [DBRef a]
(.&&.) STM [DBRef a]
fxs STM [DBRef a]
fys= do
     [DBRef a]
xs <- STM [DBRef a]
fxs
     forall a. Eq a => [a] -> [a] -> [a]
intersect [DBRef a]
xs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM [DBRef a]
fys

    .||. :: STM [DBRef a] -> STM [DBRef a] -> STM [DBRef a]
(.||.) STM [DBRef a]
fxs STM [DBRef a]
fys= do
     [DBRef a]
xs <- STM [DBRef a]
fxs
     forall a. Eq a => [a] -> [a] -> [a]
union [DBRef a]
xs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM [DBRef a]
fys

infixr 4 .&&.
infixr 3 .||.

instance SetOperations  (JoinData a a') [DBRef a] (JoinData a a') where
    .&&. :: STM (JoinData a a') -> STM [DBRef a] -> STM (JoinData a a')
(.&&.) STM (JoinData a a')
fxs STM [DBRef a]
fys= do
     JoinData a a'
xss <- STM (JoinData a a')
fxs
     [DBRef a]
ys <- STM [DBRef a]
fys
     forall (m :: * -> *) a. Monad m => a -> m a
return [([DBRef a]
xs forall a. Eq a => [a] -> [a] -> [a]
`intersect` [DBRef a]
ys, [DBRef a']
zs) | ([DBRef a]
xs,[DBRef a']
zs) <- JoinData a a'
xss]

    .||. :: STM (JoinData a a') -> STM [DBRef a] -> STM (JoinData a a')
(.||.) STM (JoinData a a')
fxs STM [DBRef a]
fys= do
     JoinData a a'
xss <- STM (JoinData a a')
fxs
     [DBRef a]
ys <- STM [DBRef a]
fys
     forall (m :: * -> *) a. Monad m => a -> m a
return [([DBRef a]
xs forall a. Eq a => [a] -> [a] -> [a]
`union` [DBRef a]
ys, [DBRef a']
zs) | ([DBRef a]
xs,[DBRef a']
zs) <- JoinData a a'
xss]

instance SetOperations  [DBRef a] (JoinData a a')  (JoinData a a') where
    .&&. :: STM [DBRef a] -> STM (JoinData a a') -> STM (JoinData a a')
(.&&.) STM [DBRef a]
fxs STM (JoinData a a')
fys=  STM (JoinData a a')
fys forall set set' setResult.
SetOperations set set' setResult =>
STM set -> STM set' -> STM setResult
.&&. STM [DBRef a]
fxs
    .||. :: STM [DBRef a] -> STM (JoinData a a') -> STM (JoinData a a')
(.||.) STM [DBRef a]
fxs STM (JoinData a a')
fys=  STM (JoinData a a')
fys forall set set' setResult.
SetOperations set set' setResult =>
STM set -> STM set' -> STM setResult
.||. STM [DBRef a]
fxs

instance SetOperations  (JoinData a a') [DBRef a'] (JoinData a a') where
    .&&. :: STM (JoinData a a') -> STM [DBRef a'] -> STM (JoinData a a')
(.&&.) STM (JoinData a a')
fxs STM [DBRef a']
fys= do
     JoinData a a'
xss <- STM (JoinData a a')
fxs
     [DBRef a']
ys <- STM [DBRef a']
fys
     forall (m :: * -> *) a. Monad m => a -> m a
return [([DBRef a]
zs, [DBRef a']
xs forall a. Eq a => [a] -> [a] -> [a]
`intersect` [DBRef a']
ys) | ([DBRef a]
zs,[DBRef a']
xs) <- JoinData a a'
xss]

    .||. :: STM (JoinData a a') -> STM [DBRef a'] -> STM (JoinData a a')
(.||.) STM (JoinData a a')
fxs STM [DBRef a']
fys= do
     JoinData a a'
xss <- STM (JoinData a a')
fxs
     [DBRef a']
ys <- STM [DBRef a']
fys
     forall (m :: * -> *) a. Monad m => a -> m a
return [([DBRef a]
zs, [DBRef a']
xs forall a. Eq a => [a] -> [a] -> [a]
`union` [DBRef a']
ys) | ([DBRef a]
zs,[DBRef a']
xs) <- JoinData a a'
xss]


-- |  return all  the (indexed)  values which this field has and a DBRef pointer to the register
indexOf :: (Queriable reg a) => (reg -> a) -> STM [(a,[DBRef reg])]
indexOf :: forall reg a.
Queriable reg a =>
(reg -> a) -> STM [(a, [DBRef reg])]
indexOf reg -> a
selector= do
   let [TypeRep
one, TypeRep
two]= TypeRep -> [TypeRep]
typeRepArgs forall a b. (a -> b) -> a -> b
$! forall a. Typeable a => a -> TypeRep
typeOf reg -> a
selector
   let rindex :: DBRef (Index reg a)
rindex= forall a. (Typeable a, IResource a) => String -> DBRef a
getDBRef forall a b. (a -> b) -> a -> b
$! forall a1 a2. (Show a1, Show a2) => a1 -> a2 -> String
keyIndex TypeRep
one TypeRep
two
   Maybe (Index reg a)
mindex <- forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef DBRef (Index reg a)
rindex
   case Maybe (Index reg a)
mindex of
     Just (Index Map a [DBRef reg]
index1) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map a [DBRef reg]
index1;
     Maybe (Index reg a)
_ -> do
        let fields :: String
fields= forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => a -> TypeRep
typeOf  reg -> a
selector
        forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"the index for "forall a. [a] -> [a] -> [a]
++ String
fields forall a. [a] -> [a] -> [a]
++String
" do not exist. At main, use \"Data.TCache.IndexQuery.index\" to start indexing this field"

retrieve :: Queriable reg a => (reg -> a) -> a -> (a -> a -> Bool) -> STM[DBRef reg]
retrieve :: forall reg a.
Queriable reg a =>
(reg -> a) -> a -> (a -> a -> Bool) -> STM [DBRef reg]
retrieve reg -> a
field a
value a -> a -> Bool
op= do
   [(a, [DBRef reg])]
index1 <- forall reg a.
Queriable reg a =>
(reg -> a) -> STM [(a, [DBRef reg])]
indexOf reg -> a
field
   let higuer :: [[DBRef reg]]
higuer = forall a b. (a -> b) -> [a] -> [b]
map (\(a
v, [DBRef reg]
vals) -> if a -> a -> Bool
op a
v a
value then  [DBRef reg]
vals else [])  [(a, [DBRef reg])]
index1
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[DBRef reg]]
higuer

-- from a Query result, return the records, rather than the references
recordsWith
  :: (IResource a, Typeable a) =>
     STM [DBRef a] -> STM [ a]
recordsWith :: forall a. (IResource a, Typeable a) => STM [DBRef a] -> STM [a]
recordsWith STM [DBRef a]
dbrefs= forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (STM [DBRef a]
dbrefs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef)


class Select  selector a res | selector a -> res  where
  select :: selector -> a -> res


{-
instance (Select sel1 a res1, Select sel2 b res2 )
          => Select (sel1, sel2) (a , b) (res1, res2)  where
  select (sel1,sel2)  (x, y) = (select sel1 x, select sel2 y)
-}


instance (Typeable reg, IResource reg) =>  Select (reg -> a) (STM [DBRef reg])  (STM [a]) where
  select :: (reg -> a) -> STM [DBRef reg] -> STM [a]
select reg -> a
sel STM [DBRef reg]
xs= forall a b. (a -> b) -> [a] -> [b]
map reg -> a
sel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STM [DBRef reg]
xs))


instance  (Typeable reg, IResource reg,
          Select (reg -> a) (STM [DBRef reg])  (STM [a]),
          Select (reg -> b) (STM [DBRef reg])  (STM [b]) )
          =>  Select (reg -> a, reg -> b) (STM [DBRef reg])  (STM [(a,b)])
          where
    select :: (reg -> a, reg -> b) -> STM [DBRef reg] -> STM [(a, b)]
select (reg -> a
sel, reg -> b
sel') STM [DBRef reg]
xs= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\reg
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (reg -> a
sel reg
x, reg -> b
sel' reg
x)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef  forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STM [DBRef reg]
xs)

instance  (Typeable reg, IResource reg,
          Select (reg -> a) (STM [DBRef reg])  (STM [a]),
          Select (reg -> b) (STM [DBRef reg])  (STM [b]),
          Select (reg -> c) (STM [DBRef reg])  (STM [c]) )
          =>  Select (reg -> a, reg -> b, reg -> c) (STM [DBRef reg])  (STM [(a,b,c)])
          where
    select :: (reg -> a, reg -> b, reg -> c)
-> STM [DBRef reg] -> STM [(a, b, c)]
select (reg -> a
sel, reg -> b
sel',reg -> c
sel'') STM [DBRef reg]
xs= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\reg
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (reg -> a
sel reg
x, reg -> b
sel' reg
x, reg -> c
sel'' reg
x)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef  forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STM [DBRef reg]
xs)


instance  (Typeable reg, IResource reg,
          Select (reg -> a) (STM [DBRef reg])  (STM [a]),
          Select (reg -> b) (STM [DBRef reg])  (STM [b]),
          Select (reg -> c) (STM [DBRef reg])  (STM [c]),
          Select (reg -> d) (STM [DBRef reg])  (STM [d]) )
          =>  Select (reg -> a, reg -> b, reg -> c, reg -> d) (STM [DBRef reg])  (STM [(a,b,c,d)])
          where
    select :: (reg -> a, reg -> b, reg -> c, reg -> d)
-> STM [DBRef reg] -> STM [(a, b, c, d)]
select (reg -> a
sel, reg -> b
sel',reg -> c
sel'',reg -> d
sel''') STM [DBRef reg]
xs= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\reg
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (reg -> a
sel reg
x, reg -> b
sel' reg
x, reg -> c
sel'' reg
x, reg -> d
sel''' reg
x)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef  forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STM [DBRef reg]
xs)

-- for join's   (field1 op field2)

instance  (Typeable reg, IResource reg,
          Typeable reg', IResource reg',
          Select (reg -> a) (STM [DBRef reg])  (STM [a]),
          Select (reg' -> b) (STM [DBRef reg'])  (STM [b]) )
          =>  Select (reg -> a, reg' -> b) (STM (JoinData reg reg')) (STM [([a],[b])])
          where
    select :: (reg -> a, reg' -> b)
-> STM (JoinData reg reg') -> STM [([a], [b])]
select (reg -> a
sel, reg' -> b
sel') STM (JoinData reg reg')
xss = STM (JoinData reg reg')
xss forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([DBRef reg], [DBRef reg']) -> STM ([a], [b])
select1
        where
        select1 :: ([DBRef reg], [DBRef reg']) -> STM ([a], [b])
select1 ([DBRef reg]
xs, [DBRef reg']
ys) = do
         [a]
rxs <- forall a b. (a -> b) -> [a] -> [b]
map reg -> a
sel  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [Maybe a] -> [a]
catMaybes  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef  [DBRef reg]
xs)
         [b]
rys <- forall a b. (a -> b) -> [a] -> [b]
map reg' -> b
sel' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [Maybe a] -> [a]
catMaybes  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef  [DBRef reg']
ys)
         forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
rxs,[b]
rys)