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

{- |
    /RECOMMENDATION:/ Use "Data.Generics.Uniplate.Data" instead - it usually performs
    faster (sometimes significantly so) and requires no special instance declarations.

    This module supplies a method for writing 'Uniplate' / 'Biplate' instances. One
    instance declaration is required for each data type you wish to work with. The
    instances can be generated using Derive: <http://community.haskell.org/~ndm/derive/>.

    To take an example:

    > data Expr = Var Int | Neg Expr | Add Expr Expr
    >             deriving Typeable
    >
    > instance (Typeable a, Uniplate a) => PlateAll Expr a where
    >     plateAll (Var x  ) = plate Var |+ x
    >     plateAll (Neg x  ) = plate Neg |+ x
    >     plateAll (Add x y) = plate Add |+ x |+ y
-}

module Data.Generics.Uniplate.Typeable(
    module Data.Generics.Uniplate.Operations,
    module Data.Typeable,
    -- * The Class
    PlateAll(..),
    -- * The Combinators
    plate, (|+), (|-), plateProject
    ) where

import Control.Arrow
import Data.Generics.Uniplate.Operations
import Data.Generics.Uniplate.Internal.Utils
import Data.Generics.Str
import Data.Typeable
import Data.Ratio


instance (Typeable a, Typeable b, Uniplate b, PlateAll a b) => Biplate a b where
    biplate :: a -> (Str b, Str b -> a)
biplate = a -> (Str b, Str b -> a)
forall from to.
(Typeable from, Typeable to, PlateAll from to) =>
from -> Type from to
plateMore

instance PlateAll a a => Uniplate a where
    uniplate :: a -> (Str a, Str a -> a)
uniplate = a -> (Str a, Str a -> a)
forall from to. PlateAll from to => from -> Type from to
plateAll


type Type from to = (Str to, Str to -> from)


plateMore :: (Typeable from, Typeable to, PlateAll from to) => from -> Type from to
plateMore :: from -> Type from to
plateMore from
x = Type from to
res
    where
        res :: Type from to
res = case Maybe to -> Maybe to -> Maybe to
forall a. a -> a -> a
asTypeOf (from -> Maybe to
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast from
x) (to -> Maybe to
forall a. a -> Maybe a
Just (to -> Maybe to) -> to -> Maybe to
forall a b. (a -> b) -> a -> b
$ Str to -> to
forall a. Str a -> a
strType (Str to -> to) -> Str to -> to
forall a b. (a -> b) -> a -> b
$ Type from to -> Str to
forall a b. (a, b) -> a
fst Type from to
res) of
                  Maybe to
Nothing -> from -> Type from to
forall from to. PlateAll from to => from -> Type from to
plateAll from
x
                  Just to
y -> (to -> Str to
forall a. a -> Str a
One to
y, \(One to
y) -> to -> from
forall a b. a -> b
unsafeCoerce to
y)


-- | This class should be defined for each data type of interest.
class PlateAll from to where
    -- | This method should be defined using 'plate' and '|+', '|-'.
    plateAll :: from -> Type from to


-- | The main combinator used to start the chain.
plate :: from -> Type from to
plate :: from -> Type from to
plate from
x = (Str to
forall a. Str a
Zero, \Str to
_ -> from
x)


-- | The field to the right may contain the target.
(|+) :: (Typeable item, Typeable to, PlateAll item to) => Type (item -> from) to -> item -> Type from to
|+ :: Type (item -> from) to -> item -> Type from to
(|+) (Str to
xs,Str to -> item -> from
x_) item
y = case item -> Type item to
forall from to.
(Typeable from, Typeable to, PlateAll from to) =>
from -> Type from to
plateMore 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.
--   This can be used as either an optimisation, or more commonly for excluding
--   primitives such as Int.
(|-) :: Type (item -> from) to -> item -> Type 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)


