    {-# LANGUAGE DeriveDataTypeable #-}

    -- | In some cases, 'Data' instances for abstract types are incorrect,
    --   and fail to work correctly with Uniplate. This module defines three helper
    --   types ('Hide', 'Trigger' and 'Invariant') to assist when writing instances
    --   for abstract types. The 'Hide' type is useful when you want to mark some part
    --   of your data type as being ignored by "Data.Generics.Uniplate.Data"
    --   (and any other 'Data' based generics libraries, such as @syb@).
    --
    --   Using the helper types, this module defines wrappers for types in
    --   the @containers@ package, namely 'Map', 'Set', 'IntMap' and 'IntSet'.
    --   The standard @containers@ 'Data' instances all treat the types as abstract,
    --   but the wrapper types allow you to traverse within the data types, ensuring
    --   the necessary invariants are maintained. In particular, if you do not modify
    --   the keys reconstruct will be /O(n)/ instead of /O(n log n)/.
    --
    --   As an example of how to implement your own abstract type wrappers, the 'Map' data
    --   type is defined as:
    --
    -- @
    --   newtype Map k v = Map ('Invariant' ('Trigger' [k], 'Trigger' [v], Hide (Map.Map k v)))
    --      deriving (Data, Typeable)
    -- @
    --
    --   The 'Map' type is defined as an 'Invariant' of three components - the keys, the values, and
    --   the underlying @Map@. We use 'Invariant' to ensure that the keys/values/map always remain in sync.
    --   We use 'Trigger' on the keys and values to ensure that whenever the keys or values change we
    --   rebuild the @Map@, but if they don't, we reuse the previous @Map@. The 'fromMap' function is
    --   implemented by pattern matching on the 'Map' type:
    --
    -- @
    --   'fromMap' ('Map' ('Invariant' _ (_,_,'Hide' x))) = x
    -- @
    --
    --   The 'toMap' function is slightly harder, as we need to come up with an invariant restoring function:
    --
    -- > toMap :: Ord k => Map.Map k v -> Map k v
    -- > toMap x = Map $ Invariant inv $ create x
    -- >     where
    -- >         create x = (Trigger False ks, Trigger False vs, Hide x)
    -- >             where (ks,vs) = unzip $ Map.toAscList x
    -- >
    -- >         inv (ks,vs,x)
    -- >             | trigger ks = create $ Map.fromList $ zip (fromTrigger ks) (fromTrigger vs)
    -- >             | trigger vs = create $ Map.fromDistinctAscList $ zip (fromTrigger ks) (fromTrigger vs)
    -- >             | otherwise = (ks,vs,x)
    --
    --   The 'create' function creates a value from a @Map@, getting the correct keys and values. The 'inv'
    --   function looks at the triggers on the keys/values. If the keys trigger has been tripped, then we
    --   reconstruct the @Map@ using @fromList@. If the values trigger has been tripped, but they keys trigger
    --   has not, we can use @fromDistinctAscList@, reducing the complexity of constructing the @Map@. If nothing
    --   has changed we can reuse the previous value.
    --
    --   The end result is that all Uniplate (or @syb@) traversals over 'Map' result in a valid value, which has
    --   had all appropriate transformations applied.
    module Data.Generics.Uniplate.Data.Instances(
        Hide(..), Trigger(..), Invariant(..),
        Map, fromMap, toMap,
        Set, fromSet, toSet,
        IntMap, fromIntMap, toIntMap,
        IntSet, fromIntSet, toIntSet
        ) where

    import Data.Data
    import qualified Data.Map as Map
    import qualified Data.Set as Set
    import qualified Data.IntMap as IntMap
    import qualified Data.IntSet as IntSet

    ---------------------------------------------------------------------
    -- DATA TYPES

    -- | The 'Hide' data type has a 'Data' instance which reports having no constructors,
    --   as though the type was defined as using the extension @EmptyDataDecls@:
    --
    -- > data Hide a
    --
    --   This type is suitable for defining regions that are avoided by Uniplate traversals.
    --   As an example:
    --
    -- > transformBi (+1) (1, 2, Hide 3, Just 4) == (2, 3, Hide 3, Just 4)
    --
    --   As a result of having no constructors, any calls to the methods 'toConstr' or 'gunfold'
    --   will raise an error.
    newtype Hide a = Hide {fromHide :: a}
        deriving (Read,Ord,Eq,Typeable)

    instance Show a => Show (Hide a) where
        show (Hide a) = "Hide " ++ show a

    instance Functor Hide where
        fmap f (Hide x) = Hide $ f x

    instance Typeable a => Data (Hide a) where
        gfoldl k z x = z x
        gunfold k z c = error "Data.Generics.Uniplate.Data.Instances.Hide: gunfold not implemented - data type has no constructors"
        toConstr _ = error "Data.Generics.Uniplate.Data.Instances.Hide: toConstr not implemented - data type has no constructors"
        dataTypeOf _ = tyHide

    tyHide = mkDataType "Data.Generics.Uniplate.Data.Instances.Hide" []

    -- | The 'Trigger' data type has a 'Data' instance which reports as being defined:
    --
    -- > data Trigger a = Trigger a
    --
    --   However, whenever a 'gfoldl' or 'gunfold' constructs a new value, it will have the
    --   'trigger' field set to 'True'. The trigger information is useful to indicate whether
    --   any invariants have been broken, and thus need fixing. As an example:
    --
    -- > data SortedList a = SortedList (Trigger [a]) deriving (Data,Typeable)
    -- > toSortedList xs = SortedList $ Trigger False $ sort xs
    -- > fromSortedList (SortedList (Trigger t xs)) = if t then sort xs else xs
    --
    --   This data type represents a sorted list. When constructed the items are initially sorted,
    --   but operations such as 'gmapT' could break that invariant. The 'Trigger' type is used to
    --   detect when the Data operations have been performed, and resort the list.
    --
    --   The 'Trigger' type is often used in conjunction with 'Invariant', which fixes the invariants.
    data Trigger a = Trigger {trigger :: Bool, fromTrigger :: a}
        deriving (Read,Ord,Eq,Show,Typeable)

    instance Functor Trigger where
        fmap f (Trigger a b) = Trigger a $ f b

    instance (Data a, Typeable a) => Data (Trigger a) where
        gfoldl k z (Trigger _ x) = z (Trigger True) `k` x
        gunfold k z c = k $ z $ Trigger True
        toConstr Trigger{} = conTrigger
        dataTypeOf _ = tyTrigger

    conTrigger = mkConstr tyTrigger "Trigger" [] Prefix
    tyTrigger = mkDataType "Data.Generics.Uniplate.Data.Instances.Trigger" [conTrigger]

    -- | The 'Invariant' data type as a 'Data' instance which reports as being defined:
    --
    -- > data Invariant a = Invariant a
    --
    --   However, whenever a 'gfoldl' constructs a new value, it will have the function in
    --   the 'invariant' field applied to it. As an example:
    --
    -- > data SortedList a = SortedList (Invariant [a]) deriving (Data,Typeable)
    -- > toSortedList xs = SortedList $ Invariant sort (sort xs)
    -- > fromSortedList (SortedList (Invariant _ xs)) = xs
    --
    --   Any time an operation such as 'gmapT' is applied to the data type, the 'invariant' function
    --   is applied to the result. The @fromSortedList@ function can then rely on this invariant.
    --
    --   The 'gunfold' method is partially implemented - all constructed values will have an undefined
    --   value for all fields, regardless of which function is passed to 'fromConstrB'. If you only use
    --   'fromConstr' (as Uniplate does) then the 'gunfold' method is sufficient.
    data Invariant a = Invariant {invariant :: a -> a, fromInvariant :: a}
        deriving Typeable

    instance Show a => Show (Invariant a) where
        show (Invariant _ x) = "Invariant " ++ show x

    instance (Data a, Typeable a) => Data (Invariant a) where
        gfoldl k z (Invariant f x) = z (Invariant f . f) `k` x
        gunfold k z c = k $ z $ \x -> Invariant (error msg) (error msg `asTypeOf` x)
            where msg = "Data.Generics.Uniplate.Data.Instances.Invariant: gunfold only partially implemented"
        toConstr Invariant{} = conInvariant
        dataTypeOf _ = tyInvariant

    conInvariant = mkConstr tyInvariant "Invariant" [] Prefix
    tyInvariant = mkDataType "Data.Generics.Uniplate.Data.Instances.Invariant" [conInvariant]

    ---------------------------------------------------------------------
    -- DATA TYPES

    -- | Invariant preserving version of @Map@ from the @containers@ packages, suitable for use with 'Uniplate'.
    --   Use 'toMap' to construct values, and 'fromMap' to deconstruct values.
    newtype Map k v = Map (Invariant (Trigger [k], Trigger [v], Hide (Map.Map k v)))
        deriving (Data, Typeable)

    instance (Show k, Show v) => Show (Map k v) where; show = show . fromMap
    instance (Eq k, Eq v) => Eq (Map k v) where; a == b = fromMap a == fromMap b
    instance (Ord k, Ord v) => Ord (Map k v) where; compare a b = compare (fromMap a) (fromMap b)

    -- | Deconstruct a value of type 'Map'.
    fromMap :: Map k v -> Map.Map k v
    fromMap (Map (Invariant _ (_,_,Hide x))) = x

    -- | Construct a value of type 'Map'.
    toMap :: Ord k => Map.Map k v -> Map k v
    toMap x = Map $ Invariant inv $ create x
        where
            create x = (Trigger False ks, Trigger False vs, Hide x)
                where (ks,vs) = unzip $ Map.toAscList x

            inv (ks,vs,x)
                | trigger ks = create $ Map.fromList $ zip (fromTrigger ks) (fromTrigger vs)
                | trigger vs = create $ Map.fromDistinctAscList $ zip (fromTrigger ks) (fromTrigger vs) -- recreate ks/vs to reduce memory usage
                | otherwise = (ks,vs,x)

    -- | Invariant preserving version of @Set@ from the @containers@ packages, suitable for use with 'Uniplate'.
    --   Use 'toSet' to construct values, and 'fromSet' to deconstruct values.
    newtype Set k = Set (Invariant (Trigger [k], Hide (Set.Set k)))
        deriving (Data, Typeable)

    instance Show k => Show (Set k) where; show = show . fromSet
    instance Eq k => Eq (Set k) where; a == b = fromSet a == fromSet b
    instance Ord k => Ord (Set k) where; compare a b = compare (fromSet a) (fromSet b)

    -- | Deconstruct a value of type 'Set'.
    fromSet :: Set k -> Set.Set k
    fromSet (Set (Invariant _ (_,Hide x))) = x

    -- | Construct a value of type 'Set'.
    toSet :: Ord k => Set.Set k -> Set k
    toSet x = Set $ Invariant inv $ create x
        where
            create x = (Trigger False $ Set.toList x, Hide x)

            inv (ks,x)
                | trigger ks = create $ Set.fromList $ fromTrigger ks
                | otherwise = (ks,x)

    -- | Invariant preserving version of @IntMap@ from the @containers@ packages, suitable for use with 'Uniplate'.
    --   Use 'toIntMap' to construct values, and 'fromIntMap' to deconstruct values.
    newtype IntMap v = IntMap (Invariant (Trigger [Int], Trigger [v], Hide (IntMap.IntMap v)))
        deriving (Data, Typeable)

    instance Show v => Show (IntMap v) where; show = show . fromIntMap
    instance Eq v => Eq (IntMap v) where; a == b = fromIntMap a == fromIntMap b
    instance Ord v => Ord (IntMap v) where; compare a b = compare (fromIntMap a) (fromIntMap b)

    -- | Deconstruct a value of type 'IntMap'.
    fromIntMap :: IntMap v -> IntMap.IntMap v
    fromIntMap (IntMap (Invariant _ (_,_,Hide x))) = x

    -- | Construct a value of type 'IntMap'.
    toIntMap :: IntMap.IntMap v -> IntMap v
    toIntMap x = IntMap $ Invariant inv $ create x
        where
            create x = (Trigger False ks, Trigger False vs, Hide x)
                where (ks,vs) = unzip $ IntMap.toAscList x

            inv (ks,vs,x)
                | trigger ks = create $ IntMap.fromList $ zip (fromTrigger ks) (fromTrigger vs)
                | trigger vs = create $ IntMap.fromDistinctAscList $ zip (fromTrigger ks) (fromTrigger vs) -- recreate ks/vs to reduce memory usage
                | otherwise = (ks,vs,x)

    -- | Invariant preserving version of @IntSet@ from the @containers@ packages, suitable for use with 'Uniplate'.
    --   Use 'toIntSet' to construct values, and 'fromIntSet' to deconstruct values.
    newtype IntSet = IntSet (Invariant (Trigger [Int], Hide (IntSet.IntSet)))
        deriving (Data, Typeable)

    instance Show IntSet where; show = show . fromIntSet
    instance Eq IntSet where; a == b = fromIntSet a == fromIntSet b
    instance Ord IntSet where; compare a b = compare (fromIntSet a) (fromIntSet b)

    -- | Deconstruct a value of type 'IntSet'.
    fromIntSet :: IntSet -> IntSet.IntSet
    fromIntSet (IntSet (Invariant _ (_,Hide x))) = x

    -- | Construct a value of type 'IntSet'.
    toIntSet :: IntSet.IntSet -> IntSet
    toIntSet x = IntSet $ Invariant inv $ create x
        where
            create x = (Trigger False $ IntSet.toList x, Hide x)

            inv (ks,x)
                | trigger ks = create $ IntSet.fromList $ fromTrigger ks
                | otherwise = (ks,x)