{-# LANGUAGE UndecidableInstances, OverlappingInstances, FlexibleContexts, FlexibleInstances,
             MultiParamTypeClasses, TemplateHaskell, PolymorphicComponents,
             DeriveDataTypeable,ExistentialQuantification #-}

{- |

This module defines 'Typeable' indexes and convenience functions. Should
probably be considered private to "Data.IxSet".

-}
module Data.IxSet.Ix
    ( Ix(..)
    , insert
    , delete
    , insertList
    , deleteList
    , union
    , intersection
    )
    where

import           Data.Generics hiding (GT)
import qualified Data.Generics.SYB.WithClass.Basics as SYBWC
import           Data.List  (foldl')
import           Data.Map   (Map)
import qualified Data.Map.Strict as Map
import           Data.Set   (Set)
import qualified Data.Set   as Set

-- the core datatypes

-- | 'Ix' is a 'Map' from some 'Typeable' key to a 'Set' of values for
-- that key.  'Ix' carries type information inside.
data Ix a = forall key . (Typeable key, Ord key) =>
            Ix (Map key (Set a)) (a -> [key])
    deriving Typeable

 -- minimal hacky instance
instance Data a => Data (Ix a) where
    toConstr :: Ix a -> Constr
toConstr (Ix Map key (Set a)
_ a -> [key]
_) = Constr
con_Ix_Data
    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ix a)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_     = [Char] -> Constr -> c (Ix a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
    dataTypeOf :: Ix a -> DataType
dataTypeOf Ix a
_    = DataType
ixType_Data


con_Ix_Data :: Constr
con_Ix_Data :: Constr
con_Ix_Data = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
ixType_Data [Char]
"Ix" [] Fixity
Prefix
ixType_Data :: DataType
ixType_Data :: DataType
ixType_Data = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Happstack.Data.IxSet.Ix" [Constr
con_Ix_Data]

ixConstr :: SYBWC.Constr
ixConstr :: Constr
ixConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
SYBWC.mkConstr DataType
ixDataType [Char]
"Ix" [] Fixity
SYBWC.Prefix
ixDataType :: SYBWC.DataType
ixDataType :: DataType
ixDataType = [Char] -> [Constr] -> DataType
SYBWC.mkDataType [Char]
"Ix" [Constr
ixConstr]

instance (SYBWC.Typeable Ix, SYBWC.Data ctx a, SYBWC.Sat (ctx (Ix a)))
       => SYBWC.Data ctx (Ix a) where
    gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> Ix a
-> w (Ix a)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
_ forall g. g -> w g
_ Ix a
_ = [Char] -> w (Ix a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gfoldl Ix" :: w (Ix a)
    toConstr :: Proxy ctx -> Ix a -> Constr
toConstr Proxy ctx
_ (Ix Map key (Set a)
_ a -> [key]
_)    = Constr
ixConstr
    gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Ix a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ = [Char] -> c (Ix a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold Ix" :: c (Ix a)
    dataTypeOf :: Proxy ctx -> Ix a -> DataType
dataTypeOf Proxy ctx
_ Ix a
_ = DataType
ixDataType

-- modification operations

-- | Convenience function for inserting into 'Map's of 'Set's as in
-- the case of an 'Ix'.  If they key did not already exist in the
-- 'Map', then a new 'Set' is added transparently.
insert :: (Ord a, Ord k)
       => k -> a -> Map k (Set a) -> Map k (Set a)
insert :: k -> a -> Map k (Set a) -> Map k (Set a)
insert k
k a
v Map k (Set a)
index = (Set a -> Set a -> Set a)
-> k -> Set a -> Map k (Set a) -> Map k (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 k
k (a -> Set a
forall a. a -> Set a
Set.singleton a
v) Map k (Set a)
index

-- | Helper function to 'insert' a list of elements into a set.
insertList :: (Ord a, Ord k)
           => [(k,a)] -> Map k (Set a) -> Map k (Set a)
insertList :: [(k, a)] -> Map k (Set a) -> Map k (Set a)
insertList [(k, a)]
xs Map k (Set a)
index = (Map k (Set a) -> (k, a) -> Map k (Set a))
-> Map k (Set a) -> [(k, a)] -> Map k (Set a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map k (Set a)
m (k
k,a
v)-> k -> a -> Map k (Set a) -> Map k (Set a)
forall a k.
(Ord a, Ord k) =>
k -> a -> Map k (Set a) -> Map k (Set a)
insert k
k a
v Map k (Set a)
m) Map k (Set a)
index [(k, a)]
xs

-- | Convenience function for deleting from 'Map's of 'Set's. If the
-- resulting 'Set' is empty, then the entry is removed from the 'Map'.
delete :: (Ord a, Ord k)
       => k -> a -> Map k (Set a) -> Map k (Set a)
delete :: k -> a -> Map k (Set a) -> Map k (Set a)
delete k
k a
v Map k (Set a)
index = (Set a -> Maybe (Set a)) -> k -> Map k (Set a) -> Map k (Set a)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Set a -> Maybe (Set a)
remove k
k Map k (Set a)
index
    where
    remove :: Set a -> Maybe (Set a)
remove Set a
set = let set' :: Set a
set' = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
v Set a
set
                 in if Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
set' then Maybe (Set a)
forall a. Maybe a
Nothing else Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just Set a
set'

-- | Helper function to 'delete' a list of elements from a set.
deleteList :: (Ord a, Ord k)
           => [(k,a)] -> Map k (Set a) -> Map k (Set a)
deleteList :: [(k, a)] -> Map k (Set a) -> Map k (Set a)
deleteList [(k, a)]
xs Map k (Set a)
index = (Map k (Set a) -> (k, a) -> Map k (Set a))
-> Map k (Set a) -> [(k, a)] -> Map k (Set a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map k (Set a)
m (k
k,a
v) -> k -> a -> Map k (Set a) -> Map k (Set a)
forall a k.
(Ord a, Ord k) =>
k -> a -> Map k (Set a) -> Map k (Set a)
delete k
k a
v Map k (Set a)
m) Map k (Set a)
index [(k, a)]
xs

-- | Takes the union of two sets.
union :: (Ord a, Ord k)
       => Map k (Set a) -> Map k (Set a) -> Map k (Set a)
union :: Map k (Set a) -> Map k (Set a) -> Map k (Set a)
union Map k (Set a)
index1 Map k (Set a)
index2 = (Set a -> Set a -> Set a)
-> Map k (Set a) -> Map k (Set a) -> Map k (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 k (Set a)
index1 Map k (Set a)
index2

-- | Takes the intersection of two sets.
intersection :: (Ord a, Ord k)
             => Map k (Set a) -> Map k (Set a) -> Map k (Set a)
intersection :: Map k (Set a) -> Map k (Set a) -> Map k (Set a)
intersection Map k (Set a)
index1 Map k (Set a)
index2 = (Set a -> Bool) -> Map k (Set a) -> Map k (Set a)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (Set a -> Bool) -> Set a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Bool
forall a. Set a -> Bool
Set.null) (Map k (Set a) -> Map k (Set a)) -> Map k (Set a) -> Map k (Set a)
forall a b. (a -> b) -> a -> b
$
                             (Set a -> Set a -> Set a)
-> Map k (Set a) -> Map k (Set a) -> Map k (Set a)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Map k (Set a)
index1 Map k (Set a)
index2