{-# LANGUAGE UndecidableInstances, FlexibleInstances,
             MultiParamTypeClasses, TemplateHaskell, RankNTypes,
             FunctionalDependencies, DeriveDataTypeable,
             GADTs, CPP, ScopedTypeVariables, KindSignatures,
             DataKinds, TypeOperators, StandaloneDeriving,
             TypeFamilies, ScopedTypeVariables, ConstraintKinds,
             FunctionalDependencies, FlexibleContexts, BangPatterns #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{- |
An efficient implementation of queryable sets.

Assume you have a family of types such as:

> data Entry      = Entry Author [Author] Updated Id Content
>   deriving (Show, Eq, Ord, Data, Typeable)
> newtype Updated = Updated UTCTime
>   deriving (Show, Eq, Ord, Data, Typeable)
> newtype Id      = Id Int64
>   deriving (Show, Eq, Ord, Data, Typeable)
> newtype Content = Content String
>   deriving (Show, Eq, Ord, Data, Typeable)
> newtype Author  = Author Email
>   deriving (Show, Eq, Ord, Data, Typeable)
> type Email      = String
> data Test = Test
>   deriving (Show, Eq, Ord, Data, Typeable)

1. Decide what parts of your type you want indexed and make your type
an instance of 'Indexable'. Use 'ixFun' and 'ixGen' to build indices:

    > type EntryIxs = '[Author, Id, Updated, Test]
    > type IxEntry  = IxSet EntryIxs Entry
    >
    > instance Indexable EntryIxs Entry where
    >   indices = ixList
    >               (ixGen (Proxy :: Proxy Author))        -- out of order
    >               (ixGen (Proxy :: Proxy Id))
    >               (ixGen (Proxy :: Proxy Updated))
    >               (ixGen (Proxy :: Proxy Test))          -- bogus index

    The use of 'ixGen' requires the 'Data' and 'Typeable' instances above.
    You can build indices manually using 'ixFun'. You can also use the
    Template Haskell function 'inferIxSet' to generate an 'Indexable'
    instance automatically.

2. Use 'insert', 'insertList', 'delete', 'updateIx', 'deleteIx'
and 'empty' to build up an 'IxSet' collection:

    > entries  = insertList [e1, e2, e3, e4] (empty :: IxEntry)
    > entries1 = foldr delete entries [e1, e3]
    > entries2 = updateIx (Id 4) e5 entries

3. Use the query functions below to grab data from it:

    > entries @= Author "john@doe.com" @< Updated t1

    Statement above will find all items in entries updated earlier than
    @t1@ by @john\@doe.com@.

4. Text index

    If you want to do add a text index create a calculated index.  Then if you want
    all entries with either @word1@ or @word2@, you change the instance
    to:

    > newtype Word = Word String
    >   deriving (Show, Eq, Ord)
    >
    > getWords (Entry _ _ _ _ (Content s)) = map Word $ words s
    >
    > type EntryIxs = '[..., Word]
    > instance Indexable EntryIxs Entry where
    >     indices = ixList
    >                 ...
    >                 (ixFun getWords)

    Now you can do this query to find entries with any of the words:

    > entries @+ [Word "word1", Word "word2"]

    And if you want all entries with both:

    > entries @* [Word "word1", Word "word2"]

5. Find only the first author

    If an @Entry@ has multiple authors and you want to be able to query on
    the first author only, define a @FirstAuthor@ datatype and create an
    index with this type.  Now you can do:

    > newtype FirstAuthor = FirstAuthor Email
    >   deriving (Show, Eq, Ord)
    >
    > getFirstAuthor (Entry author _ _ _ _) = [FirstAuthor author]
    >
    > type EntryIxs = '[..., FirstAuthor]
    > instance Indexable EntryIxs Entry where
    >     indices = ixList
    >                 ...
    >                 (ixFun getFirstAuthor)

    > entries @= (FirstAuthor "john@doe.com")  -- guess what this does

-}

module Data.IxSet.Typed
    (
     -- * Set type
     IxSet(),
     IxList(),
     Indexable(..),
     IsIndexOf(),
     All,
     -- ** Declaring indices
     Ix(),
     ixList,
     MkIxList(),
     ixFun,
     ixGen,
     -- ** TH derivation of indices
     noCalcs,
     inferIxSet,

     -- * Changes to set
     IndexOp,
     SetOp,
     change,
     insert,
     insertList,
     delete,
     updateIx,
     deleteIx,

     -- * Creation
     empty,
     fromSet,
     fromList,

     -- * Conversion
     toSet,
     toList,
     toAscList,
     toDescList,
     getOne,
     getOneOr,

     -- * Size checking
     size,
     null,

     -- * Set operations
     (&&&),
     (|||),
     union,
     intersection,

     -- * Indexing
     (@=),
     (@<),
     (@>),
     (@<=),
     (@>=),
     (@><),
     (@>=<),
     (@><=),
     (@>=<=),
     (@+),
     (@*),
     getEQ,
     getLT,
     getGT,
     getLTE,
     getGTE,
     getRange,
     groupBy,
     groupAscBy,
     groupDescBy,
     indexKeys,

     -- * Index creation helpers
     flatten,
     flattenWithCalcs,

     -- * Debugging and optimization
     stats
)
where

import Data.Kind
import Prelude hiding (null)

import           Control.Arrow  (first, second)
import           Control.DeepSeq
import qualified Data.Foldable  as Fold
import           Data.Generics  (Data, gmapQ)
-- import qualified Data.Generics.SYB.WithClass.Basics as SYBWC
import qualified Data.IxSet.Typed.Ix  as Ix
import           Data.IxSet.Typed.Ix  (Ix(Ix))
import qualified Data.List      as List
import           Data.Map       (Map)
import qualified Data.Map       as Map
import           Data.Maybe     (fromMaybe)
import           Data.SafeCopy  (SafeCopy(..), contain, safeGet, safePut)
import           Data.Semigroup (Semigroup(..))
import           Data.Set       (Set)
import qualified Data.Set       as Set
import           Data.Typeable  (Typeable, cast {- , typeOf -})
import Language.Haskell.TH      as TH hiding (Type)

--------------------------------------------------------------------------
-- The main 'IxSet' datatype.
--------------------------------------------------------------------------

-- | Set with associated indices.
--
-- The type-level list 'ixs' contains all types that are valid index keys.
-- The type 'a' is the type of elements in the indexed set.
--
-- On strictness: An 'IxSet' is "mostly" spine-strict. It is generally
-- spine-strict in the set itself. All operations on 'IxSet' with the
-- exception of queries are spine-strict in the indices as well. Query
-- operations, however, are lazy in the indices, so querying a number of
-- times and subsequently selecting the result will not unnecessarily
-- rebuild all indices.
--
data IxSet (ixs :: [Type]) (a :: Type) where
  IxSet :: !(Set a) -> !(IxList ixs a) -> IxSet ixs a

