module Data.Store.Selection
( (.<)
, (.<=)
, (.>)
, (.>=)
, (./=)
, (.==)
, (.&&)
, (.||)
, not
, all
, all1D
, any
, any1D
, IsSelection(..)
, Selection
) where
import Prelude hiding (not, all, any)
import Data.Monoid ((<>))
import qualified Data.IntSet
import qualified Data.List
import qualified Data.IntMap.Strict as Data.IntMap
import qualified Data.Map.Strict as Data.Map
import qualified Data.Store.Internal.Type as I
moduleName :: String
moduleName = "Data.Store.Selection"
infix 4 .==, ./=, .<, .<=, .>=, .>
infixr 3 .&&
infixr 2 .||
not :: IsSelection sel => sel tag krs irs ts -> Selection tag krs irs ts
not = SelectionNot
all :: [Selection tag krs irs ts] -> Selection tag krs irs ts
all [] = error $ moduleName <> ".all: empty list."
all [s] = s
all (s:rest) = Data.List.foldl' (.&&) s rest
all1D :: (tag, n) -> [(tag, n) -> Selection tag krs irs ts] -> Selection tag krs irs ts
all1D _ [] = error $ moduleName <> ".all1D: empty list."
all1D d [h] = h d
all1D d (h:rest) = Data.List.foldl' (\acc f -> acc .&& f d) (h d) rest
any :: [Selection tag krs irs ts] -> Selection tag krs irs ts
any [] = error $ moduleName <> ".any: empty list."
any (x:xs) = Data.List.foldl' (.||) x xs
any1D :: (tag, n) -> [(tag, n) -> Selection tag krs irs ts] -> Selection tag krs irs ts
any1D _ [] = error $ moduleName <> ".any1D: empty list."
any1D d (x:xs) = Data.List.foldl' (\acc f -> acc .|| f d) (x d) xs
(.<) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
(.<) (_, n) = SelectionType . SelectionDimension n (Condition True False False)
(.<=) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
(.<=) (_, n) = SelectionType . SelectionDimension n (Condition True True False)
(.>) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
(.>) (_, n) = SelectionType . SelectionDimension n (Condition False False True)
(.>=) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
(.>=) (_, n) = SelectionType . SelectionDimension n (Condition False True True)
(./=) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
(./=) (_, n) = SelectionType . SelectionDimension n (Condition True False True)
(.==) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
(.==) (_, n) = SelectionType . SelectionDimension n (Condition False True False)
(.&&) :: (IsSelection s1, IsSelection s2)
=> s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
(.&&) = SelectionA
(.||) :: (IsSelection s1, IsSelection s2)
=> s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
(.||) = SelectionO
instance IsSelection Selection where
resolve (SelectionType sel) s = resolve sel s
resolve (SelectionA s1 s2) s = Data.IntSet.intersection (resolve s1 s) (resolve s2 s)
resolve (SelectionO s1 s2) s = Data.IntSet.union (resolve s1 s) (resolve s2 s)
resolve (SelectionNot sel) s@(I.Store vs _ _) =
Data.IntSet.difference (Data.IntMap.keysSet vs) (resolve sel s)
instance IsSelection (SelectionDimension n) where
resolve = resolveSD
resolveSD :: forall tag n krs irs ts v . SelectionDimension n tag krs irs ts
-> I.Store tag krs irs ts v
-> Data.IntSet.IntSet
resolveSD (SelectionDimension _ (Condition False False False) _) _ = Data.IntSet.empty
resolveSD (SelectionDimension _ (Condition True True True) _) (I.Store vs _ _) = Data.IntSet.fromList $ Data.IntMap.keys vs
resolveSD (SelectionDimension n (Condition lt eq gt) v) (I.Store _ ix _) =
go $! I.getDimension n ix
where
go (I.IndexDimensionO m) = m `seq` case Data.Map.splitLookup v m of
(lk, ek, gk) -> (if lt then trO lk else Data.IntSet.empty) <>
(if eq then trMaybeO ek else Data.IntSet.empty) <>
(if gt then trO gk else Data.IntSet.empty)
go (I.IndexDimensionM m) = m `seq` case Data.Map.splitLookup v m of
(lk, ek, gk) -> (if lt then trM lk else Data.IntSet.empty) <>
(if eq then trMaybeM ek else Data.IntSet.empty) <>
(if gt then trM gk else Data.IntSet.empty)
trO :: Data.Map.Map k Int -> Data.IntSet.IntSet
trO xs = Data.Map.foldl' ins Data.IntSet.empty xs
where ins acc i = Data.IntSet.insert i acc
trMaybeO :: Maybe Int -> Data.IntSet.IntSet
trMaybeO (Just x) = Data.IntSet.singleton x
trMaybeO _ = Data.IntSet.empty
trM :: Data.Map.Map k Data.IntSet.IntSet -> Data.IntSet.IntSet
trM = Data.Map.foldl' Data.IntSet.union Data.IntSet.empty
trMaybeM :: Maybe Data.IntSet.IntSet -> Data.IntSet.IntSet
trMaybeM (Just x) = x
trMaybeM _ = Data.IntSet.empty
data SelectionDimension n tag krs irs ts where
SelectionDimension :: I.GetDimension n (I.Index irs ts)
=> n
-> Condition
-> I.DimensionType n irs ts
-> SelectionDimension n tag krs irs ts
data Selection tag krs irs ts where
SelectionType :: IsSelection sel => sel tag krs irs ts -> Selection tag krs irs ts
SelectionA :: (IsSelection s1, IsSelection s2)
=> s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
SelectionO :: (IsSelection s1, IsSelection s2)
=> s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
SelectionNot :: IsSelection sel => sel tag krs irs ts -> Selection tag krs irs ts
data Condition = Condition !Bool !Bool !Bool
class IsSelection sel where
resolve :: sel tag krs irs ts -> I.Store tag krs irs ts v -> Data.IntSet.IntSet