{-# LANGUAGE UndecidableInstances, OverlappingInstances, FlexibleContexts, FlexibleInstances,
             MultiParamTypeClasses, TemplateHaskell, RankNTypes,
             FunctionalDependencies, DeriveDataTypeable,
             GADTs, CPP, ScopedTypeVariables #-}

{- |
An efficient implementation of queryable sets.

Assume you have a type like:

> data Entry = Entry Author [Author] Updated Id Content
> newtype Updated = Updated EpochTime
> newtype Id = Id Int64
> newtype Content = Content String
> newtype Author = Author Email
> type Email = String

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

> instance Indexable Entry where
>     empty = ixSet
>               [ ixGen (Proxy :: Proxy Author)        -- out of order
>               , ixGen (Proxy :: Proxy Id)
>               , ixGen (Proxy :: Proxy Updated)
>               , ixGen (Proxy :: Proxy Test)          -- bogus index
>               ]

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

> entries = foldr insert empty [e1,e2,e3,e4]
> entries' = foldr delete entries [e1,e3]
> entries'' = update e4 e5 entries

4. 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@.

5. 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:

> getWords (Entry _ _ _ _ (Content s)) = map Word $ words s
>
> instance Indexable Entry where
>     empty = ixSet [ ...
>                   , 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"]

6. 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
>
> getFirstAuthor (Entry author _ _ _ _) = [FirstAuthor author]
>
> instance Indexable Entry where
>     ...
>     empty = ixSet [ ...
>                   , ixFun getFirstAuthor
>                   ]
>
>     entries @= (FirstAuthor "john@doe.com")  -- guess what this does

-}

module Data.IxSet
    (
     -- * Set type
     IxSet,
     Indexable(..),
     Proxy(..),
     noCalcs,
     inferIxSet,
     ixSet,
     ixFun,
     ixGen,

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

     -- * Creation
     fromSet,
     fromList,

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

     -- * Size checking
     size,
     null,

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

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

     -- * Index creation helpers
     flatten,
     flattenWithCalcs,

     -- * Debugging and optimization
     stats
)
where

import Prelude hiding (null)

import           Control.Arrow  (first, second)
import           Data.Generics  (Data, gmapQ)
import qualified Data.Generics.SYB.WithClass.Basics as SYBWC
import qualified Data.IxSet.Ix  as Ix
import           Data.IxSet.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.Monoid    (Monoid(mempty, mappend))
import           Data.SafeCopy  (SafeCopy(..), contain, safeGet, safePut)
import           Data.Set       (Set)
import qualified Data.Set       as Set
import           Data.Typeable  (Typeable, cast, typeOf)
import Language.Haskell.TH      as TH
import           Data.Semigroup

-------------------------------------------------
-- Type proxies

data Proxy a = Proxy

mkProxy :: a -> Proxy a
mkProxy :: a -> Proxy a
mkProxy a
_ = Proxy a
forall a. Proxy a
Proxy

asProxyType :: a -> Proxy a -> a
asProxyType :: a -> Proxy a -> a
asProxyType a
a Proxy a
_ = a
a

-- the core datatypes

-- | Set with associated indexes.
data IxSet a = IxSet [Ix a]
    deriving (Typeable (IxSet a)
DataType
Constr
Typeable (IxSet a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> IxSet a -> c (IxSet a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (IxSet a))
-> (IxSet a -> Constr)
-> (IxSet a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (IxSet a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (IxSet a)))
-> ((forall b. Data b => b -> b) -> IxSet a -> IxSet a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IxSet a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IxSet a -> r)
-> (forall u. (forall d. Data d => d -> u) -> IxSet a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IxSet a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a))
-> Data (IxSet a)
IxSet a -> DataType
IxSet a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (IxSet a))
(forall b. Data b => b -> b) -> IxSet a -> IxSet a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IxSet a -> c (IxSet a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IxSet a)
forall a. Data a => Typeable (IxSet a)
forall a. Data a => IxSet a -> DataType
forall a. Data a => IxSet a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> IxSet a -> IxSet a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> IxSet a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> IxSet a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IxSet a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IxSet a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IxSet a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IxSet a -> c (IxSet a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (IxSet a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (IxSet a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IxSet a -> u
forall u. (forall d. Data d => d -> u) -> IxSet a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IxSet a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IxSet a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IxSet a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IxSet a -> c (IxSet a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (IxSet a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (IxSet a))
$cIxSet :: Constr
$tIxSet :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
gmapMp :: (forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
gmapM :: (forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> IxSet a -> m (IxSet a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> IxSet a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> IxSet a -> u
gmapQ :: (forall d. Data d => d -> u) -> IxSet a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> IxSet a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IxSet a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IxSet a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IxSet a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IxSet a -> r
gmapT :: (forall b. Data b => b -> b) -> IxSet a -> IxSet a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> IxSet a -> IxSet a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (IxSet a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (IxSet a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (IxSet a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (IxSet a))
dataTypeOf :: IxSet a -> DataType
$cdataTypeOf :: forall a. Data a => IxSet a -> DataType
toConstr :: IxSet a -> Constr
$ctoConstr :: forall a. Data a => IxSet a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IxSet a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IxSet a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IxSet a -> c (IxSet a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IxSet a -> c (IxSet a)
$cp1Data :: forall a. Data a => Typeable (IxSet a)
Data, Typeable)

-- | Create an 'IxSet' using a list of indexes. Typically used to
-- create the 'empty' method for an 'Indexable' instance.
--
-- The list elements are generally created by using the 'ixFun' and
-- 'ixGen' helper functions.
--
-- > instance Indexable Type where
-- >     empty = ixSet [ ...
-- >                   , ixFun getIndex1
-- >                   , ixGen (Proxy :: Proxy Index2Type)
-- >                   ]
--
-- Every value in the 'IxSet' must be reachable by the first index in this
-- list, or you'll get a runtime error.
ixSet :: [Ix a] -> IxSet a
ixSet :: [Ix a] -> IxSet a
ixSet = [Ix a] -> IxSet a
forall a. [Ix a] -> IxSet a
IxSet

-- | Create a functional index. Provided function should return a list
-- of indexes where the value should be found.
--
-- > getIndexes value = [...indexes...]
--
-- > instance Indexable Type where
-- >     empty = ixSet [ ixFun getIndexes ]
--
-- This is the recommended way to create indexes.
ixFun :: forall a b . (Ord b,Typeable b) => (a -> [b]) -> Ix a
ixFun :: (a -> [b]) -> Ix a
ixFun a -> [b]
f = Map b (Set a) -> (a -> [b]) -> Ix a
forall a key.
(Typeable key, Ord key) =>
Map key (Set a) -> (a -> [key]) -> Ix a
Ix Map b (Set a)
forall k a. Map k a
Map.empty a -> [b]
f


-- | 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 Type where
-- >     empty = ixSet [ ixGen (Proxy :: Proxy Type) ]
--
-- In production systems consider using 'ixFun' in place of 'ixGen' as
-- the former one is much faster.
ixGen :: forall a b . (Data a,Ord b,Typeable b) => Proxy b -> Ix a
ixGen :: Proxy b -> Ix a
ixGen Proxy b
_example = (a -> [b]) -> Ix a
forall a b. (Ord b, Typeable b) => (a -> [b]) -> Ix a
ixFun (a -> [b]
forall a b. (Typeable a, Data a, Typeable b) => a -> [b]
flatten :: a -> [b])

showTypeOf :: (Typeable a) => a -> String
showTypeOf :: a -> String
showTypeOf a
x = Int -> TypeRep -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x) []

instance (Eq a,Ord a,Typeable a) => Eq (IxSet a) where
    IxSet (Ix Map key (Set a)
a a -> [key]
_:[Ix a]
_) == :: IxSet a -> IxSet a -> Bool
== IxSet (Ix Map key (Set a)
b a -> [key]
_:[Ix a]
_) =
        case Map key (Set a) -> Maybe (Map key (Set a))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Map key (Set a)
b of
          Just Map key (Set a)
b' -> Map key (Set a)
aMap key (Set a) -> Map key (Set a) -> Bool
forall a. Eq a => a -> a -> Bool
==Map key (Set a)
b'
          Maybe (Map key (Set a))
Nothing -> String -> Bool
forall a. HasCallStack => String -> a
error String
"trying to compare two sets with different types of first indexes, this is a bug in the library"
    IxSet a
_ == IxSet a
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"comparing sets without indexes, this is a bug in the library"

instance (Eq a,Ord a,Typeable a) => Ord (IxSet a) where
    compare :: IxSet a -> IxSet a -> Ordering
compare IxSet a
a IxSet a
b = Set a -> Set a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IxSet a -> Set a
forall a. Ord a => IxSet a -> Set a
toSet IxSet a
a) (IxSet a -> Set a
forall a. Ord a => IxSet a -> Set a
toSet IxSet a
b)
{- FIXME
instance Version (IxSet a)
instance (Serialize a, Ord a, Typeable a, Indexable a) => Serialize (IxSet a) where
    putCopy = contain . safePut . toList
    getCopy = contain $ liftM fromList safeGet
-}
instance (SafeCopy a, Ord a, Typeable a, Indexable a) => SafeCopy (IxSet a) where
    putCopy :: IxSet a -> Contained Put
putCopy = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put)
-> (IxSet a -> Put) -> IxSet 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 a -> [a]) -> IxSet a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet a -> [a]
forall a. Ord a => IxSet a -> [a]
toList
    getCopy :: Contained (Get (IxSet a))
getCopy = Get (IxSet a) -> Contained (Get (IxSet a))
forall a. a -> Contained a
contain (Get (IxSet a) -> Contained (Get (IxSet a)))
-> Get (IxSet a) -> Contained (Get (IxSet a))
forall a b. (a -> b) -> a -> b
$ ([a] -> IxSet a) -> Get [a] -> Get (IxSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> IxSet a
forall a. (Indexable a, Ord a, Typeable a) => [a] -> IxSet a
fromList Get [a]
forall a. SafeCopy a => Get a
safeGet

instance ( SYBWC.Data ctx a
         , SYBWC.Data ctx [a]
         , SYBWC.Sat (ctx (IxSet a))
         , SYBWC.Sat (ctx [a])
         , SYBWC.Typeable IxSet
         , Indexable a
         , Data a
         , Ord a
         )
       => SYBWC.Data ctx (IxSet a) where
    gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> IxSet a
-> w (IxSet a)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z IxSet a
ixset  = ([a] -> IxSet a) -> w ([a] -> IxSet a)
forall g. g -> w g
z [a] -> IxSet a
forall a. (Indexable a, Ord a, Typeable a) => [a] -> IxSet a
fromList w ([a] -> IxSet a) -> [a] -> w (IxSet a)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` IxSet a -> [a]
forall a. Ord a => IxSet a -> [a]
toList IxSet a
ixset
    toConstr :: Proxy ctx -> IxSet a -> Constr
toConstr Proxy ctx
_ (IxSet [Ix a]
_) = Constr
ixSetConstr
    gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (IxSet a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Int
SYBWC.constrIndex Constr
c of
                       Int
1 -> c ([a] -> IxSet a) -> c (IxSet a)
forall b r. Data ctx b => c (b -> r) -> c r
k (([a] -> IxSet a) -> c ([a] -> IxSet a)
forall r. r -> c r
z [a] -> IxSet a
forall a. (Indexable a, Ord a, Typeable a) => [a] -> IxSet a
fromList)
                       Int
_ -> String -> c (IxSet a)
forall a. HasCallStack => String -> a
error String
"IxSet.SYBWC.Data.gunfold unexpected match"
    dataTypeOf :: Proxy ctx -> IxSet a -> DataType
dataTypeOf Proxy ctx
_ IxSet a
_ = DataType
ixSetDataType

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


{- FIXME
instance (Indexable a, Ord a,Data a, Default a) => Default (IxSet a) where
    defaultValue = empty
-}
instance (Ord a,Show a) => Show (IxSet a) where
    showsPrec :: Int -> IxSet a -> ShowS
showsPrec Int
prec = Int -> Set a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
prec (Set a -> ShowS) -> (IxSet a -> Set a) -> IxSet a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet a -> Set a
forall a. Ord a => IxSet a -> Set a
toSet

instance (Ord a,Read a,Typeable a,Indexable a) => Read (IxSet a) where
    readsPrec :: Int -> ReadS (IxSet a)
readsPrec Int
n = ((Set a, String) -> (IxSet a, String))
-> [(Set a, String)] -> [(IxSet a, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> IxSet a) -> (Set a, String) -> (IxSet a, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Set a -> IxSet a
forall a. (Indexable a, Ord a, Typeable a) => Set a -> IxSet a
fromSet) ([(Set a, String)] -> [(IxSet a, String)])
-> (String -> [(Set a, String)]) -> ReadS (IxSet 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

{- | Defines objects that can be members of 'IxSet'.
-}
class Indexable a where
    -- | Defines what an empty 'IxSet' for this particular type should look
    -- like.  It should have all necessary indexes. Use the 'ixSet'
    -- function to create the set and fill it in with 'ixFun' and 'ixGen'.
    empty :: IxSet a

-- | Function to be used for 'calcs' 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

and

> $(inferIxSet "FooDB" ''Foo 'noCalcs [''Int,''String])

will build a type synonym

> type FooDB = IxSet Foo

with @Int@ and @String@ as indexes.

/WARNING/: The type specified as the first index must be a type which
appears in all values in the 'IxSet' or 'toList', 'toSet' and
serialization will not function properly.  You will be warned not to do
this with a runtime error.  You can always use the element type
itself. For example:

> $(inferIxSet "FooDB" ''Foo 'noCalcs [''Foo, ''Int, ''String])

-}
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,4,0)
             mkCtx :: Name -> [TypeQ] -> TypeQ
mkCtx = Name -> [TypeQ] -> TypeQ
classP
#else
             -- mkType :: Name -> [TypeQ] -> TypeQ
             mkType con = foldl appT (conT con)

             mkCtx = mkType
#endif
             dataCtxConQ :: [TypeQ]
dataCtxConQ = [Name -> [TypeQ] -> TypeQ
mkCtx ''Data [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 :: Kind
calType = Kind -> Kind
getCalType Kind
t
                   getCalType :: Kind -> Kind
getCalType (ForallT [TyVarBndr]
_names Cxt
_ Kind
t') = Kind -> Kind
getCalType Kind
t'
                   getCalType (AppT (AppT Kind
ArrowT Kind
_) Kind
t') = Kind
t'
                   getCalType Kind
t' = String -> Kind
forall a. HasCallStack => String -> a
error (String
"Unexpected type in getCalType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Ppr a => a -> String
pprint Kind
t')
#if MIN_VERSION_template_haskell(2,17,0)
                   binders' = map (fmap (\() -> SpecifiedSpec)) (binders :: [TyVarBndr ()])
#else
                   binders' :: [TyVarBndr]
binders' = [TyVarBndr]
binders
#endif
                   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 [TyVarBndr]
binders' (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)
               in do Dec
i <- Q Cxt -> TypeQ -> [DecQ] -> DecQ
instanceD (Q Cxt
fullContext)
                          (Name -> TypeQ
conT ''Indexable TypeQ -> TypeQ -> TypeQ
`appT` TypeQ
typeCon)
                          [PatQ -> BodyQ -> [DecQ] -> DecQ
valD (Name -> PatQ
varP 'empty) (ExpQ -> BodyQ
normalB [| ixSet $(listE (map mkEntryPoint entryPoints)) |]) []]
                     let ixType :: TypeQ
ixType = TypeQ -> TypeQ -> TypeQ
appT (Name -> TypeQ
conT ''IxSet) 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"

-- | Version of 'instanceD' that takes in a Q [Dec] instead of a [Q Dec]
-- and filters out signatures from the list of declarations.
instanceD' :: CxtQ -> TypeQ -> Q [Dec] -> DecQ
instanceD' :: Q Cxt -> TypeQ -> Q [Dec] -> DecQ
instanceD' Q Cxt
ctxt TypeQ
ty Q [Dec]
decs =
    do [Dec]
decs' <- Q [Dec]
decs
       let decs'' :: [Dec]
decs'' = (Dec -> Bool) -> [Dec] -> [Dec]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Dec -> Bool) -> Dec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Bool
isSigD) [Dec]
decs'
       Q Cxt -> TypeQ -> [DecQ] -> DecQ
instanceD Q Cxt
ctxt TypeQ
ty ((Dec -> DecQ) -> [Dec] -> [DecQ]
forall a b. (a -> b) -> [a] -> [b]
map Dec -> DecQ
forall (m :: * -> *) a. Monad m => a -> m a
return [Dec]
decs'')

-- | Returns true if the Dec matches a SigD constructor.
isSigD :: Dec -> Bool
isSigD :: Dec -> Bool
isSigD (SigD Name
_ Kind
_) = Bool
True
isSigD Dec
_ = Bool
False

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



-- modification operations

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

-- | 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)

-- | 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 :: (Typeable a,Indexable a,Ord a) =>
          IndexOp -> a -> IxSet a -> IxSet a
change :: IndexOp -> a -> IxSet a -> IxSet a
change IndexOp
op a
x (IxSet [Ix a]
indexes) =
    [Ix a] -> IxSet a
forall a. [Ix a] -> IxSet a
IxSet [Ix a]
v
    where
    v :: [Ix a]
v = (Bool -> Ix a -> Ix a) -> [Bool] -> [Ix a] -> [Ix a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Ix a -> Ix a
update (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) [Ix a]
indexes
    update :: Bool -> Ix a -> Ix a
update Bool
firstindex (Ix Map key (Set a)
index a -> [key]
flatten2) = Map key (Set a) -> (a -> [key]) -> Ix a
forall a key.
(Typeable key, Ord key) =>
Map key (Set a) -> (a -> [key]) -> Ix a
Ix Map key (Set a)
index' a -> [key]
flatten2
        where
        key :: key
key = (forall key a. Map key (Set a) -> key
forall a. HasCallStack => a
undefined :: Map key (Set a) -> key) Map key (Set a)
index
        ds :: [key]
ds = a -> [key]
flatten2 a
x
        ii :: Map key (Set a) -> key -> Map key (Set a)
ii Map key (Set a)
m key
dkey = key -> a -> Map key (Set a) -> Map key (Set a)
IndexOp
op key
dkey a
x Map key (Set a)
m
        index' :: Map key (Set a)
index' = if Bool
firstindex Bool -> Bool -> Bool
&& [key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [key]
ds
                 then String -> Map key (Set a)
forall a. HasCallStack => String -> a
error (String -> Map key (Set a)) -> String -> Map key (Set a)
forall a b. (a -> b) -> a -> b
$ String
"Happstack.Data.IxSet.change: all values must appear in first declared index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ key -> String
forall a. Typeable a => a -> String
showTypeOf key
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Typeable a => a -> String
showTypeOf a
x
                 else (Map key (Set a) -> key -> Map key (Set a))
-> Map key (Set a) -> [key] -> Map key (Set a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map key (Set a) -> key -> Map key (Set a)
ii Map key (Set a)
index [key]
ds -- handle multiple values

insertList :: (Typeable a,Indexable a,Ord a)
           => [a] -> IxSet a -> IxSet a
insertList :: [a] -> IxSet a -> IxSet a
insertList [a]
xs (IxSet [Ix a]
indexes) =
    [Ix a] -> IxSet a
forall a. [Ix a] -> IxSet a
IxSet [Ix a]
v
    where
    v :: [Ix a]
v = (Bool -> Ix a -> Ix a) -> [Bool] -> [Ix a] -> [Ix a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Ix a -> Ix a
update (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) [Ix a]
indexes
    update :: Bool -> Ix a -> Ix a
update Bool
firstindex (Ix Map key (Set a)
index a -> [key]
flatten2) = Map key (Set a) -> (a -> [key]) -> Ix a
forall a key.
(Typeable key, Ord key) =>
Map key (Set a) -> (a -> [key]) -> Ix a
Ix Map key (Set a)
index' a -> [key]
flatten2
        where
        key :: key
key = (forall key a. Map key (Set a) -> key
forall a. HasCallStack => a
undefined :: Map key (Set a) -> key) Map key (Set a)
index
        flattencheck :: a -> [key]
flattencheck a
x
            | Bool
firstindex = case a -> [key]
flatten2 a
x of
                             [] -> String -> [key]
forall a. HasCallStack => String -> a
error (String -> [key]) -> String -> [key]
forall a b. (a -> b) -> a -> b
$ String
"Happstack.Data.IxSet.change: all values must appear in first declared index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ key -> String
forall a. Typeable a => a -> String
showTypeOf key
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Typeable a => a -> String
showTypeOf a
x
                             [key]
res -> [key]
res
            | Bool
otherwise = a -> [key]
flatten2 a
x
        dss :: [(key, a)]
dss = [(key
k,a
x) | a
x <- [a]
xs, key
k <- a -> [key]
flattencheck a
x]
        index' :: Map key (Set a)
index' = [(key, a)] -> Map key (Set a) -> Map key (Set a)
forall a k.
(Ord a, Ord k) =>
[(k, a)] -> Map k (Set a) -> Map k (Set a)
Ix.insertList [(key, a)]
dss Map key (Set a)
index

insertMapOfSets :: (Typeable a, Ord a,Indexable a,Typeable key,Ord key)
                => Map key (Set a) -> IxSet a -> IxSet a
insertMapOfSets :: Map key (Set a) -> IxSet a -> IxSet a
insertMapOfSets Map key (Set a)
originalindex (IxSet [Ix a]
indexes) =
    [Ix a] -> IxSet a
forall a. [Ix a] -> IxSet a
IxSet [Ix a]
v
    where
    v :: [Ix a]
v = (Ix a -> Ix a) -> [Ix a] -> [Ix a]
forall a b. (a -> b) -> [a] -> [b]
map Ix a -> Ix a
update [Ix a]
indexes
    xs :: [a]
xs = (Set a -> [a]) -> [Set a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Set a -> [a]
forall a. Set a -> [a]
Set.toList (Map key (Set a) -> [Set a]
forall k a. Map k a -> [a]
Map.elems Map key (Set a)
originalindex)
    update :: Ix a -> Ix a
update (Ix Map key (Set a)
index a -> [key]
flatten2) = Map key (Set a) -> (a -> [key]) -> Ix a
forall a key.
(Typeable key, Ord key) =>
Map key (Set a) -> (a -> [key]) -> Ix a
Ix Map key (Set a)
index' a -> [key]
flatten2
        where
        dss :: [(key, a)]
dss = [(key
k,a
x) | a
x <- [a]
xs, key
k <- a -> [key]
flatten2 a
x]
        {- We try to be really clever here. The originalindex 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 index we
           could reuse originalindex as it is. But there can be more, so we need to
           add remaining ones. Anyway we try to reuse old structure and keep
           new allocations low as much as possible.
         -}
        index' :: Map key (Set a)
index' = case Map key (Set a) -> Maybe (Map key (Set a))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Map key (Set a)
originalindex of
                   Just Map key (Set a)
originalindex' ->
                       let dssf :: [(key, a)]
dssf = ((key, a) -> Bool) -> [(key, a)] -> [(key, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(key
k,a
_v) -> Bool -> Bool
not (key -> Map key (Set a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member key
k Map key (Set a)
originalindex')) [(key, a)]
dss
                       in [(key, a)] -> Map key (Set a) -> Map key (Set a)
forall a k.
(Ord a, Ord k) =>
[(k, a)] -> Map k (Set a) -> Map k (Set a)
Ix.insertList [(key, a)]
dssf Map key (Set a)
originalindex'
                   Maybe (Map key (Set a))
Nothing -> [(key, a)] -> Map key (Set a) -> Map key (Set a)
forall a k.
(Ord a, Ord k) =>
[(k, a)] -> Map k (Set a) -> Map k (Set a)
Ix.insertList [(key, a)]
dss Map key (Set a)
index

-- | 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 :: (Typeable a, Ord a,Indexable a) => a -> IxSet a -> IxSet a
insert :: a -> IxSet a -> IxSet a
insert = IndexOp -> a -> IxSet a -> IxSet a
forall a.
(Typeable a, Indexable a, Ord a) =>
IndexOp -> a -> IxSet a -> IxSet a
change 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 :: (Typeable a, Ord a,Indexable a) => a -> IxSet a -> IxSet a
delete :: a -> IxSet a -> IxSet a
delete = IndexOp -> a -> IxSet a -> IxSet a
forall a.
(Typeable a, Indexable a, Ord a) =>
IndexOp -> a -> IxSet a -> IxSet a
change 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 index k.  Only works if there is at
-- most one item with that index in the 'IxSet'. Will not change
-- 'IxSet' if you have more then 1 item with given index.
updateIx :: (Indexable a, Ord a, Typeable a, Typeable k)
         => k -> a -> IxSet a -> IxSet a
updateIx :: k -> a -> IxSet a -> IxSet a
updateIx k
i a
new IxSet a
ixset = a -> IxSet a -> IxSet a
forall a.
(Typeable a, Ord a, Indexable a) =>
a -> IxSet a -> IxSet a
insert a
new (IxSet a -> IxSet a) -> IxSet a -> IxSet a
forall a b. (a -> b) -> a -> b
$
                     IxSet a -> (a -> IxSet a) -> Maybe a -> IxSet a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IxSet a
ixset ((a -> IxSet a -> IxSet a) -> IxSet a -> a -> IxSet a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> IxSet a -> IxSet a
forall a.
(Typeable a, Ord a, Indexable a) =>
a -> IxSet a -> IxSet a
delete IxSet a
ixset) (Maybe a -> IxSet a) -> Maybe a -> IxSet a
forall a b. (a -> b) -> a -> b
$
                     IxSet a -> Maybe a
forall a. Ord a => IxSet a -> Maybe a
getOne (IxSet a -> Maybe a) -> IxSet a -> Maybe a
forall a b. (a -> b) -> a -> b
$ IxSet a
ixset IxSet a -> k -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@= k
i

-- | Will delete the item with index k.  Only works if there is at
-- most one item with that index in the 'IxSet'. Will not change
-- 'IxSet' if you have more then 1 item with given index.
deleteIx :: (Indexable a, Ord a, Typeable a, Typeable k)
         => k -> IxSet a -> IxSet a
deleteIx :: k -> IxSet a -> IxSet a
deleteIx k
i IxSet a
ixset = IxSet a -> (a -> IxSet a) -> Maybe a -> IxSet a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IxSet a
ixset ((a -> IxSet a -> IxSet a) -> IxSet a -> a -> IxSet a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> IxSet a -> IxSet a
forall a.
(Typeable a, Ord a, Indexable a) =>
a -> IxSet a -> IxSet a
delete IxSet a
ixset) (Maybe a -> IxSet a) -> Maybe a -> IxSet a
forall a b. (a -> b) -> a -> b
$
                       IxSet a -> Maybe a
forall a. Ord a => IxSet a -> Maybe a
getOne (IxSet a -> Maybe a) -> IxSet a -> Maybe a
forall a b. (a -> b) -> a -> b
$ IxSet a
ixset IxSet a -> k -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@= k
i

-- conversion operations

-- | Converts an 'IxSet' to a 'Set' of its elements.
toSet :: Ord a => IxSet a -> Set a
toSet :: IxSet a -> Set a
toSet (IxSet (Ix Map key (Set a)
ix a -> [key]
_:[Ix a]
_)) = (Set a -> Set a -> Set a) -> Set a -> [Set a] -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
forall a. Set a
Set.empty (Map key (Set a) -> [Set a]
forall k a. Map k a -> [a]
Map.elems Map key (Set a)
ix)
toSet (IxSet []) = Set a
forall a. Set a
Set.empty

-- | Converts a 'Set' to an 'IxSet'.
fromSet :: (Indexable a, Ord a, Typeable a) => Set a -> IxSet a
fromSet :: Set a -> IxSet a
fromSet = [a] -> IxSet a
forall a. (Indexable a, Ord a, Typeable a) => [a] -> IxSet a
fromList ([a] -> IxSet a) -> (Set a -> [a]) -> Set a -> IxSet 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 a, Ord a, Typeable a) => [a] -> IxSet a
fromList :: [a] -> IxSet a
fromList [a]
list = [a] -> IxSet a -> IxSet a
forall a.
(Typeable a, Indexable a, Ord a) =>
[a] -> IxSet a -> IxSet a
insertList [a]
list IxSet a
forall a. Indexable a => IxSet a
empty

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

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

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

-- | Converts an 'IxSet' to its list of elements.
--
-- List will be sorted in descending order by the index 'k'.
--
-- The list may contain duplicate entries if a single value produces multiple keys.
toDescList :: forall k a. (Indexable a, Typeable a, Typeable k) => Proxy k -> IxSet a -> [a]
toDescList :: Proxy k -> IxSet a -> [a]
toDescList Proxy k
_ IxSet a
ixset = ((k, [a]) -> [a]) -> [(k, [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (k, [a]) -> [a]
forall a b. (a, b) -> b
snd (IxSet a -> [(k, [a])]
forall k t. (Typeable k, Typeable t) => IxSet t -> [(k, [t])]
groupDescBy IxSet a
ixset :: [(k, [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 a -> Maybe a
getOne :: IxSet a -> Maybe a
getOne IxSet a
ixset = case IxSet a -> [a]
forall a. Ord a => IxSet a -> [a]
toList IxSet 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 a -> a
getOneOr :: a -> IxSet a -> a
getOneOr a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> (IxSet a -> Maybe a) -> IxSet a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet a -> Maybe a
forall a. Ord a => IxSet a -> Maybe a
getOne

-- | Return 'True' if the 'IxSet' is empty, 'False' otherwise.
null :: IxSet a -> Bool
null :: IxSet a -> Bool
null (IxSet (Ix Map key (Set a)
ix a -> [key]
_:[Ix a]
_)) = Map key (Set a) -> Bool
forall k a. Map k a -> Bool
Map.null Map key (Set a)
ix
null (IxSet [])          = Bool
True

-- set operations

-- | An infix 'intersection' operation.
(&&&) :: (Ord a, Typeable a, Indexable a) => IxSet a -> IxSet a -> IxSet a
&&& :: IxSet a -> IxSet a -> IxSet a
(&&&) = IxSet a -> IxSet a -> IxSet a
forall a.
(Ord a, Typeable a, Indexable a) =>
IxSet a -> IxSet a -> IxSet a
intersection

-- | An infix 'union' operation.
(|||) :: (Ord a, Typeable a, Indexable a) => IxSet a -> IxSet a -> IxSet a
||| :: IxSet a -> IxSet a -> IxSet a
(|||) = IxSet a -> IxSet a -> IxSet a
forall a.
(Ord a, Typeable a, Indexable a) =>
IxSet a -> IxSet a -> IxSet a
union

infixr 5 &&&
infixr 5 |||

-- | Takes the union of the two 'IxSet's.
union :: (Ord a, Typeable a, Indexable a) => IxSet a -> IxSet a -> IxSet a
union :: IxSet a -> IxSet a -> IxSet a
union (IxSet [Ix a]
x1) (IxSet [Ix a]
x2) = [Ix a] -> IxSet a
forall a. [Ix a] -> IxSet a
IxSet [Ix a]
indexes'
    where
      indexes' :: [Ix a]
indexes' = (Ix a -> Ix a -> Ix a) -> [Ix a] -> [Ix a] -> [Ix a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Ix a -> Ix a -> Ix a
forall a a. (Typeable a, Typeable a, Ord a) => Ix a -> Ix a -> Ix a
union' [Ix a]
x1 [Ix a]
x2
      union' :: Ix a -> Ix a -> Ix a
union' (Ix Map key (Set a)
a a -> [key]
f) (Ix b _) =
          case Map key (Set a) -> Maybe (Map key (Set a))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Map key (Set a)
b of
            Maybe (Map key (Set a))
Nothing -> String -> Ix a
forall a. HasCallStack => String -> a
error String
"IxSet.union: indexes out of order"
            Just Map key (Set a)
b' -> Map key (Set a) -> (a -> [key]) -> Ix a
forall a key.
(Typeable key, Ord key) =>
Map key (Set a) -> (a -> [key]) -> Ix a
Ix (Map key (Set a) -> Map key (Set a) -> Map key (Set a)
forall a k.
(Ord a, Ord k) =>
Map k (Set a) -> Map k (Set a) -> Map k (Set a)
Ix.union Map key (Set a)
a Map key (Set a)
b') a -> [key]
f

-- | Takes the intersection of the two 'IxSet's.
intersection :: (Ord a, Typeable a, Indexable a) => IxSet a -> IxSet a -> IxSet a
intersection :: IxSet a -> IxSet a -> IxSet a
intersection (IxSet [Ix a]
x1) (IxSet [Ix a]
x2) = [Ix a] -> IxSet a
forall a. [Ix a] -> IxSet a
IxSet [Ix a]
indexes'
    where
      indexes' :: [Ix a]
indexes' = (Ix a -> Ix a -> Ix a) -> [Ix a] -> [Ix a] -> [Ix a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Ix a -> Ix a -> Ix a
forall a a. (Typeable a, Typeable a, Ord a) => Ix a -> Ix a -> Ix a
intersection' [Ix a]
x1 [Ix a]
x2
      intersection' :: Ix a -> Ix a -> Ix a
intersection' (Ix Map key (Set a)
a a -> [key]
f) (Ix b _) =
          case Map key (Set a) -> Maybe (Map key (Set a))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Map key (Set a)
b of
            Maybe (Map key (Set a))
Nothing -> String -> Ix a
forall a. HasCallStack => String -> a
error String
"IxSet.intersection: indexes out of order"
            Just Map key (Set a)
b' -> Map key (Set a) -> (a -> [key]) -> Ix a
forall a key.
(Typeable key, Ord key) =>
Map key (Set a) -> (a -> [key]) -> Ix a
Ix (Map key (Set a) -> Map key (Set a) -> Map key (Set a)
forall a k.
(Ord a, Ord k) =>
Map k (Set a) -> Map k (Set a) -> Map k (Set a)
Ix.intersection Map key (Set a)
a Map key (Set a)
b') a -> [key]
f


-- query operators

-- | Infix version of 'getEQ'.
(@=) :: (Indexable a, Typeable a, Ord a, Typeable k)
     => IxSet a -> k -> IxSet a
IxSet a
ix @= :: IxSet a -> k -> IxSet a
@= k
v = k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getEQ k
v IxSet a
ix

-- | Infix version of 'getLT'.
(@<) :: (Indexable a, Typeable a, Ord a, Typeable k)
     => IxSet a -> k -> IxSet a
IxSet a
ix @< :: IxSet a -> k -> IxSet a
@< k
v = k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getLT k
v IxSet a
ix

-- | Infix version of 'getGT'.
(@>) :: (Indexable a, Typeable a, Ord a, Typeable k)
     => IxSet a -> k -> IxSet a
IxSet a
ix @> :: IxSet a -> k -> IxSet a
@> k
v = k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getGT k
v IxSet a
ix

-- | Infix version of 'getLTE'.
(@<=) :: (Indexable a, Typeable a, Ord a, Typeable k)
      => IxSet a -> k -> IxSet a
IxSet a
ix @<= :: IxSet a -> k -> IxSet a
@<= k
v = k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getLTE k
v IxSet a
ix

-- | Infix version of 'getGTE'.
(@>=) :: (Indexable a, Typeable a, Ord a, Typeable k)
      => IxSet a -> k -> IxSet a
IxSet a
ix @>= :: IxSet a -> k -> IxSet a
@>= k
v = k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getGTE k
v IxSet a
ix

-- | Returns the subset with indexes in the open interval (k,k).
(@><) :: (Indexable a, Typeable a, Ord a, Typeable k)
      => IxSet a -> (k, k) -> IxSet a
IxSet a
ix @>< :: IxSet a -> (k, k) -> IxSet a
@>< (k
v1,k
v2) = k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getLT k
v2 (IxSet a -> IxSet a) -> IxSet a -> IxSet a
forall a b. (a -> b) -> a -> b
$ k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getGT k
v1 IxSet a
ix

-- | Returns the subset with indexes in [k,k).
(@>=<) :: (Indexable a, Typeable a, Ord a, Typeable k)
       => IxSet a -> (k, k) -> IxSet a
IxSet a
ix @>=< :: IxSet a -> (k, k) -> IxSet a
@>=< (k
v1,k
v2) = k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getLT k
v2 (IxSet a -> IxSet a) -> IxSet a -> IxSet a
forall a b. (a -> b) -> a -> b
$ k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getGTE k
v1 IxSet a
ix

-- | Returns the subset with indexes in (k,k].
(@><=) :: (Indexable a, Typeable a, Ord a, Typeable k)
       => IxSet a -> (k, k) -> IxSet a
IxSet a
ix @><= :: IxSet a -> (k, k) -> IxSet a
@><= (k
v1,k
v2) = k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getLTE k
v2 (IxSet a -> IxSet a) -> IxSet a -> IxSet a
forall a b. (a -> b) -> a -> b
$ k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getGT k
v1 IxSet a
ix

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

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

-- | Creates the subset that matches all the provided indexes.
(@*) :: (Indexable a, Typeable a, Ord a, Typeable k)
     => IxSet a -> [k] -> IxSet a
IxSet a
ix @* :: IxSet a -> [k] -> IxSet a
@* [k]
list = (IxSet a -> IxSet a -> IxSet a) -> IxSet a -> [IxSet a] -> IxSet a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' IxSet a -> IxSet a -> IxSet a
forall a.
(Ord a, Typeable a, Indexable a) =>
IxSet a -> IxSet a -> IxSet a
intersection IxSet a
ix ([IxSet a] -> IxSet a) -> [IxSet a] -> IxSet a
forall a b. (a -> b) -> a -> b
$ (k -> IxSet a) -> [k] -> [IxSet a]
forall a b. (a -> b) -> [a] -> [b]
map (IxSet a
ix IxSet a -> k -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@=) [k]
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 a, Typeable a, Ord a, Typeable k)
      => k -> IxSet a -> IxSet a
getEQ :: k -> IxSet a -> IxSet a
getEQ = Ordering -> k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Ord a, Typeable a, Typeable k) =>
Ordering -> k -> IxSet a -> IxSet 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 a, Typeable a, Ord a, Typeable k)
      => k -> IxSet a -> IxSet a
getLT :: k -> IxSet a -> IxSet a
getLT = Ordering -> k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Ord a, Typeable a, Typeable k) =>
Ordering -> k -> IxSet a -> IxSet 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 a, Typeable a, Ord a, Typeable k)
      => k -> IxSet a -> IxSet a
getGT :: k -> IxSet a -> IxSet a
getGT = Ordering -> k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Ord a, Typeable a, Typeable k) =>
Ordering -> k -> IxSet a -> IxSet 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 a, Typeable a, Ord a, Typeable k)
       => k -> IxSet a -> IxSet a
getLTE :: k -> IxSet a -> IxSet a
getLTE = Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Ord a, Typeable a, Typeable k) =>
Bool -> Bool -> Bool -> k -> IxSet a -> IxSet 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 a, Typeable a, Ord a, Typeable k)
       => k -> IxSet a -> IxSet a
getGTE :: k -> IxSet a -> IxSet a
getGTE = Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Ord a, Typeable a, Typeable k) =>
Bool -> Bool -> Bool -> k -> IxSet a -> IxSet 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 a, Typeable k, Ord a, Typeable a)
         => k -> k -> IxSet a -> IxSet a
getRange :: k -> k -> IxSet a -> IxSet a
getRange k
k1 k
k2 IxSet a
ixset = k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getGTE k
k1 (k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
k -> IxSet a -> IxSet a
getLT k
k2 IxSet a
ixset)

-- | Returns lists of elements paired with the indexes determined by
-- type inference.
groupBy :: (Typeable k,Typeable t) =>  IxSet t -> [(k, [t])]
groupBy :: IxSet t -> [(k, [t])]
groupBy (IxSet [Ix t]
indexes) = [Ix t] -> [(k, [t])]
forall a k a.
(Typeable a, Typeable k, Typeable a) =>
[Ix a] -> [(k, [a])]
collect [Ix t]
indexes
    where
    collect :: [Ix a] -> [(k, [a])]
collect [] = [] -- FIXME: should be an error
    collect (Ix Map key (Set a)
index a -> [key]
_:[Ix a]
is) = [(k, [a])]
-> (Map k (Set a) -> [(k, [a])])
-> Maybe (Map k (Set a))
-> [(k, [a])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Ix a] -> [(k, [a])]
collect [Ix a]
is) Map k (Set a) -> [(k, [a])]
forall k a. Map k (Set a) -> [(k, [a])]
f (Map key (Set a) -> Maybe (Map k (Set a))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Map key (Set a)
index)
    f :: Map k (Set a) -> [(k, [a])]
f = ((k, Set a) -> (k, [a])) -> [(k, Set a)] -> [(k, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> [a]) -> (k, Set a) -> (k, [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) ([(k, Set a)] -> [(k, [a])])
-> (Map k (Set a) -> [(k, Set a)]) -> Map k (Set a) -> [(k, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Set a) -> [(k, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toList

-- | Returns lists of elements paired with the indexes determined by
-- type inference.
--
-- The resulting list will be sorted in ascending order by 'k'.
-- The values in '[t]' will be sorted in ascending order as well.
groupAscBy :: (Typeable k,Typeable t) =>  IxSet t -> [(k, [t])]
groupAscBy :: IxSet t -> [(k, [t])]
groupAscBy (IxSet [Ix t]
indexes) = [Ix t] -> [(k, [t])]
forall a k a.
(Typeable a, Typeable k, Typeable a) =>
[Ix a] -> [(k, [a])]
collect [Ix t]
indexes
    where
    collect :: [Ix a] -> [(k, [a])]
collect [] = [] -- FIXME: should be an error
    collect (Ix Map key (Set a)
index a -> [key]
_:[Ix a]
is) = [(k, [a])]
-> (Map k (Set a) -> [(k, [a])])
-> Maybe (Map k (Set a))
-> [(k, [a])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Ix a] -> [(k, [a])]
collect [Ix a]
is) Map k (Set a) -> [(k, [a])]
forall k a. Map k (Set a) -> [(k, [a])]
f (Map key (Set a) -> Maybe (Map k (Set a))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Map key (Set a)
index)
    f :: Map k (Set a) -> [(k, [a])]
f = ((k, Set a) -> (k, [a])) -> [(k, Set a)] -> [(k, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> [a]) -> (k, Set a) -> (k, [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) ([(k, Set a)] -> [(k, [a])])
-> (Map k (Set a) -> [(k, Set a)]) -> Map k (Set a) -> [(k, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Set a) -> [(k, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList

-- | Returns lists of elements paired with the indexes determined by
-- type inference.
--
-- The resulting list will be sorted in descending order by 'k'.
--
-- NOTE: The values in '[t]' 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 '[t]'.
groupDescBy :: (Typeable k,Typeable t) =>  IxSet t -> [(k, [t])]
groupDescBy :: IxSet t -> [(k, [t])]
groupDescBy (IxSet [Ix t]
indexes) = [Ix t] -> [(k, [t])]
forall a k a.
(Typeable a, Typeable k, Typeable a) =>
[Ix a] -> [(k, [a])]
collect [Ix t]
indexes
    where
    collect :: [Ix a] -> [(k, [a])]
collect [] = [] -- FIXME: should be an error
    collect (Ix Map key (Set a)
index a -> [key]
_:[Ix a]
is) = [(k, [a])]
-> (Map k (Set a) -> [(k, [a])])
-> Maybe (Map k (Set a))
-> [(k, [a])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Ix a] -> [(k, [a])]
collect [Ix a]
is) Map k (Set a) -> [(k, [a])]
forall k a. Map k (Set a) -> [(k, [a])]
f (Map key (Set a) -> Maybe (Map k (Set a))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Map key (Set a)
index)
    f :: Map k (Set a) -> [(k, [a])]
f = ((k, Set a) -> (k, [a])) -> [(k, Set a)] -> [(k, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> [a]) -> (k, Set a) -> (k, [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) ([(k, Set a)] -> [(k, [a])])
-> (Map k (Set a) -> [(k, Set a)]) -> Map k (Set a) -> [(k, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Set a) -> [(k, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toDescList

--query impl function

-- | 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 a, Ord a, Typeable a, Typeable k)
       => Ordering -> k -> IxSet a -> IxSet a
getOrd :: Ordering -> k -> IxSet a -> IxSet a
getOrd Ordering
LT = Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Ord a, Typeable a, Typeable k) =>
Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a
getOrd2 Bool
True Bool
False Bool
False
getOrd Ordering
EQ = Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Ord a, Typeable a, Typeable k) =>
Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a
getOrd2 Bool
False Bool
True Bool
False
getOrd Ordering
GT = Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a
forall a k.
(Indexable a, Ord a, Typeable a, Typeable k) =>
Bool -> Bool -> Bool -> k -> IxSet a -> IxSet 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 :: (Indexable a, Ord a, Typeable a, Typeable k)
        => Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a
getOrd2 :: Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a
getOrd2 Bool
inclt Bool
inceq Bool
incgt k
v ixset :: IxSet a
ixset@(IxSet [Ix a]
indexes) = [Ix a] -> IxSet a
collect [Ix a]
indexes
    where
    collect :: [Ix a] -> IxSet a
collect [] = String -> IxSet a
forall a. HasCallStack => String -> a
error (String -> IxSet a) -> String -> IxSet a
forall a b. (a -> b) -> a -> b
$ String
"IxSet: there is no index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ k -> String
forall a. Typeable a => a -> String
showTypeOf k
v String -> ShowS
forall a. [a] -> [a] -> [a]
++
                 String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IxSet a -> String
forall a. Typeable a => a -> String
showTypeOf IxSet a
ixset
    collect (Ix Map key (Set a)
index a -> [key]
_:[Ix a]
is) = IxSet a -> (key -> IxSet a) -> Maybe key -> IxSet a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Ix a] -> IxSet a
collect [Ix a]
is) key -> IxSet a
f (Maybe key -> IxSet a) -> Maybe key -> IxSet a
forall a b. (a -> b) -> a -> b
$ k -> Maybe key
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast k
v
        where
        f :: key -> IxSet a
f key
v'' = Map key (Set a) -> IxSet a -> IxSet a
forall a key.
(Typeable a, Ord a, Indexable a, Typeable key, Ord key) =>
Map key (Set a) -> IxSet a -> IxSet a
insertMapOfSets Map key (Set a)
result IxSet a
forall a. Indexable a => IxSet a
empty
            where
            (Map key (Set a)
lt',Maybe (Set a)
eq',Map key (Set a)
gt') = key
-> Map key (Set a)
-> (Map key (Set a), Maybe (Set a), Map key (Set a))
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup key
v'' Map key (Set a)
index
            ltgt :: Map key (Set a)
ltgt = (Set a -> Set a -> Set a)
-> Map key (Set a) -> Map key (Set a) -> Map key (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 key (Set a)
lt Map key (Set a)
gt
            result :: Map key (Set a)
result = case Maybe (Set a)
eq of
                       Just Set a
eqset -> (Set a -> Set a -> Set a)
-> key -> Set a -> Map key (Set a) -> Map key (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 key
v'' Set a
eqset Map key (Set a)
ltgt
                       Maybe (Set a)
Nothing -> Map key (Set a)
ltgt
            lt :: Map key (Set a)
lt = if Bool
inclt
                 then Map key (Set a)
lt'
                 else Map key (Set a)
forall k a. Map k a
Map.empty
            gt :: Map key (Set a)
gt = if Bool
incgt
                 then Map key (Set a)
gt'
                 else Map key (Set a)
forall k a. Map k a
Map.empty
            eq :: Maybe (Set a)
eq = if Bool
inceq
                 then Maybe (Set a)
eq'
                 else Maybe (Set a)
forall a. Maybe a
Nothing

{--
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?

--}
instance (Indexable a, Typeable a, Ord a) => Semigroup (IxSet a) where
    <> :: IxSet a -> IxSet a -> IxSet a
(<>) = IxSet a -> IxSet a -> IxSet a
forall a.
(Ord a, Typeable a, Indexable a) =>
IxSet a -> IxSet a -> IxSet a
union
    
instance (Indexable a, Typeable a, Ord a) => Monoid (IxSet a) where
    mempty :: IxSet a
mempty = IxSet a
forall a. Indexable a => IxSet a
empty
    mappend :: IxSet a -> IxSet a -> IxSet a
mappend = IxSet a -> IxSet a -> IxSet a
forall a.
(Ord a, Typeable a, Indexable a) =>
IxSet a -> IxSet a -> IxSet a
union

-- | Statistics about 'IxSet'. This function returns quadruple
-- consisting of 1. total number of elements in the set 2. number of
-- declared indexes 3. number of keys in all indexes 4. number of
-- values in all keys in all indexes. This can aid you in debugging
-- and optimisation.
stats :: (Ord a) => IxSet a -> (Int,Int,Int,Int)
stats :: IxSet a -> (Int, Int, Int, Int)
stats (IxSet [Ix a]
indexes) = (Int
no_elements,Int
no_indexes,Int
no_keys,Int
no_values)
    where
      no_elements :: Int
no_elements = IxSet a -> Int
forall a. Ord a => IxSet a -> Int
size ([Ix a] -> IxSet a
forall a. [Ix a] -> IxSet a
IxSet [Ix a]
indexes)
      no_indexes :: Int
no_indexes = [Ix a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ix a]
indexes
      no_keys :: Int
no_keys = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Map key (Set a) -> Int
forall k a. Map k a -> Int
Map.size Map key (Set a)
m | Ix Map key (Set a)
m a -> [key]
_ <- [Ix a]
indexes]
      no_values :: Int
no_values = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [[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 key (Set a) -> [Set a]
forall k a. Map k a -> [a]
Map.elems Map key (Set a)
m] | Ix Map key (Set a)
m a -> [key]
_ <- [Ix a]
indexes]