data IxList (ixs :: [Type]) (a :: Type) where
  Nil   :: IxList '[] a
  (:::) :: Ix ix a -> IxList ixs a -> IxList (ix ': ixs) a

infixr 5 :::

-- | A strict variant of ':::'.
(!:::) :: Ix ix a -> IxList ixs a -> IxList (ix ': ixs) a
!::: :: Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
(!:::) !Ix ix a
ix !IxList ixs a
ixs = Ix ix a
ix Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
forall ix a (ixs :: [*]).
Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
::: IxList ixs a
ixs

infixr 5 !:::

-- TODO:
--
-- We cannot currently derive Typeable for 'IxSet':
--
--   * In ghc-7.6, Typeable isn't supported for non-* kinds.
--   * In ghc-7.8, see bug #8950. We can work around this, but I rather
--     would wait for a proper fix.

-- deriving instance Data (IxSet ixs a)
-- deriving instance Typeable IxSet


--------------------------------------------------------------------------
-- Type-level tools for dealing with indexed sets.
--
-- These are partially internal. TODO: Move to different module?
--------------------------------------------------------------------------

-- | The constraint @All c xs@ says the @c@ has to hold for all
-- elements in the type-level list @xs@.
--
-- Example:
--
-- > All Ord '[Int, Char, Bool]
--
-- is equivalent to
--
-- > (Ord Int, Ord Char, Ord Bool)
--
type family All (c :: Type -> Constraint) (xs :: [Type]) :: Constraint
type instance All c '[]       = ()
type instance All c (x ': xs) = (c x, All c xs)

-- | Associate indices with a given type. The constraint
-- @'Indexable' ixs a@ says that we know how to build index sets
-- of type @'IxSet' ixs a@.
--
-- In order to use an 'IxSet' on a particular type, you have to
-- make it an instance of 'Indexable' yourself. There are no
-- predefined instances of 'IxSet'.
--
class (All Ord ixs, Ord a) => Indexable ixs a where

  -- | Define how the indices for this particular type should look like.
  --
  -- Use the 'ixList' function to construct the list of indices, and use
  -- 'ixFun' (or 'ixGen') for individual indices.
  indices :: IxList ixs a

-- | Constraint for membership in the type-level list. Says that 'ix'
-- is contained in the index list 'ixs'.
class Ord ix => IsIndexOf (ix :: Type) (ixs :: [Type]) where

  -- | Provide access to the selected index in the list.
  access :: IxList ixs a -> Ix ix a

  -- | Map over the index list, treating the selected different
  -- from the rest.
  --
  -- The function 'mapAt' is lazy in the index list structure,
  -- because it is used by query operations.
  mapAt :: (All Ord ixs)
        => (Ix ix a -> Ix ix a)
              -- ^ what to do with the selected index
        -> (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)
              -- ^ what to do with the other indices
        -> IxList ixs a -> IxList ixs a

instance
  {-# OVERLAPPING #-}
  Ord ix => IsIndexOf ix (ix ': ixs) where
  access :: IxList (ix : ixs) a -> Ix ix a
access (Ix ix a
x ::: IxList ixs a
_xs)     = Ix ix a
Ix ix a
x
  mapAt :: (Ix ix a -> Ix ix a)
-> (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)
-> IxList (ix : ixs) a
-> IxList (ix : ixs) a
mapAt Ix ix a -> Ix ix a
fh forall ix'. Ord ix' => Ix ix' a -> Ix ix' a
ft (Ix ix a
x ::: IxList ixs a
xs) = Ix ix a -> Ix ix a
fh Ix ix a
Ix ix a
x Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
forall ix a (ixs :: [*]).
Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
::: (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)
-> IxList ixs a -> IxList ixs a
forall (ixs :: [*]) a.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
mapIxList forall ix'. Ord ix' => Ix ix' a -> Ix ix' a
ft IxList ixs a
xs

instance
  {-# OVERLAPPABLE #-}
  IsIndexOf ix ixs => IsIndexOf ix (ix' ': ixs) where
  access :: IxList (ix' : ixs) a -> Ix ix a
access (Ix ix a
_x ::: IxList ixs a
xs)     = IxList ixs a -> Ix ix a
forall ix (ixs :: [*]) a.
IsIndexOf ix ixs =>
IxList ixs a -> Ix ix a
access IxList ixs a
xs
  mapAt :: (Ix ix a -> Ix ix a)
-> (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)
-> IxList (ix' : ixs) a
-> IxList (ix' : ixs) a
mapAt Ix ix a -> Ix ix a
fh forall ix'. Ord ix' => Ix ix' a -> Ix ix' a
ft (Ix ix a
x ::: IxList ixs a
xs) = Ix ix a -> Ix ix a
forall ix'. Ord ix' => Ix ix' a -> Ix ix' a
ft Ix ix a
x Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
forall ix a (ixs :: [*]).
Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
::: (Ix ix a -> Ix ix a)
-> (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)
-> IxList ixs a
-> IxList ixs a
forall ix (ixs :: [*]) a.
(IsIndexOf ix ixs, All Ord ixs) =>
(Ix ix a -> Ix ix a)
-> (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)
-> IxList ixs a
-> IxList ixs a
mapAt Ix ix a -> Ix ix a
fh forall ix'. Ord ix' => Ix ix' a -> Ix ix' a
ft IxList ixs a
xs

-- | Return the length of an index list.
--
-- TODO: Could be statically unrolled.
lengthIxList :: forall ixs a. IxList ixs a -> Int
lengthIxList :: IxList ixs a -> Int
lengthIxList = Int -> IxList ixs a -> Int
forall (ixs' :: [*]). Int -> IxList ixs' a -> Int
go Int
0
  where
    go :: forall ixs'. Int -> IxList ixs' a -> Int
    go :: Int -> IxList ixs' a -> Int
go !Int
acc IxList ixs' a
Nil        = Int
acc
    go !Int
acc (Ix ix a
_ ::: IxList ixs a
xs) = Int -> IxList ixs a -> Int
forall (ixs' :: [*]). Int -> IxList ixs' a -> Int
go (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) IxList ixs a
xs

-- | Turn an index list into a normal list, given a function that
-- turns an arbitrary index into an element of a fixed type @r@.
ixListToList :: All Ord ixs
             => (forall ix. Ord ix => Ix ix a -> r)
                  -- ^ what to do with each index
             -> IxList ixs a -> [r]
ixListToList :: (forall ix. Ord ix => Ix ix a -> r) -> IxList ixs a -> [r]
ixListToList forall ix. Ord ix => Ix ix a -> r
_ IxList ixs a
Nil        = []
ixListToList forall ix. Ord ix => Ix ix a -> r
f (Ix ix a
x ::: IxList ixs a
xs) = Ix ix a -> r
forall ix. Ord ix => Ix ix a -> r
f Ix ix a
x r -> [r] -> [r]
forall a. a -> [a] -> [a]
: (forall ix. Ord ix => Ix ix a -> r) -> IxList ixs a -> [r]
forall (ixs :: [*]) a r.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> r) -> IxList ixs a -> [r]
ixListToList forall ix. Ord ix => Ix ix a -> r
f IxList ixs a
xs

-- | Map over an index list.
mapIxList :: All Ord ixs
          => (forall ix. Ord ix => Ix ix a -> Ix ix a)
                -- ^ what to do with each index
          -> IxList ixs a -> IxList ixs a
mapIxList :: (forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
mapIxList forall ix. Ord ix => Ix ix a -> Ix ix a
_ IxList ixs a
Nil        = IxList ixs a
forall a. IxList '[] a
Nil
mapIxList forall ix. Ord ix => Ix ix a -> Ix ix a
f (Ix ix a
x ::: IxList ixs a
xs) = Ix ix a -> Ix ix a
forall ix. Ord ix => Ix ix a -> Ix ix a
f Ix ix a
x Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
forall ix a (ixs :: [*]).
Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
::: (forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
forall (ixs :: [*]) a.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
mapIxList forall ix. Ord ix => Ix ix a -> Ix ix a
f IxList ixs a
xs

-- | Map over an index list (spine-strict).
mapIxList' :: All Ord ixs
           => (forall ix. Ord ix => Ix ix a -> Ix ix a)
                 -- ^ what to do with each index
           -> IxList ixs a -> IxList ixs a
mapIxList' :: (forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
mapIxList' forall ix. Ord ix => Ix ix a -> Ix ix a
_ IxList ixs a
Nil        = IxList ixs a
forall a. IxList '[] a
Nil
mapIxList' forall ix. Ord ix => Ix ix a -> Ix ix a
f (Ix ix a
x ::: IxList ixs a
xs) = Ix ix a -> Ix ix a
forall ix. Ord ix => Ix ix a -> Ix ix a
f Ix ix a
x Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
forall ix a (ixs :: [*]).
Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
!::: (forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
forall (ixs :: [*]) a.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
mapIxList' forall ix. Ord ix => Ix ix a -> Ix ix a
f IxList ixs a
xs

-- | Zip two index lists of compatible type (spine-strict).
zipWithIxList' :: All Ord ixs
               => (forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a)
                    -- ^ how to combine two corresponding indices
               -> IxList ixs a -> IxList ixs a -> IxList ixs a
zipWithIxList' :: (forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a -> IxList ixs a
zipWithIxList' forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a
_ IxList ixs a
Nil        IxList ixs a
Nil        = IxList ixs a
forall a. IxList '[] a
Nil
zipWithIxList' forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a
f (Ix ix a
x ::: IxList ixs a
xs) (Ix ix a
y ::: IxList ixs a
ys) = Ix ix a -> Ix ix a -> Ix ix a
forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a
f Ix ix a
x Ix ix a
Ix ix a
y Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
forall ix a (ixs :: [*]).
Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
!::: (forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a -> IxList ixs a
forall (ixs :: [*]) a.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a -> IxList ixs a
zipWithIxList' forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a
f IxList ixs a
xs IxList ixs a
IxList ixs a
ys
#if __GLASGOW_HASKELL__ < 800
zipWithIxList' _ _          _          = error "Data.IxSet.Typed.zipWithIxList: impossible"
  -- the line above is actually impossible by the types; it's just there
  -- to please avoid the warning resulting from the exhaustiveness check
#endif

--------------------------------------------------------------------------
-- Various instances for 'IxSet'
--------------------------------------------------------------------------

instance Indexable ixs a => Eq (IxSet ixs a) where
  IxSet Set a
a IxList ixs a
_ == :: IxSet ixs a -> IxSet ixs a -> Bool
== IxSet Set a
b IxList ixs a
_ = Set a
a Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== Set a
b

instance Indexable ixs a => Ord (IxSet ixs a) where
  compare :: IxSet ixs a -> IxSet ixs a -> Ordering
compare (IxSet Set a
a IxList ixs a
_) (IxSet Set a
b IxList ixs a
_) = Set a -> Set a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Set a
a Set a
b

instance (Indexable ixs a, Show a) => Show (IxSet ixs a) where
  showsPrec :: Int -> IxSet ixs a -> ShowS
showsPrec Int
prec = Int -> Set a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
prec (Set a -> ShowS) -> (IxSet ixs a -> Set a) -> IxSet ixs a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet ixs a -> Set a
forall (ixs :: [*]) a. IxSet ixs a -> Set a
toSet

instance (Indexable ixs a, Read a) => Read (IxSet ixs a) where
  readsPrec :: Int -> ReadS (IxSet ixs a)
readsPrec Int
n = ((Set a, String) -> (IxSet ixs a, String))
-> [(Set a, String)] -> [(IxSet ixs a, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> IxSet ixs a) -> (Set a, String) -> (IxSet ixs a, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Set a -> IxSet ixs a
forall (ixs :: [*]) a. Indexable ixs a => Set a -> IxSet ixs a
fromSet) ([(Set a, String)] -> [(IxSet ixs a, String)])
-> (String -> [(Set a, String)]) -> ReadS (IxSet ixs a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Set a, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
n

instance (Indexable ixs a, Typeable ixs, SafeCopy a, Typeable a) => SafeCopy (IxSet ixs a) where
  putCopy :: IxSet ixs a -> Contained Put
putCopy = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put)
-> (IxSet ixs a -> Put) -> IxSet ixs a -> Contained Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Put
forall a. SafeCopy a => a -> Put
safePut ([a] -> Put) -> (IxSet ixs a -> [a]) -> IxSet ixs a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet ixs a -> [a]
forall (ixs :: [*]) a. IxSet ixs a -> [a]
toList
  getCopy :: Contained (Get (IxSet ixs a))
getCopy = Get (IxSet ixs a) -> Contained (Get (IxSet ixs a))
forall a. a -> Contained a
contain (Get (IxSet ixs a) -> Contained (Get (IxSet ixs a)))
-> Get (IxSet ixs a) -> Contained (Get (IxSet ixs a))
forall a b. (a -> b) -> a -> b
$ ([a] -> IxSet ixs a) -> Get [a] -> Get (IxSet ixs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> IxSet ixs a
forall (ixs :: [*]) a. Indexable ixs a => [a] -> IxSet ixs a
fromList Get [a]
forall a. SafeCopy a => Get a
safeGet

instance (All NFData ixs, NFData a) => NFData (IxList ixs a) where
  rnf :: IxList ixs a -> ()
rnf IxList ixs a
Nil        = ()
  rnf (Ix ix a
x ::: IxList ixs a
xs) = Ix ix a -> ()
forall a. NFData a => a -> ()
rnf Ix ix a
x () -> () -> ()
`seq` IxList ixs a -> ()
forall a. NFData a => a -> ()
rnf IxList ixs a
xs

instance (All NFData ixs, NFData a) => NFData (IxSet ixs a) where
  rnf :: IxSet ixs a -> ()
rnf (IxSet Set a
a IxList ixs a
ixs) = Set a -> ()
forall a. NFData a => a -> ()
rnf Set a
a () -> () -> ()
`seq` IxList ixs a -> ()
forall a. NFData a => a -> ()
rnf IxList ixs a
ixs

instance Indexable ixs a => Semigroup (IxSet ixs a) where
  <> :: IxSet ixs a -> IxSet ixs a -> IxSet ixs a
(<>) = IxSet ixs a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
IxSet ixs a -> IxSet ixs a -> IxSet ixs a
union

instance Indexable ixs a => Monoid (IxSet ixs a) where
  mempty :: IxSet ixs a
mempty  = IxSet ixs a
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty
  mappend :: IxSet ixs a -> IxSet ixs a -> IxSet ixs a
mappend = IxSet ixs a -> IxSet ixs a -> IxSet ixs a
forall a. Semigroup a => a -> a -> a
(<>)

instance Foldable (IxSet ixs) where
  fold :: IxSet ixs m -> m
fold      = Set m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Fold.fold      (Set m -> m) -> (IxSet ixs m -> Set m) -> IxSet ixs m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet ixs m -> Set m
forall (ixs :: [*]) a. IxSet ixs a -> Set a
toSet
  foldMap :: (a -> m) -> IxSet ixs a -> m
foldMap a -> m
f = (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Fold.foldMap a -> m
f (Set a -> m) -> (IxSet ixs a -> Set a) -> IxSet ixs a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet ixs a -> Set a
forall (ixs :: [*]) a. IxSet ixs a -> Set a
toSet
  foldr :: (a -> b -> b) -> b -> IxSet ixs a -> b
foldr a -> b -> b
f b
z = (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr a -> b -> b
f b
z (Set a -> b) -> (IxSet ixs a -> Set a) -> IxSet ixs a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet ixs a -> Set a
forall (ixs :: [*]) a. IxSet ixs a -> Set a
toSet
  foldl :: (b -> a -> b) -> b -> IxSet ixs a -> b
foldl b -> a -> b
f b
z = (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl b -> a -> b
f b
z (Set a -> b) -> (IxSet ixs a -> Set a) -> IxSet ixs a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet ixs a -> Set a
forall (ixs :: [*]) a. IxSet ixs a -> Set a
toSet

-- TODO: Do we need SYBWC?
{-
instance ( SYBWC.Data ctx a
         , SYBWC.Data ctx [a]
         , SYBWC.Sat (ctx (IxSet a))
         , SYBWC.Sat (ctx [a])
         , Indexable a
         , Data a
         , Ord a
         )
       => SYBWC.Data ctx (IxSet a) where
    gfoldl _ f z ixset  = z fromList `f` toList ixset
    toConstr _ (IxSet _) = ixSetConstr
    gunfold _ k z c  = case SYBWC.constrIndex c of
                       1 -> k (z fromList)
                       _ -> error "IxSet.SYBWC.Data.gunfold unexpected match"
    dataTypeOf _ _ = ixSetDataType

ixSetConstr :: SYBWC.Constr
ixSetConstr = SYBWC.mkConstr ixSetDataType "IxSet" [] SYBWC.Prefix
ixSetDataType :: SYBWC.DataType
ixSetDataType = SYBWC.mkDataType "IxSet" [ixSetConstr]
-}

-- TODO: Do we need Default?
{- FIXME
instance (Indexable a, Ord a,Data a, Default a) => Default (IxSet a) where
    defaultValue = empty
-}

--------------------------------------------------------------------------
-- 'IxSet' construction
--------------------------------------------------------------------------

-- | An empty 'IxSet'.
empty :: Indexable ixs a => IxSet ixs a
empty :: IxSet ixs a
empty = Set a -> IxList ixs a -> IxSet ixs a
forall a (ixs :: [*]). Set a -> IxList ixs a -> IxSet ixs a
IxSet Set a
forall a. Set a
Set.empty IxList ixs a
forall (ixs :: [*]) a. Indexable ixs a => IxList ixs a
indices

-- | Create an (empty) 'IxList' from a number of indices. Useful in the 'Indexable'
-- 'indices' method. Use 'ixFun' and 'ixGen' for the individual indices.
--
-- Note that this function takes a variable number of arguments.
-- Here are some example types at which the function can be used:
--
-- > ixList :: Ix ix1 a -> IxList '[ix1] a
-- > ixList :: Ix ix1 a -> Ix ix2 a -> IxList '[ix1, ix2] a
-- > ixList :: Ix ix1 a -> Ix ix2 a -> Ix ix3 a -> IxList '[ix1, ix2, ix3] a
-- > ixList :: ...
--
-- Concrete example use:
--
-- > instance Indexable '[..., Index1Type, Index2Type] Type where
-- >     indices = ixList
-- >                 ...
-- >                 (ixFun getIndex1)
-- >                 (ixGen (Proxy :: Proxy Index2Type))
--
ixList :: MkIxList ixs ixs a r => r
ixList :: r
ixList = (IxList ixs a -> IxList ixs a) -> r
forall (ixs :: [*]) (ixs' :: [*]) a r.
MkIxList ixs ixs' a r =>
(IxList ixs a -> IxList ixs' a) -> r
ixList' IxList ixs a -> IxList ixs a
forall a. a -> a
id

-- | Class that allows a variable number of arguments to be passed to the
-- 'ixSet' and 'mkEmpty' functions. See the documentation of these functions
-- for more information.
class MkIxList ixs ixs' a r | r -> a ixs ixs' where
  ixList' :: (IxList ixs a -> IxList ixs' a) -> r

instance MkIxList '[] ixs a (IxList ixs a) where
  ixList' :: (IxList '[] a -> IxList ixs a) -> IxList ixs a
ixList' IxList '[] a -> IxList ixs a
acc = IxList '[] a -> IxList ixs a
acc IxList '[] a
forall a. IxList '[] a
Nil

instance MkIxList ixs ixs' a r => MkIxList (ix ': ixs) ixs' a (Ix ix a -> r) where
  ixList' :: (IxList (ix : ixs) a -> IxList ixs' a) -> Ix ix a -> r
ixList' IxList (ix : ixs) a -> IxList ixs' a
acc Ix ix a
ix = (IxList ixs a -> IxList ixs' a) -> r
forall (ixs :: [*]) (ixs' :: [*]) a r.
MkIxList ixs ixs' a r =>
(IxList ixs a -> IxList ixs' a) -> r
ixList' (\ IxList ixs a
x -> IxList (ix : ixs) a -> IxList ixs' a
acc (Ix ix a
ix Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
forall ix a (ixs :: [*]).
Ix ix a -> IxList ixs a -> IxList (ix : ixs) a
::: IxList ixs a
x))

-- | Create a functional index. Provided function should return a list
-- of indices where the value should be found.
--
-- > getIndices :: Type -> [IndexType]
-- > getIndices value = [...indices...]
--
-- > instance Indexable '[IndexType] Type where
-- >     indices = ixList (ixFun getIndices)
--
-- This is the recommended way to create indices.
--
ixFun :: Ord ix => (a -> [ix]) -> Ix ix a
ixFun :: (a -> [ix]) -> Ix ix a
ixFun = Map ix (Set a) -> (a -> [ix]) -> Ix ix a
forall ix a. Map ix (Set a) -> (a -> [ix]) -> Ix ix a
Ix Map ix (Set a)
forall k a. Map k a
Map.empty

-- | Create a generic index. Provided example is used only as type source
-- so you may use a 'Proxy'. This uses flatten to traverse values using
-- their 'Data' instances.
--
-- > instance Indexable '[IndexType] Type where
-- >     indices = ixList (ixGen (Proxy :: Proxy Type))
--
-- In production systems consider using 'ixFun' in place of 'ixGen' as
-- the former one is much faster.
--
ixGen :: forall proxy a ix. (Ord ix, Data a, Typeable ix) => proxy ix -> Ix ix a
ixGen :: proxy ix -> Ix ix a
ixGen proxy ix
_proxy = (a -> [ix]) -> Ix ix a
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun (a -> [ix]
forall a b. (Typeable a, Data a, Typeable b) => a -> [b]
flatten :: a -> [ix])

--------------------------------------------------------------------------
-- 'IxSet' construction via Template Haskell
--------------------------------------------------------------------------

-- | Function to be used as third argument in 'inferIxSet'
-- when you don't want any calculated values.
noCalcs :: t -> ()
noCalcs :: t -> ()
noCalcs t
_ = ()

-- | Template Haskell helper function for automatically building an
-- 'Indexable' instance from a data type, e.g.
--
-- > data Foo = Foo Int String
-- >   deriving (Eq, Ord, Data, Typeable)
--
-- and
--
-- > inferIxSet "FooDB" ''Foo 'noCalcs [''Int, ''String]
--
-- will define:
--
-- > type FooDB = IxSet '[Int, String] Foo
-- > instance Indexable '[Int, String] Foo where
-- >   ...
--
-- with @Int@ and @String@ as indices defined via
--
-- >   ixFun (flattenWithCalcs noCalcs)
--
-- each.
--
-- /WARNING/: This function uses 'flattenWithCalcs' for index generation,
-- which in turn uses an SYB type-based traversal. It is often more efficient
-- (and sometimes more correct) to explicitly define the indices using
-- 'ixFun'.
--
inferIxSet :: String -> TH.Name -> TH.Name -> [TH.Name] -> Q [Dec]
inferIxSet :: String -> Name -> Name -> [Name] -> Q [Dec]
inferIxSet String
_ Name
_ Name
_ [] = String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"inferIxSet needs at least one index"
inferIxSet String
ixset Name
typeName Name
calName [Name]
entryPoints
    = do Info
calInfo <- Name -> Q Info
reify Name
calName
         Info
typeInfo <- Name -> Q Info
reify Name
typeName
         let (Cxt
context,[TyVarBndr]
binders) = case Info
typeInfo of
#if MIN_VERSION_template_haskell(2,11,0)
                                 TyConI (DataD Cxt
ctxt Name
_ [TyVarBndr]
nms Maybe Kind
_ [Con]
_ [DerivClause]
_) -> (Cxt
ctxt,[TyVarBndr]
nms)
                                 TyConI (NewtypeD Cxt
ctxt Name
_ [TyVarBndr]
nms Maybe Kind
_ Con
_ [DerivClause]
_) -> (Cxt
ctxt,[TyVarBndr]
nms)
#else
                                 TyConI (DataD ctxt _ nms _ _) -> (ctxt,nms)
                                 TyConI (NewtypeD ctxt _ nms _ _) -> (ctxt,nms)
#endif

                                 TyConI (TySynD Name
_ [TyVarBndr]
nms Kind
_) -> ([],[TyVarBndr]
nms)
                                 Info
_ -> String -> (Cxt, [TyVarBndr])
forall a. HasCallStack => String -> a
error String
"IxSet.inferIxSet typeInfo unexpected match"

             names :: [Name]
names = (TyVarBndr -> Name) -> [TyVarBndr] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Name
tyVarBndrToName [TyVarBndr]
binders

             typeCon :: TypeQ
typeCon = (TypeQ -> TypeQ -> TypeQ) -> TypeQ -> [TypeQ] -> TypeQ
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' TypeQ -> TypeQ -> TypeQ
appT (Name -> TypeQ
conT Name
typeName) ((Name -> TypeQ) -> [Name] -> [TypeQ]
forall a b. (a -> b) -> [a] -> [b]
map Name -> TypeQ
varT [Name]
names)
#if MIN_VERSION_template_haskell(2,10,0)
             mkCtx :: Name -> t TypeQ -> TypeQ
mkCtx Name
c = (TypeQ -> TypeQ -> TypeQ) -> TypeQ -> t TypeQ -> TypeQ
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' TypeQ -> TypeQ -> TypeQ
appT (Name -> TypeQ
conT Name
c)
#else
             mkCtx = classP
#endif
             dataCtxConQ :: [TypeQ]
dataCtxConQ = [[TypeQ]] -> [TypeQ]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name -> [TypeQ] -> TypeQ
forall (t :: * -> *). Foldable t => Name -> t TypeQ -> TypeQ
mkCtx ''Data [Name -> TypeQ
varT Name
name], Name -> [TypeQ] -> TypeQ
forall (t :: * -> *). Foldable t => Name -> t TypeQ -> TypeQ
mkCtx ''Ord [Name -> TypeQ
varT Name
name]] | Name
name <- [Name]
names]
             fullContext :: Q Cxt
fullContext = do
                Cxt
dataCtxCon <- [TypeQ] -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [TypeQ]
dataCtxConQ
                Cxt -> Q Cxt
forall (m :: * -> *) a. Monad m => a -> m a
return (Cxt
context Cxt -> Cxt -> Cxt
forall a. [a] -> [a] -> [a]
++ Cxt
dataCtxCon)
         case Info
calInfo of
#if MIN_VERSION_template_haskell(2,11,0)
           VarI Name
_ Kind
_t Maybe Dec
_ ->
#else
           VarI _ _t _ _ ->
#endif
               let {-
                   calType = getCalType t
                   getCalType (ForallT _names _ t') = getCalType t'
                   getCalType (AppT (AppT ArrowT _) t') = t'
                   getCalType t' = error ("Unexpected type in getCalType: " ++ pprint t')
                   -}
                   mkEntryPoint :: Name -> ExpQ
mkEntryPoint Name
n = (Name -> ExpQ
conE 'Ix) ExpQ -> ExpQ -> ExpQ
`appE`
                                    (ExpQ -> TypeQ -> ExpQ
sigE (Name -> ExpQ
varE 'Map.empty) ([TyVarBndr] -> Q Cxt -> TypeQ -> TypeQ
forallT
#if MIN_VERSION_template_haskell(2,17,0)
                                                             (map (SpecifiedSpec <$) binders)
#else
                                                             [TyVarBndr]
binders
#endif
                                                             (Cxt -> Q Cxt
forall (m :: * -> *) a. Monad m => a -> m a
return Cxt
context) (TypeQ -> TypeQ) -> TypeQ -> TypeQ
forall a b. (a -> b) -> a -> b
$
                                                             TypeQ -> TypeQ -> TypeQ
appT (TypeQ -> TypeQ -> TypeQ
appT (Name -> TypeQ
conT ''Map) (Name -> TypeQ
conT Name
n))
                                                                      (TypeQ -> TypeQ -> TypeQ
appT (Name -> TypeQ
conT ''Set) TypeQ
typeCon))) ExpQ -> ExpQ -> ExpQ
`appE`
                                    (Name -> ExpQ
varE 'flattenWithCalcs ExpQ -> ExpQ -> ExpQ
`appE` Name -> ExpQ
varE Name
calName)
                   mkTypeList :: [TypeQ] -> TypeQ
                   mkTypeList :: [TypeQ] -> TypeQ
mkTypeList = (TypeQ -> TypeQ -> TypeQ) -> TypeQ -> [TypeQ] -> TypeQ
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ TypeQ
x TypeQ
xs -> TypeQ
promotedConsT TypeQ -> TypeQ -> TypeQ
`appT` TypeQ
x TypeQ -> TypeQ -> TypeQ
`appT` TypeQ
xs) TypeQ
promotedNilT
                   typeList :: TypeQ
                   typeList :: TypeQ
typeList = [TypeQ] -> TypeQ
mkTypeList ((Name -> TypeQ) -> [Name] -> [TypeQ]
forall a b. (a -> b) -> [a] -> [b]
map Name -> TypeQ
conT [Name]
entryPoints)
               in do Dec
i <- Q Cxt -> TypeQ -> [DecQ] -> DecQ
instanceD (Q Cxt
fullContext)
                          (Name -> TypeQ
conT ''Indexable TypeQ -> TypeQ -> TypeQ
`appT` TypeQ
typeList TypeQ -> TypeQ -> TypeQ
`appT` TypeQ
typeCon)
                          [PatQ -> BodyQ -> [DecQ] -> DecQ
valD (Name -> PatQ
varP 'indices) (ExpQ -> BodyQ
normalB ([ExpQ] -> ExpQ
appsE ([| ixList |] ExpQ -> [ExpQ] -> [ExpQ]
forall a. a -> [a] -> [a]
: (Name -> ExpQ) -> [Name] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
map Name -> ExpQ
mkEntryPoint [Name]
entryPoints))) []]
                     let ixType :: TypeQ
ixType = Name -> TypeQ
conT ''IxSet TypeQ -> TypeQ -> TypeQ
`appT` TypeQ
typeList TypeQ -> TypeQ -> TypeQ
`appT` TypeQ
typeCon
                     Dec
ixType' <- Name -> [TyVarBndr] -> TypeQ -> DecQ
tySynD (String -> Name
mkName String
ixset) [TyVarBndr]
binders TypeQ
ixType
                     [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec
i, Dec
ixType']  -- ++ d
           Info
_ -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"IxSet.inferIxSet calInfo unexpected match"

#if MIN_VERSION_template_haskell(2,17,0)
tyVarBndrToName :: TyVarBndr () -> Name
tyVarBndrToName (PlainTV nm _) = nm
tyVarBndrToName (KindedTV nm _ _) = nm
#else
tyVarBndrToName :: TyVarBndr -> Name
tyVarBndrToName :: TyVarBndr -> Name
tyVarBndrToName (PlainTV Name
nm) = Name
nm
tyVarBndrToName (KindedTV Name
nm Kind
_) = Name
nm
#endif

-- | Generically traverses the argument to find all occurences of
-- values of type @b@ and returns them as a list.
--
-- This function properly handles 'String' as 'String' not as @['Char']@.
flatten :: (Typeable a, Data a, Typeable b) => a -> [b]
flatten :: a -> [b]
flatten a
x = case a -> Maybe String
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x of
              Just String
y -> case String -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast (String
y :: String) of
                          Just b
v -> [b
v]
                          Maybe b
Nothing -> []
              Maybe String
Nothing -> case a -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x of
                           Just b
v -> b
v b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((forall d. Data d => d -> [b]) -> a -> [[b]]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall d. Data d => d -> [b]
forall a b. (Typeable a, Data a, Typeable b) => a -> [b]
flatten a
x)
                           Maybe b
Nothing -> [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((forall d. Data d => d -> [b]) -> a -> [[b]]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall d. Data d => d -> [b]
forall a b. (Typeable a, Data a, Typeable b) => a -> [b]
flatten a
x)

-- | Generically traverses the argument and calculated values to find
-- all occurences of values of type @b@ and returns them as a
-- list. Equivalent to:
--
-- > flatten (x,calcs x)
--
-- This function properly handles 'String' as 'String' not as @['Char']@.
flattenWithCalcs :: (Data c,Typeable a, Data a, Typeable b) => (a -> c) -> a -> [b]
flattenWithCalcs :: (a -> c) -> a -> [b]
flattenWithCalcs a -> c
calcs a
x = (a, c) -> [b]
forall a b. (Typeable a, Data a, Typeable b) => a -> [b]
flatten (a
x,a -> c
calcs a
x)

--------------------------------------------------------------------------
-- Modification of 'IxSet's
--------------------------------------------------------------------------

type SetOp =
    forall a. Ord a => a -> Set a -> Set a

type IndexOp =
    forall k a. (Ord k,Ord a) => k -> a -> Map k (Set a) -> Map k (Set a)

-- | Higher order operator for modifying 'IxSet's.  Use this when your
-- final function should have the form @a -> 'IxSet' a -> 'IxSet' a@,
-- e.g. 'insert' or 'delete'.
change :: forall ixs a. Indexable ixs a
       => SetOp -> IndexOp -> a -> IxSet ixs a -> IxSet ixs a
change :: SetOp -> IndexOp -> a -> IxSet ixs a -> IxSet ixs a
change SetOp
opS IndexOp
opI a
x (IxSet Set a
a IxList ixs a
indexes) = Set a -> IxList ixs a -> IxSet ixs a
forall a (ixs :: [*]). Set a -> IxList ixs a -> IxSet ixs a
IxSet (a -> Set a -> Set a
SetOp
opS a
x Set a
a) IxList ixs a
v
  where
    v :: IxList ixs a
    v :: IxList ixs a
v = (forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
forall (ixs :: [*]) a.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
mapIxList' forall ix. Ord ix => Ix ix a -> Ix ix a
update IxList ixs a
indexes

    update :: forall ix. Ord ix => Ix ix a -> Ix ix a
    update :: Ix ix a -> Ix ix a
update (Ix Map ix (Set a)
index a -> [ix]
f) = Map ix (Set a) -> (a -> [ix]) -> Ix ix a
forall ix a. Map ix (Set a) -> (a -> [ix]) -> Ix ix a
Ix Map ix (Set a)
index' a -> [ix]
f
      where
        ds :: [ix]
        ds :: [ix]
ds = a -> [ix]
f a
x
        ii :: forall k. Ord k => Map k (Set a) -> k -> Map k (Set a)
        ii :: Map k (Set a) -> k -> Map k (Set a)
ii Map k (Set a)
m k
dkey = k -> a -> Map k (Set a) -> Map k (Set a)
IndexOp
opI k
dkey a
x Map k (Set a)
m
        index' :: Map ix (Set a)
        index' :: Map ix (Set a)
index' = (Map ix (Set a) -> ix -> Map ix (Set a))
-> Map ix (Set a) -> [ix] -> Map ix (Set a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map ix (Set a) -> ix -> Map ix (Set a)
forall k. Ord k => Map k (Set a) -> k -> Map k (Set a)
ii Map ix (Set a)
index [ix]
ds

insertList :: forall ixs a. Indexable ixs a
           => [a] -> IxSet ixs a -> IxSet ixs a
insertList :: [a] -> IxSet ixs a -> IxSet ixs a
insertList [a]
xs (IxSet Set a
a IxList ixs a
indexes) = Set a -> IxList ixs a -> IxSet ixs a
forall a (ixs :: [*]). Set a -> IxList ixs a -> IxSet ixs a
IxSet ((Set a -> a -> Set a) -> Set a -> [a] -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\ Set a
b a
x -> a -> Set a -> Set a
SetOp
Set.insert a
x Set a
b) Set a
a [a]
xs) IxList ixs a
v
  where
    v :: IxList ixs a
    v :: IxList ixs a
v = (forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
forall (ixs :: [*]) a.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a
mapIxList' forall ix. Ord ix => Ix ix a -> Ix ix a
update IxList ixs a
indexes

    update :: forall ix. Ord ix => Ix ix a -> Ix ix a
    update :: Ix ix a -> Ix ix a
update (Ix Map ix (Set a)
index a -> [ix]
f) = Map ix (Set a) -> (a -> [ix]) -> Ix ix a
forall ix a. Map ix (Set a) -> (a -> [ix]) -> Ix ix a
Ix Map ix (Set a)
index' a -> [ix]
f
      where
        dss :: [(ix, a)]
        dss :: [(ix, a)]
dss = [(ix
k, a
x) | a
x <- [a]
xs, ix
k <- a -> [ix]
f a
x]

        index' :: Map ix (Set a)
        index' :: Map ix (Set a)
index' = [(ix, a)] -> Map ix (Set a) -> Map ix (Set a)
forall a k.
(Ord a, Ord k) =>
[(k, a)] -> Map k (Set a) -> Map k (Set a)
Ix.insertList [(ix, a)]
dss Map ix (Set a)
index

-- | Internal helper function that takes a partial index from one index
-- set and rebuilds the rest of the structure of the index set.
--
-- Slightly rewritten comment from original version regarding dss / index':
--
-- We try to be really clever here. The partialindex is a Map of Sets
-- from original index. We want to reuse it as much as possible. If there
-- was a guarantee that each element is present at at most one key we
-- could reuse originalindex as it is. But there can be more, so we need to
-- add remaining ones (in updateh). Anyway we try to reuse old structure and
-- keep new allocations low as much as possible.
fromMapOfSets :: forall ixs ix a. (Indexable ixs a, IsIndexOf ix ixs)
              => Map ix (Set a) -> IxSet ixs a
fromMapOfSets :: Map ix (Set a) -> IxSet ixs a
fromMapOfSets Map ix (Set a)
partialindex =
    Set a -> IxList ixs a -> IxSet ixs a
forall a (ixs :: [*]). Set a -> IxList ixs a -> IxSet ixs a
IxSet Set a
a ((Ix ix a -> Ix ix a)
-> (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)
-> IxList ixs a
-> IxList ixs a
forall ix (ixs :: [*]) a.
(IsIndexOf ix ixs, All Ord ixs) =>
(Ix ix a -> Ix ix a)
-> (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)
-> IxList ixs a
-> IxList ixs a
mapAt Ix ix a -> Ix ix a
updateh forall ix'. Ord ix' => Ix ix' a -> Ix ix' a
updatet IxList ixs a
forall (ixs :: [*]) a. Indexable ixs a => IxList ixs a
indices)
  where
    a :: Set a
    a :: Set a
a = [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (Map ix (Set a) -> [Set a]
forall k a. Map k a -> [a]
Map.elems Map ix (Set a)
partialindex)

    xs :: [a]
    xs :: [a]
xs = Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
a

    -- Update function for the index corresponding to partialindex.
    updateh :: Ix ix a -> Ix ix a
    updateh :: Ix ix a -> Ix ix a
updateh (Ix Map ix (Set a)
_ a -> [ix]
f) = Map ix (Set a) -> (a -> [ix]) -> Ix ix a
forall ix a. Map ix (Set a) -> (a -> [ix]) -> Ix ix a
Ix Map ix (Set a)
ix a -> [ix]
f
      where
        dss :: [(ix, a)]
        dss :: [(ix, a)]
dss = [(ix
k, a
x) | a
x <- [a]
xs, ix
k <- a -> [ix]
f a
x, Bool -> Bool
not (ix -> Map ix (Set a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member ix
k Map ix (Set a)
partialindex)]

        ix :: Map ix (Set a)
        ix :: Map ix (Set a)
ix = [(ix, a)] -> Map ix (Set a) -> Map ix (Set a)
forall a k.
(Ord a, Ord k) =>
[(k, a)] -> Map k (Set a) -> Map k (Set a)
Ix.insertList [(ix, a)]
dss Map ix (Set a)
partialindex

    -- Update function for all other indices.
    updatet :: forall ix'. Ord ix' => Ix ix' a -> Ix ix' a
    updatet :: Ix ix' a -> Ix ix' a
updatet (Ix Map ix' (Set a)
_ a -> [ix']
f) = Map ix' (Set a) -> (a -> [ix']) -> Ix ix' a
forall ix a. Map ix (Set a) -> (a -> [ix]) -> Ix ix a
Ix Map ix' (Set a)
ix a -> [ix']
f
      where
        dss :: [(ix', a)]
        dss :: [(ix', a)]
dss = [(ix'
k, a
x) | a
x <- [a]
xs, ix'
k <- a -> [ix']
f a
x]

        ix :: Map ix' (Set a)
        ix :: Map ix' (Set a)
ix = [(ix', a)] -> Map ix' (Set a)
forall a k. (Ord a, Ord k) => [(k, a)] -> Map k (Set a)
Ix.fromList [(ix', a)]
dss

-- | Inserts an item into the 'IxSet'. If your data happens to have
-- a primary key this function might not be what you want. See
-- 'updateIx'.
insert :: Indexable ixs a => a -> IxSet ixs a -> IxSet ixs a
insert :: a -> IxSet ixs a -> IxSet ixs a
insert = SetOp -> IndexOp -> a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
SetOp -> IndexOp -> a -> IxSet ixs a -> IxSet ixs a
change SetOp
Set.insert IndexOp
forall a k.
(Ord a, Ord k) =>
k -> a -> Map k (Set a) -> Map k (Set a)
Ix.insert

-- | Removes an item from the 'IxSet'.
delete :: Indexable ixs a => a -> IxSet ixs a -> IxSet ixs a
delete :: a -> IxSet ixs a -> IxSet ixs a
delete = SetOp -> IndexOp -> a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
SetOp -> IndexOp -> a -> IxSet ixs a -> IxSet ixs a
change SetOp
Set.delete IndexOp
forall a k.
(Ord a, Ord k) =>
k -> a -> Map k (Set a) -> Map k (Set a)
Ix.delete

-- | Will replace the item with the given index of type 'ix'.
-- Only works if there is at most one item with that index in the 'IxSet'.
-- Will not change 'IxSet' if you have more than one item with given index.
updateIx :: (Indexable ixs a, IsIndexOf ix ixs)
         => ix -> a -> IxSet ixs a -> IxSet ixs a
updateIx :: ix -> a -> IxSet ixs a -> IxSet ixs a
updateIx ix
i a
new IxSet ixs a
ixset = a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
insert a
new (IxSet ixs a -> IxSet ixs a) -> IxSet ixs a -> IxSet ixs a
forall a b. (a -> b) -> a -> b
$
                     IxSet ixs a -> (a -> IxSet ixs a) -> Maybe a -> IxSet ixs a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IxSet ixs a
ixset ((a -> IxSet ixs a -> IxSet ixs a)
-> IxSet ixs a -> a -> IxSet ixs a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
delete IxSet ixs a
ixset) (Maybe a -> IxSet ixs a) -> Maybe a -> IxSet ixs a
forall a b. (a -> b) -> a -> b
$
                     IxSet ixs a -> Maybe a
forall a (ixs :: [*]). Ord a => IxSet ixs a -> Maybe a
getOne (IxSet ixs a -> Maybe a) -> IxSet ixs a -> Maybe a
forall a b. (a -> b) -> a -> b
$ IxSet ixs a
ixset IxSet ixs a -> ix -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@= ix
i

-- | Will delete the item with the given index of type 'ix'.
-- Only works if there is at  most one item with that index in the 'IxSet'.
-- Will not change 'IxSet' if you have more than one item with given index.
deleteIx :: (Indexable ixs a, IsIndexOf ix ixs)
         => ix -> IxSet ixs a -> IxSet ixs a
deleteIx :: ix -> IxSet ixs a -> IxSet ixs a
deleteIx ix
i IxSet ixs a
ixset = IxSet ixs a -> (a -> IxSet ixs a) -> Maybe a -> IxSet ixs a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IxSet ixs a
ixset ((a -> IxSet ixs a -> IxSet ixs a)
-> IxSet ixs a -> a -> IxSet ixs a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
delete IxSet ixs a
ixset) (Maybe a -> IxSet ixs a) -> Maybe a -> IxSet ixs a
forall a b. (a -> b) -> a -> b
$
                       IxSet ixs a -> Maybe a
forall a (ixs :: [*]). Ord a => IxSet ixs a -> Maybe a
getOne (IxSet ixs a -> Maybe a) -> IxSet ixs a -> Maybe a
forall a b. (a -> b) -> a -> b
$ IxSet ixs a
ixset IxSet ixs a -> ix -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@= ix
i


--------------------------------------------------------------------------
-- Conversions
--------------------------------------------------------------------------

-- | Converts an 'IxSet' to a 'Set' of its elements.
toSet :: IxSet ixs a -> Set a
toSet :: IxSet ixs a -> Set a
toSet (IxSet Set a
a IxList ixs a
_) = Set a
a

-- | Converts a 'Set' to an 'IxSet'.
fromSet :: (Indexable ixs a) => Set a -> IxSet ixs a
fromSet :: Set a -> IxSet ixs a
fromSet = [a] -> IxSet ixs a
forall (ixs :: [*]) a. Indexable ixs a => [a] -> IxSet ixs a
fromList ([a] -> IxSet ixs a) -> (Set a -> [a]) -> Set a -> IxSet ixs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList

-- | Converts a list to an 'IxSet'.
fromList :: (Indexable ixs a) => [a] -> IxSet ixs a
fromList :: [a] -> IxSet ixs a
fromList [a]
list = [a] -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
[a] -> IxSet ixs a -> IxSet ixs a
insertList [a]
list IxSet ixs a
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty

-- | Returns the number of unique items in the 'IxSet'.
size :: IxSet ixs a -> Int
size :: IxSet ixs a -> Int
size = Set a -> Int
forall a. Set a -> Int
Set.size (Set a -> Int) -> (IxSet ixs a -> Set a) -> IxSet ixs a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet ixs a -> Set a
forall (ixs :: [*]) a. IxSet ixs a -> Set a
toSet

-- | Converts an 'IxSet' to its list of elements.
toList :: IxSet ixs a -> [a]
toList :: IxSet ixs a -> [a]
toList = Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> (IxSet ixs a -> Set a) -> IxSet ixs a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet ixs a -> Set a
forall (ixs :: [*]) a. IxSet ixs a -> Set a
toSet

-- | Converts an 'IxSet' to its list of elements.
--
-- List will be sorted in ascending order by the index 'ix'.
--
-- The list may contain duplicate entries if a single value produces multiple keys.
toAscList :: forall proxy ix ixs a. IsIndexOf ix ixs => proxy ix -> IxSet ixs a -> [a]
toAscList :: proxy ix -> IxSet ixs a -> [a]
toAscList proxy ix
_ IxSet ixs a
ixset = ((ix, [a]) -> [a]) -> [(ix, [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ix, [a]) -> [a]
forall a b. (a, b) -> b
snd (IxSet ixs a -> [(ix, [a])]
forall ix (ixs :: [*]) a.
IsIndexOf ix ixs =>
IxSet ixs a -> [(ix, [a])]
groupAscBy IxSet ixs a
ixset :: [(ix, [a])])

-- | Converts an 'IxSet' to its list of elements.
--
-- List will be sorted in descending order by the index 'ix'.
--
-- The list may contain duplicate entries if a single value produces multiple keys.
toDescList :: forall proxy ix ixs a. IsIndexOf ix ixs => proxy ix -> IxSet ixs a -> [a]
toDescList :: proxy ix -> IxSet ixs a -> [a]
toDescList proxy ix
_ IxSet ixs a
ixset = ((ix, [a]) -> [a]) -> [(ix, [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ix, [a]) -> [a]
forall a b. (a, b) -> b
snd (IxSet ixs a -> [(ix, [a])]
forall ix (ixs :: [*]) a.
IsIndexOf ix ixs =>
IxSet ixs a -> [(ix, [a])]
groupDescBy IxSet ixs a
ixset :: [(ix, [a])])

-- | If the 'IxSet' is a singleton it will return the one item stored in it.
-- If 'IxSet' is empty or has many elements this function returns 'Nothing'.
getOne :: Ord a => IxSet ixs a -> Maybe a
getOne :: IxSet ixs a -> Maybe a
getOne IxSet ixs a
ixset = case IxSet ixs a -> [a]
forall (ixs :: [*]) a. IxSet ixs a -> [a]
toList IxSet ixs a
ixset of
                   [a
x] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                   [a]
_   -> Maybe a
forall a. Maybe a
Nothing

-- | Like 'getOne' with a user-provided default.
getOneOr :: Ord a => a -> IxSet ixs a -> a
getOneOr :: a -> IxSet ixs a -> a
getOneOr a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> (IxSet ixs a -> Maybe a) -> IxSet ixs a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet ixs a -> Maybe a
forall a (ixs :: [*]). Ord a => IxSet ixs a -> Maybe a
getOne

-- | Return 'True' if the 'IxSet' is empty, 'False' otherwise.
null :: IxSet ixs a -> Bool
null :: IxSet ixs a -> Bool
null (IxSet Set a
a IxList ixs a
_) = Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
a

--------------------------------------------------------------------------
-- Set operations
--------------------------------------------------------------------------

-- | An infix 'intersection' operation.
(&&&) :: Indexable ixs a => IxSet ixs a -> IxSet ixs a -> IxSet ixs a
&&& :: IxSet ixs a -> IxSet ixs a -> IxSet ixs a
(&&&) = IxSet ixs a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
IxSet ixs a -> IxSet ixs a -> IxSet ixs a
intersection

-- | An infix 'union' operation.
(|||) :: Indexable ixs a => IxSet ixs a -> IxSet ixs a -> IxSet ixs a
||| :: IxSet ixs a -> IxSet ixs a -> IxSet ixs a
(|||) = IxSet ixs a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
IxSet ixs a -> IxSet ixs a -> IxSet ixs a
union

infixr 5 &&&
infixr 5 |||

-- | Takes the union of the two 'IxSet's.
union :: Indexable ixs a => IxSet ixs a -> IxSet ixs a -> IxSet ixs a
union :: IxSet ixs a -> IxSet ixs a -> IxSet ixs a
union (IxSet Set a
a1 IxList ixs a
x1) (IxSet Set a
a2 IxList ixs a
x2) =
  Set a -> IxList ixs a -> IxSet ixs a
forall a (ixs :: [*]). Set a -> IxList ixs a -> IxSet ixs a
IxSet (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
a1 Set a
a2)
    ((forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a -> IxList ixs a
forall (ixs :: [*]) a.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a -> IxList ixs a
zipWithIxList' (\ (Ix Map ix (Set a)
a a -> [ix]
f) (Ix Map ix (Set a)
b a -> [ix]
_) -> Map ix (Set a) -> (a -> [ix]) -> Ix ix a
forall ix a. Map ix (Set a) -> (a -> [ix]) -> Ix ix a
Ix (Map ix (Set a) -> Map ix (Set a) -> Map ix (Set a)
forall a k.
(Ord a, Ord k) =>
Map k (Set a) -> Map k (Set a) -> Map k (Set a)
Ix.union Map ix (Set a)
a Map ix (Set a)
b) a -> [ix]
f) IxList ixs a
x1 IxList ixs a
x2)
-- TODO: function is taken from the first

-- | Takes the intersection of the two 'IxSet's.
intersection :: Indexable ixs a => IxSet ixs a -> IxSet ixs a -> IxSet ixs a
intersection :: IxSet ixs a -> IxSet ixs a -> IxSet ixs a
intersection (IxSet Set a
a1 IxList ixs a
x1) (IxSet Set a
a2 IxList ixs a
x2) =
  Set a -> IxList ixs a -> IxSet ixs a
forall a (ixs :: [*]). Set a -> IxList ixs a -> IxSet ixs a
IxSet (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set a
a1 Set a
a2)
    ((forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a -> IxList ixs a
forall (ixs :: [*]) a.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a)
-> IxList ixs a -> IxList ixs a -> IxList ixs a
zipWithIxList' (\ (Ix Map ix (Set a)
a a -> [ix]
f) (Ix Map ix (Set a)
b a -> [ix]
_) -> Map ix (Set a) -> (a -> [ix]) -> Ix ix a
forall ix a. Map ix (Set a) -> (a -> [ix]) -> Ix ix a
Ix (Map ix (Set a) -> Map ix (Set a) -> Map ix (Set a)
forall a k.
(Ord a, Ord k) =>
Map k (Set a) -> Map k (Set a) -> Map k (Set a)
Ix.intersection Map ix (Set a)
a Map ix (Set a)
b) a -> [ix]
f) IxList ixs a
x1 IxList ixs a
x2)
-- TODO: function is taken from the first

--------------------------------------------------------------------------
-- Query operations
--------------------------------------------------------------------------

-- | Infix version of 'getEQ'.
(@=) :: (Indexable ixs a, IsIndexOf ix ixs)
     => IxSet ixs a -> ix -> IxSet ixs a
IxSet ixs a
ix @= :: IxSet ixs a -> ix -> IxSet ixs a
@= ix
v = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getEQ ix
v IxSet ixs a
ix

-- | Infix version of 'getLT'.
(@<) :: (Indexable ixs a, IsIndexOf ix ixs)
     => IxSet ixs a -> ix -> IxSet ixs a
IxSet ixs a
ix @< :: IxSet ixs a -> ix -> IxSet ixs a
@< ix
v = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getLT ix
v IxSet ixs a
ix

-- | Infix version of 'getGT'.
(@>) :: (Indexable ixs a, IsIndexOf ix ixs)
     => IxSet ixs a -> ix -> IxSet ixs a
IxSet ixs a
ix @> :: IxSet ixs a -> ix -> IxSet ixs a
@> ix
v = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getGT ix
v IxSet ixs a
ix

-- | Infix version of 'getLTE'.
(@<=) :: (Indexable ixs a, IsIndexOf ix ixs)
      => IxSet ixs a -> ix -> IxSet ixs a
IxSet ixs a
ix @<= :: IxSet ixs a -> ix -> IxSet ixs a
@<= ix
v = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getLTE ix
v IxSet ixs a
ix

-- | Infix version of 'getGTE'.
(@>=) :: (Indexable ixs a, IsIndexOf ix ixs)
      => IxSet ixs a -> ix -> IxSet ixs a
IxSet ixs a
ix @>= :: IxSet ixs a -> ix -> IxSet ixs a
@>= ix
v = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getGTE ix
v IxSet ixs a
ix

-- | Returns the subset with indices in the open interval (k,k).
(@><) :: (Indexable ixs a, IsIndexOf ix ixs)
      => IxSet ixs a -> (ix, ix) -> IxSet ixs a
IxSet ixs a
ix @>< :: IxSet ixs a -> (ix, ix) -> IxSet ixs a
@>< (ix
v1,ix
v2) = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getLT ix
v2 (IxSet ixs a -> IxSet ixs a) -> IxSet ixs a -> IxSet ixs a
forall a b. (a -> b) -> a -> b
$ ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getGT ix
v1 IxSet ixs a
ix

-- | Returns the subset with indices in [k,k).
(@>=<) :: (Indexable ixs a, IsIndexOf ix ixs)
       => IxSet ixs a -> (ix, ix) -> IxSet ixs a
IxSet ixs a
ix @>=< :: IxSet ixs a -> (ix, ix) -> IxSet ixs a
@>=< (ix
v1,ix
v2) = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getLT ix
v2 (IxSet ixs a -> IxSet ixs a) -> IxSet ixs a -> IxSet ixs a
forall a b. (a -> b) -> a -> b
$ ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getGTE ix
v1 IxSet ixs a
ix

-- | Returns the subset with indices in (k,k].
(@><=) :: (Indexable ixs a, IsIndexOf ix ixs)
       => IxSet ixs a -> (ix, ix) -> IxSet ixs a
IxSet ixs a
ix @><= :: IxSet ixs a -> (ix, ix) -> IxSet ixs a
@><= (ix
v1,ix
v2) = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getLTE ix
v2 (IxSet ixs a -> IxSet ixs a) -> IxSet ixs a -> IxSet ixs a
forall a b. (a -> b) -> a -> b
$ ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getGT ix
v1 IxSet ixs a
ix

-- | Returns the subset with indices in [k,k].
(@>=<=) :: (Indexable ixs a, IsIndexOf ix ixs)
        => IxSet ixs a -> (ix, ix) -> IxSet ixs a
IxSet ixs a
ix @>=<= :: IxSet ixs a -> (ix, ix) -> IxSet ixs a
@>=<= (ix
v1,ix
v2) = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getLTE ix
v2 (IxSet ixs a -> IxSet ixs a) -> IxSet ixs a -> IxSet ixs a
forall a b. (a -> b) -> a -> b
$ ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getGTE ix
v1 IxSet ixs a
ix

-- | Creates the subset that has an index in the provided list.
(@+) :: (Indexable ixs a, IsIndexOf ix ixs)
     => IxSet ixs a -> [ix] -> IxSet ixs a
IxSet ixs a
ix @+ :: IxSet ixs a -> [ix] -> IxSet ixs a
@+ [ix]
list = (IxSet ixs a -> IxSet ixs a -> IxSet ixs a)
-> IxSet ixs a -> [IxSet ixs a] -> IxSet ixs a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' IxSet ixs a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
IxSet ixs a -> IxSet ixs a -> IxSet ixs a
union IxSet ixs a
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty ([IxSet ixs a] -> IxSet ixs a) -> [IxSet ixs a] -> IxSet ixs a
forall a b. (a -> b) -> a -> b
$ (ix -> IxSet ixs a) -> [ix] -> [IxSet ixs a]
forall a b. (a -> b) -> [a] -> [b]
map (IxSet ixs a
ix IxSet ixs a -> ix -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@=) [ix]
list

-- | Creates the subset that matches all the provided indices.
(@*) :: (Indexable ixs a, IsIndexOf ix ixs)
     => IxSet ixs a -> [ix] -> IxSet ixs a
IxSet ixs a
ix @* :: IxSet ixs a -> [ix] -> IxSet ixs a
@* [ix]
list = (IxSet ixs a -> IxSet ixs a -> IxSet ixs a)
-> IxSet ixs a -> [IxSet ixs a] -> IxSet ixs a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' IxSet ixs a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a.
Indexable ixs a =>
IxSet ixs a -> IxSet ixs a -> IxSet ixs a
intersection IxSet ixs a
ix ([IxSet ixs a] -> IxSet ixs a) -> [IxSet ixs a] -> IxSet ixs a
forall a b. (a -> b) -> a -> b
$ (ix -> IxSet ixs a) -> [ix] -> [IxSet ixs a]
forall a b. (a -> b) -> [a] -> [b]
map (IxSet ixs a
ix IxSet ixs a -> ix -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@=) [ix]
list

-- | Returns the subset with an index equal to the provided key.  The
-- set must be indexed over key type, doing otherwise results in
-- runtime error.
getEQ :: (Indexable ixs a, IsIndexOf ix ixs)
      => ix -> IxSet ixs a -> IxSet ixs a
getEQ :: ix -> IxSet ixs a -> IxSet ixs a
getEQ = Ordering -> ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
Ordering -> ix -> IxSet ixs a -> IxSet ixs a
getOrd Ordering
EQ

-- | Returns the subset with an index less than the provided key.  The
-- set must be indexed over key type, doing otherwise results in
-- runtime error.
getLT :: (Indexable ixs a, IsIndexOf ix ixs)
      => ix -> IxSet ixs a -> IxSet ixs a
getLT :: ix -> IxSet ixs a -> IxSet ixs a
getLT = Ordering -> ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
Ordering -> ix -> IxSet ixs a -> IxSet ixs a
getOrd Ordering
LT

-- | Returns the subset with an index greater than the provided key.
-- The set must be indexed over key type, doing otherwise results in
-- runtime error.
getGT :: (Indexable ixs a, IsIndexOf ix ixs)
      => ix -> IxSet ixs a -> IxSet ixs a
getGT :: ix -> IxSet ixs a -> IxSet ixs a
getGT = Ordering -> ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
Ordering -> ix -> IxSet ixs a -> IxSet ixs a
getOrd Ordering
GT

-- | Returns the subset with an index less than or equal to the
-- provided key.  The set must be indexed over key type, doing
-- otherwise results in runtime error.
getLTE :: (Indexable ixs a, IsIndexOf ix ixs)
       => ix -> IxSet ixs a -> IxSet ixs a
getLTE :: ix -> IxSet ixs a -> IxSet ixs a
getLTE = Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) ix a.
(Indexable ixs a, IsIndexOf ix ixs) =>
Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
getOrd2 Bool
True Bool
True Bool
False

-- | Returns the subset with an index greater than or equal to the
-- provided key.  The set must be indexed over key type, doing
-- otherwise results in runtime error.
getGTE :: (Indexable ixs a, IsIndexOf ix ixs)
       => ix -> IxSet ixs a -> IxSet ixs a
getGTE :: ix -> IxSet ixs a -> IxSet ixs a
getGTE = Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) ix a.
(Indexable ixs a, IsIndexOf ix ixs) =>
Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
getOrd2 Bool
False Bool
True Bool
True

-- | Returns the subset with an index within the interval provided.
-- The bottom of the interval is closed and the top is open,
-- i. e. [k1;k2).  The set must be indexed over key type, doing
-- otherwise results in runtime error.
getRange :: (Indexable ixs a, IsIndexOf ix ixs)
         => ix -> ix -> IxSet ixs a -> IxSet ixs a
getRange :: ix -> ix -> IxSet ixs a -> IxSet ixs a
getRange ix
k1 ix
k2 IxSet ixs a
ixset = ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getGTE ix
k1 (ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
getLT ix
k2 IxSet ixs a
ixset)

-- | Returns lists of elements paired with the indices determined by
-- type inference.
groupBy :: forall ix ixs a. IsIndexOf ix ixs => IxSet ixs a -> [(ix, [a])]
groupBy :: IxSet ixs a -> [(ix, [a])]
groupBy (IxSet Set a
_ IxList ixs a
indexes) = Ix ix a -> [(ix, [a])]
f (IxList ixs a -> Ix ix a
forall ix (ixs :: [*]) a.
IsIndexOf ix ixs =>
IxList ixs a -> Ix ix a
access IxList ixs a
indexes)
  where
    f :: Ix ix a -> [(ix, [a])]
    f :: Ix ix a -> [(ix, [a])]
f (Ix Map ix (Set a)
index a -> [ix]
_) = ((ix, Set a) -> (ix, [a])) -> [(ix, Set a)] -> [(ix, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> [a]) -> (ix, Set a) -> (ix, [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Set a -> [a]
forall a. Set a -> [a]
Set.toList) (Map ix (Set a) -> [(ix, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ix (Set a)
index)

-- | Returns the list of index keys being used for a particular index.
indexKeys :: forall ix ixs a . IsIndexOf ix ixs => IxSet ixs a -> [ix]
indexKeys :: IxSet ixs a -> [ix]
indexKeys (IxSet Set a
_ IxList ixs a
indexes) = Ix ix a -> [ix]
f (IxList ixs a -> Ix ix a
forall ix (ixs :: [*]) a.
IsIndexOf ix ixs =>
IxList ixs a -> Ix ix a
access IxList ixs a
indexes)
  where
    f :: Ix ix a -> [ix]
    f :: Ix ix a -> [ix]
f (Ix Map ix (Set a)
index a -> [ix]
_) = Map ix (Set a) -> [ix]
forall k a. Map k a -> [k]
Map.keys Map ix (Set a)
index

-- | Returns lists of elements paired with the indices determined by
-- type inference.
--
-- The resulting list will be sorted in ascending order by 'ix'.
-- The values in @[a]@ will be sorted in ascending order as well.
groupAscBy :: forall ix ixs a. IsIndexOf ix ixs =>  IxSet ixs a -> [(ix, [a])]
groupAscBy :: IxSet ixs a -> [(ix, [a])]
groupAscBy (IxSet Set a
_ IxList ixs a
indexes) = Ix ix a -> [(ix, [a])]
f (IxList ixs a -> Ix ix a
forall ix (ixs :: [*]) a.
IsIndexOf ix ixs =>
IxList ixs a -> Ix ix a
access IxList ixs a
indexes)
  where
    f :: Ix ix a -> [(ix, [a])]
    f :: Ix ix a -> [(ix, [a])]
f (Ix Map ix (Set a)
index a -> [ix]
_) = ((ix, Set a) -> (ix, [a])) -> [(ix, Set a)] -> [(ix, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> [a]) -> (ix, Set a) -> (ix, [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Set a -> [a]
forall a. Set a -> [a]
Set.toAscList) (Map ix (Set a) -> [(ix, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map ix (Set a)
index)

-- | Returns lists of elements paired with the indices determined by
-- type inference.
--
-- The resulting list will be sorted in descending order by 'ix'.
--
-- NOTE: The values in @[a]@ are currently sorted in ascending
-- order. But this may change if someone bothers to add
-- 'Set.toDescList'. So do not rely on the sort order of the
-- resulting list.
groupDescBy :: IsIndexOf ix ixs =>  IxSet ixs a -> [(ix, [a])]
groupDescBy :: IxSet ixs a -> [(ix, [a])]
groupDescBy (IxSet Set a
_ IxList ixs a
indexes) = Ix ix a -> [(ix, [a])]
forall ix a. Ix ix a -> [(ix, [a])]
f (IxList ixs a -> Ix ix a
forall ix (ixs :: [*]) a.
IsIndexOf ix ixs =>
IxList ixs a -> Ix ix a
access IxList ixs a
indexes)
  where
    f :: Ix ix a -> [(ix, [a])]
    f :: Ix ix a -> [(ix, [a])]
f (Ix Map ix (Set a)
index a -> [ix]
_) = ((ix, Set a) -> (ix, [a])) -> [(ix, Set a)] -> [(ix, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> [a]) -> (ix, Set a) -> (ix, [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Set a -> [a]
forall a. Set a -> [a]
Set.toAscList) (Map ix (Set a) -> [(ix, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toDescList Map ix (Set a)
index)

-- | A function for building up selectors on 'IxSet's.  Used in the
-- various get* functions.  The set must be indexed over key type,
-- doing otherwise results in runtime error.

getOrd :: (Indexable ixs a, IsIndexOf ix ixs)
       => Ordering -> ix -> IxSet ixs a -> IxSet ixs a
getOrd :: Ordering -> ix -> IxSet ixs a -> IxSet ixs a
getOrd Ordering
LT = Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) ix a.
(Indexable ixs a, IsIndexOf ix ixs) =>
Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
getOrd2 Bool
True Bool
False Bool
False
getOrd Ordering
EQ = Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) ix a.
(Indexable ixs a, IsIndexOf ix ixs) =>
Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
getOrd2 Bool
False Bool
True Bool
False
getOrd Ordering
GT = Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [*]) ix a.
(Indexable ixs a, IsIndexOf ix ixs) =>
Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
getOrd2 Bool
False Bool
False Bool
True

-- | A function for building up selectors on 'IxSet's.  Used in the
-- various get* functions.  The set must be indexed over key type,
-- doing otherwise results in runtime error.
getOrd2 :: forall ixs ix a. (Indexable ixs a, IsIndexOf ix ixs)
        => Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
getOrd2 :: Bool -> Bool -> Bool -> ix -> IxSet ixs a -> IxSet ixs a
getOrd2 Bool
inclt Bool
inceq Bool
incgt ix
v (IxSet Set a
_ IxList ixs a
ixs) = Ix ix a -> IxSet ixs a
f (IxList ixs a -> Ix ix a
forall ix (ixs :: [*]) a.
IsIndexOf ix ixs =>
IxList ixs a -> Ix ix a
access IxList ixs a
ixs)
  where
    f :: Ix ix a -> IxSet ixs a
    f :: Ix ix a -> IxSet ixs a
f (Ix Map ix (Set a)
index a -> [ix]
_) = Map ix (Set a) -> IxSet ixs a
forall (ixs :: [*]) ix a.
(Indexable ixs a, IsIndexOf ix ixs) =>
Map ix (Set a) -> IxSet ixs a
fromMapOfSets Map ix (Set a)
result
      where
        lt', gt' :: Map ix (Set a)
        eq' :: Maybe (Set a)
        (Map ix (Set a)
lt', Maybe (Set a)
eq', Map ix (Set a)
gt') = ix
-> Map ix (Set a)
-> (Map ix (Set a), Maybe (Set a), Map ix (Set a))
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup ix
v Map ix (Set a)
index

        lt, gt :: Map ix (Set a)
        lt :: Map ix (Set a)
lt = if Bool
inclt then Map ix (Set a)
lt' else Map ix (Set a)
forall k a. Map k a
Map.empty
        gt :: Map ix (Set a)
gt = if Bool
incgt then Map ix (Set a)
gt' else Map ix (Set a)
forall k a. Map k a
Map.empty
        eq :: Maybe (Set a)
        eq :: Maybe (Set a)
eq = if Bool
inceq then Maybe (Set a)
eq' else Maybe (Set a)
forall a. Maybe a
Nothing

        ltgt :: Map ix (Set a)
        ltgt :: Map ix (Set a)
ltgt = (Set a -> Set a -> Set a)
-> Map ix (Set a) -> Map ix (Set a) -> Map ix (Set a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Map ix (Set a)
lt Map ix (Set a)
gt

        result :: Map ix (Set a)
        result :: Map ix (Set a)
result = case Maybe (Set a)
eq of
          Just Set a
eqset -> (Set a -> Set a -> Set a)
-> ix -> Set a -> Map ix (Set a) -> Map ix (Set a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union ix
v Set a
eqset Map ix (Set a)
ltgt
          Maybe (Set a)
Nothing    -> Map ix (Set a)
ltgt

-- Optimization todo:
--
--   * can we avoid rebuilding the collection every time we query?
--     does laziness take care of everything?
--
--   * nicer operators?
--
--   * nice way to do updates that doesn't involve reinserting the entire data
--
--   * can we index on xpath rather than just type?

-- | Statistics about 'IxSet'. This function returns quadruple
-- consisting of
--
--   1. total number of elements in the set
--   2. number of declared indices
--   3. number of keys in all indices
--   4. number of values in all keys in all indices.
--
-- This can aid you in debugging and optimisation.
--
stats :: Indexable ixs a => IxSet ixs a -> (Int,Int,Int,Int)
stats :: IxSet ixs a -> (Int, Int, Int, Int)
stats (IxSet Set a
a IxList ixs a
ixs) = (Int
no_elements,Int
no_indexes,Int
no_keys,Int
no_values)
    where
      no_elements :: Int
no_elements = Set a -> Int
forall a. Set a -> Int
Set.size Set a
a
      no_indexes :: Int
no_indexes  = IxList ixs a -> Int
forall (ixs :: [*]) a. IxList ixs a -> Int
lengthIxList IxList ixs a
ixs
      no_keys :: Int
no_keys     = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((forall ix. Ord ix => Ix ix a -> Int) -> IxList ixs a -> [Int]
forall (ixs :: [*]) a r.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> r) -> IxList ixs a -> [r]
ixListToList (\ (Ix Map ix (Set a)
m a -> [ix]
_) -> Map ix (Set a) -> Int
forall k a. Map k a -> Int
Map.size Map ix (Set a)
m) IxList ixs a
ixs)
      no_values :: Int
no_values   = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((forall ix. Ord ix => Ix ix a -> Int) -> IxList ixs a -> [Int]
forall (ixs :: [*]) a r.
All Ord ixs =>
(forall ix. Ord ix => Ix ix a -> r) -> IxList ixs a -> [r]
ixListToList (\ (Ix Map ix (Set a)
m a -> [ix]
_) -> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Set a -> Int
forall a. Set a -> Int
Set.size Set a
s | Set a
s <- Map ix (Set a) -> [Set a]
forall k a. Map k a -> [a]
Map.elems Map ix (Set a)
m]) IxList ixs a
ixs)