    {-# LANGUAGE UndecidableInstances, OverlappingInstances, 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 _ _) = 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 _ _     = [Char] -> Constr -> c (Ix a)
    forall a. HasCallStack => [Char] -> a
    error "gunfold"
        dataTypeOf :: Ix a -> DataType
    dataTypeOf _    = DataType
    ixType_Data

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

    ixConstr :: SYBWC.Constr
    ixConstr :: Constr
    ixConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
    SYBWC.mkConstr DataType
    ixDataType "Ix" [] Fixity
    SYBWC.Prefix
    ixDataType :: SYBWC.DataType
    ixDataType :: DataType
    ixDataType = [Char] -> [Constr] -> DataType
    SYBWC.mkDataType "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 _ _ _ _ = [Char] -> w (Ix a)
    forall a. HasCallStack => [Char] -> a
    error "gfoldl Ix" :: w (Ix a)
        toConstr :: Proxy ctx -> Ix a -> Constr
    toConstr _ (Ix _ _)    = 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 _ _ _ _ = [Char] -> c (Ix a)
    forall a. HasCallStack => [Char] -> a
    error "gunfold Ix" :: c (Ix a)
        dataTypeOf :: Proxy ctx -> Ix a -> DataType
    dataTypeOf _ _ = 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
    k v :: a
    v index :: 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 xs :: [(k, a)]
    xs index :: 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' (\m :: Map k (Set a)
    m (k :: k
    k,v :: 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
    k v :: a
    v index :: 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 :: 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 xs :: [(k, a)]
    xs index :: 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' (\m :: Map k (Set a)
    m (k :: k
    k,v :: 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 index1 :: Map k (Set a)
    index1 index2 :: 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 index1 :: Map k (Set a)
    index1 index2 :: 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