    {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
    {-# OPTIONS_GHC -Wno-orphans #-}

    {- |
        This module supplies a method for writing 'Uniplate' and 'Biplate' instances.
        This moulde gives the highest performance, but requires many instance definitions. The
        instances can be generated using Derive: <http://community.haskell.org/~ndm/derive/>.

        To take an example:

        > data Expr = Var Int | Pos Expr String | Neg Expr | Add Expr Expr
        > data Stmt = Seq [Stmt] | Sel [Expr] | Let String Expr
        >
        > instance Uniplate Expr where
        >     uniplate (Var x  ) = plate Var |- x
        >     uniplate (Pos x y) = plate Pos |* x |- y
        >     uniplate (Neg x  ) = plate Neg |* x
        >     uniplate (Add x y) = plate Add |* x |* y
        >
        > instance Biplate Expr Expr where
        >     biplate = plateSelf
        >
        > instance Uniplate Stmt where
        >     uniplate (Seq x  ) = plate Seq ||* x
        >     uniplate (Sel x  ) = plate Sel ||+ x
        >     uniplate (Let x y) = plate Let |-  x |- y
        >
        > instance Biplate Stmt Stmt where
        >     biplate = plateSelf
        >
        > instance Biplate Stmt Expr where
        >     biplate (Seq x  ) = plate Seq ||+ x
        >     biplate (Sel x  ) = plate Sel ||* x
        >     biplate (Let x y) = plate Let |-  x |* y

        To define instances for abstract data types, such as @Map@ or @Set@ from the @containers@ package,
        use 'plateProject'.

        This module provides a few monomorphic instances of 'Uniplate' / 'Biplate'
        for common types available in the base library, but does not provide any polymorphic
        instances. Given only monomorphic instances it is trivial to ensure that all instances
        are disjoint, making it easier to add your own instances.

        When defining polymorphic instances, be carefully to mention all potential children.
        Consider @Biplate Int (Int, a)@ - this instance cannot be correct because it will fail
        to return both @Int@ values on @(Int,Int)@. There are some legitimate polymorphic instances,
        such as @Biplate a [a]@ and @Biplate a a@, but take care to avoid overlapping instances.
    -}
    module Data.Generics.Uniplate.Direct(
        module Data.Generics.Uniplate.Operations,
        -- * The Combinators
        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)

    -- | The main combinator used to start the chain.
    --
    -- The following rule can be used for optimisation:
    --
    -- > plate Ctor |- x == plate (Ctor x)
    {-# INLINE[1] plate #-}
    plate :: from -> Type from to
    plate :: forall from to. from -> Type from to
    plate from
    f = (Str to
    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 = (to -> Str to
    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 item -> (Str to, Str to -> item)
    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 (item -> from) -> item -> from
    forall a b. (a -> b) -> a -> b
    $ Str to -> item
    y_ Str to
    ys)

    -- | The field to the right is the target.
    {-# 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 = (Str to -> Str to -> Str to
    forall a. Str a -> Str a -> Str a
    Two Str to
    xs (to -> Str to
    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)

    -- | The field to the right may contain the target.
    {-# 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 item -> (Str to, Str to -> item)
    forall from to. Biplate from to => from -> (Str to, Str to -> from)
    biplate item
    y of
                          (Str to
    ys,Str to -> item
    y_) -> (Str to -> Str to -> Str to
    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))

    -- | The field to the right /does not/ contain the target.
    {-# 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)

    -- | The field to the right is a list of the type of the target
    {-# 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 = (Str to -> Str to -> Str to
    forall a. Str a -> Str a -> Str a
    Two Str to
    xs ([to] -> Str to
    forall a. [a] -> Str a
    listStr [to]
    y), \(Two Str to
    xs Str to
    ys) -> Str to -> [to] -> from
    x_ Str to
    xs (Str to -> [to]
    forall a. Str a -> [a]
    strList Str to
    ys))

    -- | The field to the right is a list of types which may contain the target
    (||+) :: 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 []) -- can eliminate a Two _ Zero in the base case
    (||+) (Str to
    xs,Str to -> [item] -> from
    x_) (item
    y:[item]
    ys) = case (item -> [item] -> [item]) -> Type (item -> [item] -> [item]) to
    forall from to. from -> Type from to
    plate (:) Type (item -> [item] -> [item]) to
    -> item -> Type ([item] -> [item]) to
    forall item to from.
    Biplate item to =>
    Type (item -> from) to -> item -> Type from to
    |+ item
    y Type ([item] -> [item]) to -> [item] -> Type [item] to
    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_) -> (Str to -> Str to -> Str to
    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))

    -- | Used for 'Biplate' definitions where both types are the same.
    plateSelf :: to -> Type to to
    plateSelf :: forall to. to -> Type to to
    plateSelf to
    x = (to -> Str to
    forall a. a -> Str a
    One to
    x, \(One to
    x) -> to
    x)

    -- | Write an instance in terms of a projection/injection pair. Usually used to define instances
    --   for abstract containers such as Map:
    --
    -- > instance Biplate (Map.Map [Char] Int) Char where
    -- >     biplate = plateProject Map.toList Map.fromList
    --
    --   If the types ensure that no operations will not change the keys
    --   we can use the 'fromDistictAscList' function to reconstruct the Map:
    --
    -- > instance Biplate (Map.Map [Char] Int) Int where
    -- >     biplate = plateProject Map.toAscList Map.fromDistinctAscList
    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 = ((Str to -> item) -> Str to -> from)
    -> (Str to, Str to -> item) -> (Str to, Str to -> from)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (item -> from
    outof (item -> from) -> (Str to -> item) -> Str to -> from
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ) ((Str to, Str to -> item) -> (Str to, Str to -> from))
    -> (from -> (Str to, Str to -> item))
    -> from
    -> (Str to, Str to -> from)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . item -> (Str to, Str to -> item)
    forall from to. Biplate from to => from -> (Str to, Str to -> from)
    biplate (item -> (Str to, Str to -> item))
    -> (from -> item) -> from -> (Str to, Str to -> item)
    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 = Int -> (Str Int, Str Int -> Int)
    forall from to. from -> Type from to
    plate Int
    x
    instance Uniplate Bool where uniplate :: Bool -> (Str Bool, Str Bool -> Bool)
    uniplate Bool
    x = Bool -> (Str Bool, Str Bool -> Bool)
    forall from to. from -> Type from to
    plate Bool
    x
    instance Uniplate Char where uniplate :: Char -> (Str Char, Str Char -> Char)
    uniplate Char
    x = Char -> (Str Char, Str Char -> Char)
    forall from to. from -> Type from to
    plate Char
    x
    instance Uniplate Integer where uniplate :: Integer -> (Str Integer, Str Integer -> Integer)
    uniplate Integer
    x = Integer -> (Str Integer, Str Integer -> Integer)
    forall from to. from -> Type from to
    plate Integer
    x
    instance Uniplate Double where uniplate :: Double -> (Str Double, Str Double -> Double)
    uniplate Double
    x = Double -> (Str Double, Str Double -> Double)
    forall from to. from -> Type from to
    plate Double
    x
    instance Uniplate Float where uniplate :: Float -> (Str Float, Str Float -> Float)
    uniplate Float
    x = Float -> (Str Float, Str Float -> Float)
    forall from to. from -> Type from to
    plate Float
    x
    instance Uniplate () where uniplate :: () -> (Str (), Str () -> ())
    uniplate ()
    x = () -> (Str (), Str () -> ())
    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) = ([Char] -> [Char]) -> Type ([Char] -> [Char]) [Char]
    forall from to. from -> Type from to
    plate (Char
    xChar -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :) Type ([Char] -> [Char]) [Char]
    -> [Char] -> (Str [Char], Str [Char] -> [Char])
    forall to from. Type (to -> from) to -> to -> Type from to
    |* [Char]
    xs
        uniplate [Char]
    x = [Char] -> (Str [Char], Str [Char] -> [Char])
    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) = (Char -> [Char] -> [Char]) -> Type (Char -> [Char] -> [Char]) Char
    forall from to. from -> Type from to
    plate (:) Type (Char -> [Char] -> [Char]) Char
    -> Char -> Type ([Char] -> [Char]) Char
    forall to from. Type (to -> from) to -> to -> Type from to
    |* Char
    x Type ([Char] -> [Char]) Char
    -> [Char] -> (Str Char, Str Char -> [Char])
    forall to from. Type ([to] -> from) to -> [to] -> Type from to
    ||* [Char]
    xs
        biplate [Char]
    x = [Char] -> (Str Char, Str Char -> [Char])
    forall from to. from -> Type from to
    plate [Char]
    x

    instance Biplate [Char] [Char] where
        biplate :: [Char] -> (Str [Char], Str [Char] -> [Char])
    biplate = [Char] -> (Str [Char], Str [Char] -> [Char])
    forall to. to -> Type to to
    plateSelf

    instance Uniplate (Ratio Integer) where
        uniplate :: Ratio Integer
    -> (Str (Ratio Integer), Str (Ratio Integer) -> Ratio Integer)
    uniplate = Ratio Integer
    -> (Str (Ratio Integer), Str (Ratio Integer) -> Ratio Integer)
    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 = Ratio Integer
    -> (Str (Ratio Integer), Str (Ratio Integer) -> Ratio Integer)
    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 = (Str Integer -> Str Integer -> Str Integer
    forall a. Str a -> Str a -> Str a
    Two (Integer -> Str Integer
    forall a. a -> Str a
    One (Ratio Integer -> Integer
    forall a. Ratio a -> a
    numerator Ratio Integer
    x)) (Integer -> Str Integer
    forall a. a -> Str a
    One (Ratio Integer -> Integer
    forall a. Ratio a -> a
    denominator Ratio Integer
    x)), \(Two (One Integer
    n) (One Integer
    d)) -> Integer
    n Integer -> Integer -> Ratio Integer
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    d)