module Data.Fold.R
( R(..)
) where
import Control.Applicative
import Control.Comonad
import Control.Lens
import Data.Foldable hiding (sum, product)
import Data.Fold.Class
import Data.Functor.Extend
import Data.Functor.Bind
import Data.Profunctor.Unsafe
import Unsafe.Coerce
import Prelude hiding (foldr, sum, product, length)
data R a b = forall r. R (r -> b) (a -> r -> r) r
instance Folding R where
run t (R k h z) = k (foldr h z t)
run1 t (R k h z) = k (h t z)
runOf l s (R k h z) = k (foldrOf l h z s)
prefix s = extend (run s)
prefix1 a = extend (run1 a)
prefixOf l s = extend (runOf l s)
postfix t s = run s (duplicate t)
postfix1 t a = run1 a (duplicate t)
postfixOf l t s = runOf l s (duplicate t)
instance Profunctor R where
dimap f g (R k h z) = R (g.k) (h.f) z
rmap g (R k h z) = R (g.k) h z
lmap f (R k h z) = R k (h.f) z
(#.) _ = unsafeCoerce
x .# _ = unsafeCoerce x
instance Choice R where
left' (R k h z) = R (_Left %~ k) step (Left z) where
step (Left x) (Left y) = Left (h x y)
step (Right c) _ = Right c
step _ (Right c) = Right c
right' (R k h z) = R (_Right %~ k) step (Right z) where
step (Right x) (Right y) = Right (h x y)
step (Left c) _ = Left c
step _ (Left c) = Left c
instance Functor (R a) where
fmap f (R k h z) = R (f.k) h z
(<$) b = \_ -> pure b
instance Comonad (R a) where
extract (R k _ z) = k z
duplicate (R k h z) = R (R k h) h z
extend f (R k h z) = R (f . R k h) h z
data Pair a b = Pair !a !b
instance Bind (R a) where
(>>-) = (>>=)
instance Monad (R a) where
return b = R (\() -> b) (\_ () -> ()) ()
m >>= f = R (\xs a -> run xs (f a)) (:) [] <*> m
instance Applicative (R a) where
pure b = R (\() -> b) (\_ () -> ()) ()
R xf bxx xz <*> R ya byy yz = R
(\(Pair x y) -> xf x $ ya y)
(\b (Pair x y) -> Pair (bxx b x) (byy b y))
(Pair xz yz)
(<*) m = \_ -> m
_ *> m = m
instance Extend (R a) where
extended = extend
duplicated = duplicate
instance Apply (R a) where
(<.>) = (<*>)
(<.) m = \_ -> m
_ .> m = m
instance ComonadApply (R a) where
(<@>) = (<*>)
(<@) m = \_ -> m
_ @> m = m