> {-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}



> module Control.Arrow.ArrowP where



> import Control.Arrow

> import Control.Arrow.Operations

#if __GLASGOW_HASKELL__ >= 610

> import Control.Category

> import Prelude hiding ((.), id)

#endif



> newtype ArrowP a p b c = ArrowP { strip :: a b c }



#if __GLASGOW_HASKELL__ >= 610

> instance Category a => Category (ArrowP a p) where

>   id = ArrowP id

>   ArrowP g . ArrowP f = ArrowP (g . f)



> instance Arrow a => Arrow (ArrowP a p) where

>   arr f = ArrowP (arr f)

>   first (ArrowP f) = ArrowP (first f)

#else

> instance Arrow a => Arrow (ArrowP a p) where

>   arr f = ArrowP (arr f)

>   first (ArrowP f) = ArrowP (first f)

>   ArrowP f >>> ArrowP g = ArrowP (f >>> g)

#endif



> instance ArrowLoop a => ArrowLoop (ArrowP a p) where

>   loop (ArrowP f) = ArrowP (loop f)



> instance ArrowCircuit a => ArrowCircuit (ArrowP a p) where

>   delay i = ArrowP (delay i)



> instance ArrowChoice a => ArrowChoice (ArrowP a p) where

>   left (ArrowP f) = ArrowP (left f)

>   ArrowP f ||| ArrowP g = ArrowP (f ||| g)