{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, ExistentialQuantification, Rank2Types #-}
{-# OPTIONS_GHC -Wno-orphans #-}
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}
| Follow
| Miss
containsMatch :: (Data start, Typeable start, Data find, Typeable find) =>
start -> find ->
Box find
containsMatch :: start -> find -> Box find
containsMatch start :: start
start find :: 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
a = case a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a of
Just y :: a
y -> a -> Answer a
forall a. a -> Answer a
Hit a
y
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 oracle :: forall a. Typeable a => a -> Answer with
oracle x :: 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 y :: with
y -> (with -> Str with
forall a. a -> Str a
One with
y, \(One x :: with
x) -> with -> on
forall a b. a -> b
unsafeCoerce with
x)
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
Miss -> (Str with
forall a. Str a
Zero, \_ -> 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 oracle :: forall a. Typeable a => a -> Answer with
oracle item :: 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
combine :: C with (t -> a) -> t -> C with a
combine (C (c :: Str with
c,g :: Str with -> t -> a
g)) x :: 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
(c2 :: Str with
c2, g2 :: 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 c' :: Str with
c' c2' :: Str with
c2') -> Str with -> t -> a
g Str with
c' (Str with -> t
g2 Str with
c2'))
create :: a -> C x a
create x :: 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, \_ -> a
x)