-- | Write an instance in terms of a projection/injection pair. Usually used to define instances
--   for abstract containers such as Map:
--
-- > instance (Ord a, Typeable a, PlateAll a c, Typeable b, PlateAll b c,
-- >          Typeable c, PlateAll c c) => PlateAll (Map.Map a b) c where
-- >     plateAll = plateProject Map.toList Map.fromList
plateProject :: (Typeable item, Typeable to, PlateAll item to) => (from -> item) -> (item -> from) -> from -> Type from to
plateProject :: (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) -> Type from to
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) -> Type from to)
-> (from -> (Str to, Str to -> item)) -> from -> Type from to
forall b c a. (b -> c) -> (a -> b) -> a -> c
. item -> (Str to, Str to -> item)
forall from to. PlateAll from to => from -> Type from to
plateAll (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


-- * Instances

-- ** Primitive Types

instance PlateAll Int to where plateAll :: Int -> Type Int to
plateAll Int
x = Int -> Type Int to
forall from to. from -> Type from to
plate Int
x
instance PlateAll Bool to where plateAll :: Bool -> Type Bool to
plateAll Bool
x = Bool -> Type Bool to
forall from to. from -> Type from to
plate Bool
x
instance PlateAll Char to where plateAll :: Char -> Type Char to
plateAll Char
x = Char -> Type Char to
forall from to. from -> Type from to
plate Char
x
instance PlateAll Integer to where plateAll :: Integer -> Type Integer to
plateAll Integer
x = Integer -> Type Integer to
forall from to. from -> Type from to
plate Integer
x
instance PlateAll Double to where plateAll :: Double -> Type Double to
plateAll Double
x = Double -> Type Double to
forall from to. from -> Type from to
plate Double
x
instance PlateAll Float to where plateAll :: Float -> Type Float to
plateAll Float
x = Float -> Type Float to
forall from to. from -> Type from to
plate Float
x
instance PlateAll () to where plateAll :: () -> Type () to
plateAll ()
x = () -> Type () to
forall from to. from -> Type from to
plate ()
x

-- ** Container Types

instance (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll [from] to where
    plateAll :: [from] -> Type [from] to
plateAll []     = [from] -> Type [from] to
forall from to. from -> Type from to
plate []
    plateAll (from
x:[from]
xs) = (from -> [from] -> [from]) -> Type (from -> [from] -> [from]) to
forall from to. from -> Type from to
plate (:) Type (from -> [from] -> [from]) to
-> from -> Type ([from] -> [from]) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ from
x Type ([from] -> [from]) to -> [from] -> Type [from] to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ [from]
xs

instance (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll (Maybe from) to where
    plateAll :: Maybe from -> Type (Maybe from) to
plateAll Maybe from
Nothing  = Maybe from -> Type (Maybe from) to
forall from to. from -> Type from to
plate Maybe from
forall a. Maybe a
Nothing
    plateAll (Just from
x) = (from -> Maybe from) -> Type (from -> Maybe from) to
forall from to. from -> Type from to
plate from -> Maybe from
forall a. a -> Maybe a
Just Type (from -> Maybe from) to -> from -> Type (Maybe from) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ from
x

instance (PlateAll a to, Typeable a, PlateAll b to, Typeable b, Typeable to, Uniplate to) =>
         PlateAll (Either a b) to where
    plateAll :: Either a b -> Type (Either a b) to
plateAll (Left  a
x) = (a -> Either a b) -> Type (a -> Either a b) to
forall from to. from -> Type from to
plate a -> Either a b
forall a b. a -> Either a b
Left  Type (a -> Either a b) to -> a -> Type (Either a b) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ a
x
    plateAll (Right b
x) = (b -> Either a b) -> Type (b -> Either a b) to
forall from to. from -> Type from to
plate b -> Either a b
forall a b. b -> Either a b
Right Type (b -> Either a b) to -> b -> Type (Either a b) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ b
x

instance (PlateAll a to, Typeable a
         ,PlateAll b to, Typeable b
         ,Typeable to, Uniplate to) =>
         PlateAll (a,b) to where
    plateAll :: (a, b) -> Type (a, b) to
plateAll (a
a,b
b) = (a -> b -> (a, b)) -> Type (a -> b -> (a, b)) to
forall from to. from -> Type from to
plate (,) Type (a -> b -> (a, b)) to -> a -> Type (b -> (a, b)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ a
a Type (b -> (a, b)) to -> b -> Type (a, b) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ b
b

instance (PlateAll a to, Typeable a
         ,PlateAll b to, Typeable b
         ,PlateAll c to, Typeable c
         ,Typeable to, Uniplate to) =>
         PlateAll (a,b,c) to where
    plateAll :: (a, b, c) -> Type (a, b, c) to
plateAll (a
a,b
b,c
c) = (a -> b -> c -> (a, b, c)) -> Type (a -> b -> c -> (a, b, c)) to
forall from to. from -> Type from to
plate (,,) Type (a -> b -> c -> (a, b, c)) to
-> a -> Type (b -> c -> (a, b, c)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ a
a Type (b -> c -> (a, b, c)) to -> b -> Type (c -> (a, b, c)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ b
b Type (c -> (a, b, c)) to -> c -> Type (a, b, c) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ c
c

instance (PlateAll a to, Typeable a
         ,PlateAll b to, Typeable b
         ,PlateAll c to, Typeable c
         ,PlateAll d to, Typeable d
         ,Typeable to, Uniplate to) =>
         PlateAll (a,b,c,d) to where
    plateAll :: (a, b, c, d) -> Type (a, b, c, d) to
plateAll (a
a,b
b,c
c,d
d) = (a -> b -> c -> d -> (a, b, c, d))
-> Type (a -> b -> c -> d -> (a, b, c, d)) to
forall from to. from -> Type from to
plate (,,,) Type (a -> b -> c -> d -> (a, b, c, d)) to
-> a -> Type (b -> c -> d -> (a, b, c, d)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ a
a Type (b -> c -> d -> (a, b, c, d)) to
-> b -> Type (c -> d -> (a, b, c, d)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ b
b Type (c -> d -> (a, b, c, d)) to
-> c -> Type (d -> (a, b, c, d)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ c
c Type (d -> (a, b, c, d)) to -> d -> Type (a, b, c, d) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ d
d

instance (PlateAll a to, Typeable a
         ,PlateAll b to, Typeable b
         ,PlateAll c to, Typeable c
         ,PlateAll d to, Typeable d
         ,PlateAll e to, Typeable e
         ,Typeable to, Uniplate to) =>
         PlateAll (a,b,c,d,e) to where
    plateAll :: (a, b, c, d, e) -> Type (a, b, c, d, e) to
plateAll (a
a,b
b,c
c,d
d,e
e) = (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Type (a -> b -> c -> d -> e -> (a, b, c, d, e)) to
forall from to. from -> Type from to
plate (,,,,) Type (a -> b -> c -> d -> e -> (a, b, c, d, e)) to
-> a -> Type (b -> c -> d -> e -> (a, b, c, d, e)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ a
a Type (b -> c -> d -> e -> (a, b, c, d, e)) to
-> b -> Type (c -> d -> e -> (a, b, c, d, e)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ b
b Type (c -> d -> e -> (a, b, c, d, e)) to
-> c -> Type (d -> e -> (a, b, c, d, e)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ c
c Type (d -> e -> (a, b, c, d, e)) to
-> d -> Type (e -> (a, b, c, d, e)) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ d
d Type (e -> (a, b, c, d, e)) to -> e -> Type (a, b, c, d, e) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
Type (item -> from) to -> item -> Type from to
|+ e
e

instance (Integral a, PlateAll a to, Typeable a, Typeable to, Uniplate to) => PlateAll (Ratio a) to where
    plateAll :: Ratio a -> Type (Ratio a) to
plateAll = (Ratio a -> (a, a))
-> ((a, a) -> Ratio a) -> Ratio a -> Type (Ratio a) to
forall item to from.
(Typeable item, Typeable to, PlateAll item to) =>
(from -> item) -> (item -> from) -> from -> Type from to
plateProject (\Ratio a
x -> (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
x, Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
x)) ((a -> a -> Ratio a) -> (a, a) -> Ratio a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
(%))