{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
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 f = (Zero, \_ -> 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 f x = (One x, \(One x) -> f x)
{-# INLINE platePlus #-}
platePlus :: Biplate item to => (item -> from) -> item -> Type from to
platePlus f x = case biplate x of
(ys,y_) -> (ys, \ys -> f $ y_ ys)
{-# INLINE[1] (|*) #-}
(|*) :: Type (to -> from) to -> to -> Type from to
(|*) (xs,x_) y = (Two xs (One y),\(Two xs (One y)) -> x_ xs y)
{-# INLINE[1] (|+) #-}
(|+) :: Biplate item to => Type (item -> from) to -> item -> Type from to
(|+) (xs,x_) y = case biplate y of
(ys,y_) -> (Two xs ys, \(Two xs ys) -> x_ xs (y_ ys))
{-# INLINE[1] (|-) #-}
(|-) :: Type (item -> from) to -> item -> Type from to
(|-) (xs,x_) y = (xs,\xs -> x_ xs y)
{-# INLINE (||*) #-}
(||*) :: Type ([to] -> from) to -> [to] -> Type from to
(||*) (xs,x_) y = (Two xs (listStr y), \(Two xs ys) -> x_ xs (strList ys))
(||+) :: Biplate item to => Type ([item] -> from) to -> [item] -> Type from to
(||+) (xs,x_) [] = (xs, \xs -> x_ xs [])
(||+) (xs,x_) (y:ys) = case plate (:) |+ y ||+ ys of
(ys,y_) -> (Two xs ys, \(Two xs ys) -> x_ xs (y_ ys))
plateSelf :: to -> Type to to
plateSelf x = (One x, \(One x) -> x)
plateProject :: Biplate item to => (from -> item) -> (item -> from) -> from -> Type from to
plateProject into outof = second (outof . ) . biplate . into
instance Uniplate Int where uniplate x = plate x
instance Uniplate Bool where uniplate x = plate x
instance Uniplate Char where uniplate x = plate x
instance Uniplate Integer where uniplate x = plate x
instance Uniplate Double where uniplate x = plate x
instance Uniplate Float where uniplate x = plate x
instance Uniplate () where uniplate x = plate x
instance Uniplate [Char] where
uniplate (x:xs) = plate (x:) |* xs
uniplate x = plate x
instance Biplate [Char] Char where
biplate (x:xs) = plate (:) |* x ||* xs
biplate x = plate x
instance Biplate [Char] [Char] where
biplate = plateSelf
instance Uniplate (Ratio Integer) where
uniplate = plate
instance Biplate (Ratio Integer) (Ratio Integer) where
biplate = plateSelf
instance Biplate (Ratio Integer) Integer where
biplate x = (Two (One (numerator x)) (One (denominator x)), \(Two (One n) (One d)) -> n % d)