module FunctorCombo.Pair
( Pair(..)
, fstP, sndP, swapP, fromP, toP, inP
, firstP, secondP, zipA, unzipA, inZipA
, curryP, uncurryP
, preScanP, sufScanP
) where
import Data.Monoid (Monoid(..))
import Data.Functor ((<$>))
import Data.Foldable (Foldable(..))
import Data.Traversable (Traversable(..))
import Control.Applicative (Applicative(..),liftA2)
import FunctorCombo.Functor
import FunctorCombo.ParScan
infixl 1 :#
data Pair a = a :# a deriving (Functor,Eq,Show)
instance Foldable Pair where
foldMap f (a :# b) = f a `mappend` f b
instance Applicative Pair where
pure a = a :# a
(f :# g) <*> (a :# b) = (f a :# g b)
instance Monad Pair where
return = pure
m >>= f = joinP (f <$> m)
joinP :: Pair (Pair a) -> Pair a
joinP ((a :# _) :# (_ :# d)) = a :# d
instance Traversable Pair where
traverse h (fa :# fb) = liftA2 (:#) (h fa) (h fb)
instance EncodeF Pair where
type Enc Pair = Id :*: Id
encode (a :# b) = Id a :*: Id b
decode (Id a :*: Id b) = a :# b
fstP, sndP :: Pair a -> a
fstP (a :# _) = a
sndP (_ :# b) = b
swapP :: Unop (Pair a)
swapP (a :# b) = b :# a
toP :: (a,a) -> Pair a
toP (a,b) = a :# b
fromP :: Pair a -> (a,a)
fromP (a :# b) = (a,b)
inP :: Unop (a,a) -> Unop (Pair a)
inP f = toP . f . fromP
firstP, secondP :: Unop a -> Unop (Pair a)
firstP f = ((f :# id) <*>)
secondP g = ((id :# g) <*>)
zipA :: Applicative f => Pair (f a) -> f (Pair a)
zipA (u :# v) = liftA2 (:#) u v
unzipA :: Functor f => f (Pair a) -> Pair (f a)
unzipA t = fmap fstP t :# fmap sndP t
inZipA :: Applicative f => Unop (f (Pair a)) -> Unop (Pair (f a))
inZipA f = unzipA . f . zipA
curryP :: (Pair a -> b) -> (a -> a -> b)
curryP g = curry (g . toP)
uncurryP :: (a -> a -> b) -> (Pair a -> b)
uncurryP f = uncurry f . fromP
preScanP :: (Functor f, Monoid o) => Pair (f o, o) -> (Pair (f o), o)
preScanP (us :# vs) = ((u :# v), vTot)
where
(u,uTot) = us
(v,vTot) = preScanTweak (uTot `mappend`) vs
sufScanP :: (Functor f, Monoid o) => Pair (o, f o) -> (o, Pair (f o))
sufScanP (us :# vs) = (uTot, (u :# v))
where
(vTot,v) = vs
(uTot,u) = sufScanTweak (`mappend` vTot) us
instance Scan Pair where
prefixScan = prefixScanEnc
suffixScan = suffixScanEnc
type Unop a = a -> a