{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Generics.Uniplate.Direct(
module Data.Generics.Uniplate.Operations,
plate, plateSelf,
(|+), (|-), (|*), (||+), (||*),
plateProject
) where
import Control.Arrow
import Data.Generics.Uniplate.Operations
import Data.Generics.Str
import Data.Ratio
type Type from to = (Str to, Str to -> from)
{-# INLINE[1] plate #-}
plate :: from -> Type from to
plate :: forall from to. from -> Type from to
plate from
f = (forall a. Str a
Zero, \Str to
_ -> from
f)
{-# RULES
"plate/-" forall f x. plate f |- x = plate (f x)
"plate/+" forall f x. plate f |+ x = platePlus f x
"plate/*" forall f x. plate f |* x = plateStar f x #-}
{-# INLINE plateStar #-}
plateStar :: (to -> from) -> to -> Type from to
plateStar :: forall to from. (to -> from) -> to -> Type from to
plateStar to -> from
f to
x = (forall a. a -> Str a
One to
x, \(One to
x) -> to -> from
f to
x)
{-# INLINE platePlus #-}
platePlus :: Biplate item to => (item -> from) -> item -> Type from to
platePlus :: forall item to from.
Biplate item to =>
(item -> from) -> item -> Type from to
platePlus item -> from
f item
x = case forall from to. Biplate from to => from -> (Str to, Str to -> from)
biplate item
x of
(Str to
ys,Str to -> item
y_) -> (Str to
ys, \Str to
ys -> item -> from
f forall a b. (a -> b) -> a -> b
$ Str to -> item
y_ Str to
ys)
{-# INLINE[1] (|*) #-}
(|*) :: Type (to -> from) to -> to -> Type from to
|* :: forall to from. Type (to -> from) to -> to -> Type from to
(|*) (Str to
xs,Str to -> to -> from
x_) to
y = (forall a. Str a -> Str a -> Str a
Two Str to
xs (forall a. a -> Str a
One to
y),\(Two Str to
xs (One to
y)) -> Str to -> to -> from
x_ Str to
xs to
y)
{-# INLINE[1] (|+) #-}
(|+) :: Biplate item to => Type (item -> from) to -> item -> Type from to
|+ :: forall item to from.
Biplate item to =>
Type (item -> from) to -> item -> Type from to
(|+) (Str to
xs,Str to -> item -> from
x_) item
y = case forall from to. Biplate from to => from -> (Str to, Str to -> from)
biplate item
y of
(Str to
ys,Str to -> item
y_) -> (forall a. Str a -> Str a -> Str a
Two Str to
xs Str to
ys, \(Two Str to
xs Str to
ys) -> Str to -> item -> from
x_ Str to
xs (Str to -> item
y_ Str to
ys))
{-# INLINE[1] (|-) #-}
(|-) :: Type (item -> from) to -> item -> Type from to
|- :: forall item from to. Type (item -> from) to -> item -> Type from to
(|-) (Str to
xs,Str to -> item -> from
x_) item
y = (Str to
xs,\Str to
xs -> Str to -> item -> from
x_ Str to
xs item
y)
{-# INLINE (||*) #-}
(||*) :: Type ([to] -> from) to -> [to] -> Type from to
||* :: forall to from. Type ([to] -> from) to -> [to] -> Type from to
(||*) (Str to
xs,Str to -> [to] -> from
x_) [to]
y = (forall a. Str a -> Str a -> Str a
Two Str to
xs (forall a. [a] -> Str a
listStr [to]
y), \(Two Str to
xs Str to
ys) -> Str to -> [to] -> from
x_ Str to
xs (forall a. Str a -> [a]
strList Str to
ys))
(||+) :: Biplate item to => Type ([item] -> from) to -> [item] -> Type from to
||+ :: forall item to from.
Biplate item to =>
Type ([item] -> from) to -> [item] -> Type from to
(||+) (Str to
xs,Str to -> [item] -> from
x_) [] = (Str to
xs, \Str to
xs -> Str to -> [item] -> from
x_ Str to
xs [])
(||+) (Str to
xs,Str to -> [item] -> from
x_) (item
y:[item]
ys) = case forall from to. from -> Type from to
plate (:) forall item to from.
Biplate item to =>
Type (item -> from) to -> item -> Type from to
|+ item
y forall item to from.
Biplate item to =>
Type ([item] -> from) to -> [item] -> Type from to
||+ [item]
ys of
(Str to
ys,Str to -> [item]
y_) -> (forall a. Str a -> Str a -> Str a
Two Str to
xs Str to
ys, \(Two Str to
xs Str to
ys) -> Str to -> [item] -> from
x_ Str to
xs (Str to -> [item]
y_ Str to
ys))
plateSelf :: to -> Type to to
plateSelf :: forall to. to -> Type to to
plateSelf to
x = (forall a. a -> Str a
One to
x, \(One to
x) -> to
x)
plateProject :: Biplate item to => (from -> item) -> (item -> from) -> from -> Type from to
plateProject :: forall item to from.
Biplate item to =>
(from -> item) -> (item -> from) -> from -> Type from to
plateProject from -> item
into item -> from
outof = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (item -> from
outof forall b c a. (b -> c) -> (a -> b) -> a -> c
. ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. Biplate from to => from -> (Str to, Str to -> from)
biplate forall b c a. (b -> c) -> (a -> b) -> a -> c
. from -> item
into
instance Uniplate Int where uniplate :: Int -> (Str Int, Str Int -> Int)
uniplate Int
x = forall from to. from -> Type from to
plate Int
x
instance Uniplate Bool where uniplate :: Bool -> (Str Bool, Str Bool -> Bool)
uniplate Bool
x = forall from to. from -> Type from to
plate Bool
x
instance Uniplate Char where uniplate :: Char -> (Str Char, Str Char -> Char)
uniplate Char
x = forall from to. from -> Type from to
plate Char
x
instance Uniplate Integer where uniplate :: Integer -> (Str Integer, Str Integer -> Integer)
uniplate Integer
x = forall from to. from -> Type from to
plate Integer
x
instance Uniplate Double where uniplate :: Double -> (Str Double, Str Double -> Double)
uniplate Double
x = forall from to. from -> Type from to
plate Double
x
instance Uniplate Float where uniplate :: Float -> (Str Float, Str Float -> Float)
uniplate Float
x = forall from to. from -> Type from to
plate Float
x
instance Uniplate () where uniplate :: () -> (Str (), Str () -> ())
uniplate ()
x = forall from to. from -> Type from to
plate ()
x
instance Uniplate [Char] where
uniplate :: [Char] -> (Str [Char], Str [Char] -> [Char])
uniplate (Char
x:[Char]
xs) = forall from to. from -> Type from to
plate (Char
xforall a. a -> [a] -> [a]
:) forall to from. Type (to -> from) to -> to -> Type from to
|* [Char]
xs
uniplate [Char]
x = forall from to. from -> Type from to
plate [Char]
x
instance Biplate [Char] Char where
biplate :: [Char] -> (Str Char, Str Char -> [Char])
biplate (Char
x:[Char]
xs) = forall from to. from -> Type from to
plate (:) forall to from. Type (to -> from) to -> to -> Type from to
|* Char
x forall to from. Type ([to] -> from) to -> [to] -> Type from to
||* [Char]
xs
biplate [Char]
x = forall from to. from -> Type from to
plate [Char]
x
instance Biplate [Char] [Char] where
biplate :: [Char] -> (Str [Char], Str [Char] -> [Char])
biplate = forall to. to -> Type to to
plateSelf
instance Uniplate (Ratio Integer) where
uniplate :: Ratio Integer
-> (Str (Ratio Integer), Str (Ratio Integer) -> Ratio Integer)
uniplate = forall from to. from -> Type from to
plate
instance Biplate (Ratio Integer) (Ratio Integer) where
biplate :: Ratio Integer
-> (Str (Ratio Integer), Str (Ratio Integer) -> Ratio Integer)
biplate = forall to. to -> Type to to
plateSelf
instance Biplate (Ratio Integer) Integer where
biplate :: Ratio Integer -> (Str Integer, Str Integer -> Ratio Integer)
biplate Ratio Integer
x = (forall a. Str a -> Str a -> Str a
Two (forall a. a -> Str a
One (forall a. Ratio a -> a
numerator Ratio Integer
x)) (forall a. a -> Str a
One (forall a. Ratio a -> a
denominator Ratio Integer
x)), \(Two (One Integer
n) (One Integer
d)) -> Integer
n forall a. Integral a => a -> a -> Ratio a
% Integer
d)