{-# LANGUAGE UndecidableInstances, FlexibleInstances,
             MultiParamTypeClasses, TemplateHaskell, PolymorphicComponents,
             DeriveDataTypeable,ExistentialQuantification, KindSignatures,
             StandaloneDeriving, GADTs #-}

{- |

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

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

import           Control.DeepSeq
-- import           Data.Generics hiding (GT)
-- import qualified Data.Generics.SYB.WithClass.Basics as SYBWC
import           Data.Kind
import qualified Data.List  as List
import           Data.Map   (Map)
import qualified Data.Map   as Map
import qualified Data.Map.Strict as Map.Strict
import           Data.Set   (Set)
import qualified Data.Set   as Set

-- the core datatypes

-- | 'Ix' is a 'Map' from some key (of type 'ix') to a 'Set' of
-- values (of type 'a') for that key.
data Ix (ix :: Type) (a :: Type) where
  Ix :: !(Map ix (Set a)) -> (a -> [ix]) -> Ix ix a

instance (NFData ix, NFData a) => NFData (Ix ix a) where
  rnf :: Ix ix a -> ()
rnf (Ix Map ix (Set a)
m a -> [ix]
f) = Map ix (Set a) -> ()
forall a. NFData a => a -> ()
rnf Map ix (Set a)
m () -> () -> ()
`seq` a -> [ix]
f (a -> [ix]) -> () -> ()
`seq` ()

-- deriving instance Typeable (Ix ix a)

{-
 -- minimal hacky instance
instance Data a => Data (Ix a) where
    toConstr (Ix _ _) = con_Ix_Data
    gunfold _ _     = error "gunfold"
    dataTypeOf _    = ixType_Data
-}

{-
con_Ix_Data :: Constr
con_Ix_Data = mkConstr ixType_Data "Ix" [] Prefix
ixType_Data :: DataType
ixType_Data = mkDataType "Happstack.Data.IxSet.Ix" [con_Ix_Data]
-}

{-
ixConstr :: SYBWC.Constr
ixConstr = SYBWC.mkConstr ixDataType "Ix" [] SYBWC.Prefix
ixDataType :: SYBWC.DataType
ixDataType = SYBWC.mkDataType "Ix" [ixConstr]
-}

{-
instance (SYBWC.Data ctx a, SYBWC.Sat (ctx (Ix a)))
       => SYBWC.Data ctx (Ix a) where
    gfoldl = error "gfoldl Ix"
    toConstr _ (Ix _ _)    = ixConstr
    gunfold = error "gunfold Ix"
    dataTypeOf _ _ = 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.Strict.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
List.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

-- | Helper function to create a new index from a list.
fromList :: (Ord a, Ord k) => [(k, a)] -> Map k (Set a)
fromList :: [(k, a)] -> Map k (Set a)
fromList [(k, a)]
xs =
  (Set a -> Set a -> Set a) -> [(k, Set a)] -> Map k (Set a)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union (((k, a) -> (k, Set a)) -> [(k, a)] -> [(k, Set a)]
forall a b. (a -> b) -> [a] -> [b]
List.map (\ (k
k, a
v) -> (k
k, a -> Set a
forall a. a -> Set a
Set.singleton a
v)) [(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
List.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