{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, ExistentialQuantification, Rank2Types #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{- |
    /DEPRECATED/: Use "Data.Generics.Uniplate.Data" instead.

    This module exports 'Biplate' instances for everything with 'Data' defined.
    Using GHC the 'Data' instances can be constructed with @deriving Data@.
-}
module Data.Generics.PlateData
    {-# DEPRECATED "Use Data.Generics.Uniplate.Data instead" #-}
    (
    module Data.Generics.Biplate
    ) where

import Data.Generics.Biplate
import Data.Generics.Uniplate.Internal.Utils
import Data.Generics


data Box find = Box {Box find -> forall a. Typeable a => a -> Answer find
fromBox :: forall a . Typeable a => a -> Answer find}

data Answer a = Hit {Answer a -> a
_fromHit :: a} -- you just hit the element you were after (here is a cast)
              | Follow -- go forward, you will find something
              | Miss -- you failed to sink my battleship!



containsMatch :: (Data start, Typeable start, Data find, Typeable find) =>
                 start -> find ->
                 Box find

-- GHC 6.4.2 does not export typeRepKey, so we can't do the trick
-- as efficiently, so we just give up and revert to always following

containsMatch :: start -> find -> Box find
containsMatch start
start find
find = (forall a. Typeable a => a -> Answer find) -> Box find
forall find. (forall a. Typeable a => a -> Answer find) -> Box find
Box forall a. Typeable a => a -> Answer find
forall a a. (Typeable a, Typeable a) => a -> Answer a
query
    where
        query :: a -> Answer a
query a
a = case a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a of
                       Just a
y -> a -> Answer a
forall a. a -> Answer a
Hit a
y
                       Maybe a
Nothing -> Answer a
forall a. Answer a
Follow


instance (Data a, Typeable a) => Uniplate a where
    uniplate :: UniplateType a
uniplate = (forall a. Typeable a => a -> Answer a) -> UniplateType a
forall on with.
(Data on, Data with, Typeable on, Typeable with) =>
(forall a. Typeable a => a -> Answer with) -> on -> CC with on
collect_generate (Box a -> forall a. Typeable a => a -> Answer a
forall find. Box find -> forall a. Typeable a => a -> Answer find
fromBox Box a
answer)
        where
            answer :: Box a
            answer :: Box a
answer = a -> a -> Box a
forall start find.
(Data start, Typeable start, Data find, Typeable find) =>
start -> find -> Box find
containsMatch (a
forall a. HasCallStack => a
undefined :: a) (a
forall a. HasCallStack => a
undefined :: a)


instance (Data a, Data b, Uniplate b, Typeable a, Typeable b) => Biplate a b where
    biplate :: BiplateType a b
biplate = (forall a. Typeable a => a -> Answer b) -> BiplateType a b
forall on with.
(Data on, Data with, Typeable on, Typeable with) =>
(forall a. Typeable a => a -> Answer with) -> on -> CC with on
collect_generate_self (Box b -> forall a. Typeable a => a -> Answer b
forall find. Box find -> forall a. Typeable a => a -> Answer find
fromBox Box b
answer)
        where
            answer :: Box b
            answer :: Box b
answer = a -> b -> Box b
forall start find.
(Data start, Typeable start, Data find, Typeable find) =>
start -> find -> Box find
containsMatch (a
forall a. HasCallStack => a
undefined :: a) (b
forall a. HasCallStack => a
undefined :: b)


newtype C x a = C {C x a -> CC x a
fromC :: CC x a}

type CC x a = (Str x, Str x -> a)


collect_generate_self :: (Data on, Data with, Typeable on, Typeable with) =>
                         (forall a . Typeable a => a -> Answer with) -> on -> CC with on
collect_generate_self :: (forall a. Typeable a => a -> Answer with) -> on -> CC with on
collect_generate_self forall a. Typeable a => a -> Answer with
oracle on
x = CC with on
res
        where
            res :: CC with on
res = case on -> Answer with
forall a. Typeable a => a -> Answer with
oracle on
x of
                       Hit with
y -> (with -> Str with
forall a. a -> Str a
One with
y, \(One with
x) -> with -> on
forall a b. a -> b
unsafeCoerce with
x)
                       Answer with
Follow -> (forall a. Typeable a => a -> Answer with) -> on -> CC with on
forall on with.
(Data on, Data with, Typeable on, Typeable with) =>
(forall a. Typeable a => a -> Answer with) -> on -> CC with on
collect_generate forall a. Typeable a => a -> Answer with
oracle on
x
                       Answer with
Miss -> (Str with
forall a. Str a
Zero, \Str with
_ -> on
x)


collect_generate :: (Data on, Data with, Typeable on, Typeable with) =>
                    (forall a . Typeable a => a -> Answer with) -> on -> CC with on
collect_generate :: (forall a. Typeable a => a -> Answer with) -> on -> CC with on
collect_generate forall a. Typeable a => a -> Answer with
oracle on
item = C with on -> CC with on
forall x a. C x a -> CC x a
fromC (C with on -> CC with on) -> C with on -> CC with on
forall a b. (a -> b) -> a -> b
$ (forall d b. Data d => C with (d -> b) -> d -> C with b)
-> (forall g. g -> C with g) -> on -> C with on
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl forall d b. Data d => C with (d -> b) -> d -> C with b
combine forall g. g -> C with g
forall a x. a -> C x a
create on
item
    where
        -- forall a b . Data a => C with (a -> b) -> a -> C with b
        combine :: C with (t -> a) -> t -> C with a
combine (C (Str with
c,Str with -> t -> a
g)) t
x = case (forall a. Typeable a => a -> Answer with) -> t -> CC with t
forall on with.
(Data on, Data with, Typeable on, Typeable with) =>
(forall a. Typeable a => a -> Answer with) -> on -> CC with on
collect_generate_self forall a. Typeable a => a -> Answer with
oracle t
x of
                                  (Str with
c2, Str with -> t
g2) -> CC with a -> C with a
forall x a. CC x a -> C x a
C (Str with -> Str with -> Str with
forall a. Str a -> Str a -> Str a
Two Str with
c Str with
c2, \(Two Str with
c' Str with
c2') -> Str with -> t -> a
g Str with
c' (Str with -> t
g2 Str with
c2'))

        -- forall g . g -> C with g
        create :: a -> C x a
create a
x = CC x a -> C x a
forall x a. CC x a -> C x a
C (Str x
forall a. Str a
Zero, \Str x
_ -> a
x)