{-# Language
FlexibleContexts,
UndecidableInstances,
TypeSynonymInstances,
DeriveGeneric,
DeriveDataTypeable,
StandaloneDeriving #-}
module Data.Fix (
Fix(..)
, cata
, ana
, hylo
, (~>)
, cataM
, anaM
, hyloM
)
where
import GHC.Generics
import Data.Data
import Data.Function (on)
newtype Fix f = Fix { Fix f -> f (Fix f)
unFix :: f (Fix f) } deriving ((forall x. Fix f -> Rep (Fix f) x)
-> (forall x. Rep (Fix f) x -> Fix f) -> Generic (Fix f)
forall x. Rep (Fix f) x -> Fix f
forall x. Fix f -> Rep (Fix f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (Fix f) x -> Fix f
forall (f :: * -> *) x. Fix f -> Rep (Fix f) x
$cto :: forall (f :: * -> *) x. Rep (Fix f) x -> Fix f
$cfrom :: forall (f :: * -> *) x. Fix f -> Rep (Fix f) x
Generic, Typeable)
deriving instance (Typeable f, Data (f (Fix f))) => Data (Fix f)
instance Show (f (Fix f)) => Show (Fix f) where
showsPrec :: Int -> Fix f -> ShowS
showsPrec n :: Int
n x :: Fix f
x = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ \s :: String
s ->
"Fix " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> f (Fix f) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 (Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix f
x) String
s
instance Read (f (Fix f)) => Read (Fix f) where
readsPrec :: Int -> ReadS (Fix f)
readsPrec d :: Int
d = Bool -> ReadS (Fix f) -> ReadS (Fix f)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ReadS (Fix f) -> ReadS (Fix f)) -> ReadS (Fix f) -> ReadS (Fix f)
forall a b. (a -> b) -> a -> b
$ \r :: String
r ->
[(f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix f (Fix f)
m, String
t) | ("Fix", s :: String
s) <- ReadS String
lex String
r, (m :: f (Fix f)
m, t :: String
t) <- Int -> ReadS (f (Fix f))
forall a. Read a => Int -> ReadS a
readsPrec 11 String
s]
instance Eq (f (Fix f)) => Eq (Fix f) where
== :: Fix f -> Fix f -> Bool
(==) = f (Fix f) -> f (Fix f) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (f (Fix f) -> f (Fix f) -> Bool)
-> (Fix f -> f (Fix f)) -> Fix f -> Fix f -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix
instance Ord (f (Fix f)) => Ord (Fix f) where
compare :: Fix f -> Fix f -> Ordering
compare = f (Fix f) -> f (Fix f) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (f (Fix f) -> f (Fix f) -> Ordering)
-> (Fix f -> f (Fix f)) -> Fix f -> Fix f -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix
cata :: Functor f => (f a -> a) -> (Fix f -> a)
cata :: (f a -> a) -> Fix f -> a
cata f :: f a -> a
f = f a -> a
f (f a -> a) -> (Fix f -> f a) -> Fix f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix f -> a) -> f (Fix f) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> a) -> Fix f -> a
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata f a -> a
f) (f (Fix f) -> f a) -> (Fix f -> f (Fix f)) -> Fix f -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix
ana :: Functor f => (a -> f a) -> (a -> Fix f)
ana :: (a -> f a) -> a -> Fix f
ana f :: a -> f a
f = f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (f (Fix f) -> Fix f) -> (a -> f (Fix f)) -> a -> Fix f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Fix f) -> f a -> f (Fix f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> f a) -> a -> Fix f
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
ana a -> f a
f) (f a -> f (Fix f)) -> (a -> f a) -> a -> f (Fix f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
f
hylo :: Functor f => (f b -> b) -> (a -> f a) -> (a -> b)
hylo :: (f b -> b) -> (a -> f a) -> a -> b
hylo phi :: f b -> b
phi psi :: a -> f a
psi = (f b -> b) -> Fix f -> b
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata f b -> b
phi (Fix f -> b) -> (a -> Fix f) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> a -> Fix f
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
ana a -> f a
psi
(~>) :: Functor f => (a -> f a) -> (f b -> b) -> (a -> b)
psi :: a -> f a
psi ~> :: (a -> f a) -> (f b -> b) -> a -> b
~> phi :: f b -> b
phi = f b -> b
phi (f b -> b) -> (a -> f b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f b -> b) -> (a -> f a) -> a -> b
forall (f :: * -> *) b a.
Functor f =>
(f b -> b) -> (a -> f a) -> a -> b
hylo f b -> b
phi a -> f a
psi) (f a -> f b) -> (a -> f a) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
psi
cataM :: (Applicative m, Monad m, Traversable t)
=> (t a -> m a) -> Fix t -> m a
cataM :: (t a -> m a) -> Fix t -> m a
cataM f :: t a -> m a
f = (t a -> m a
f (t a -> m a) -> m (t a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (t a) -> m a) -> (Fix t -> m (t a)) -> Fix t -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix t -> m a) -> t (Fix t) -> m (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((t a -> m a) -> Fix t -> m a
forall (m :: * -> *) (t :: * -> *) a.
(Applicative m, Monad m, Traversable t) =>
(t a -> m a) -> Fix t -> m a
cataM t a -> m a
f) (t (Fix t) -> m (t a)) -> (Fix t -> t (Fix t)) -> Fix t -> m (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix t -> t (Fix t)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix
anaM :: (Applicative m, Monad m, Traversable t)
=> (a -> m (t a)) -> (a -> m (Fix t))
anaM :: (a -> m (t a)) -> a -> m (Fix t)
anaM f :: a -> m (t a)
f = (t (Fix t) -> Fix t) -> m (t (Fix t)) -> m (Fix t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t (Fix t) -> Fix t
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (m (t (Fix t)) -> m (Fix t))
-> (a -> m (t (Fix t))) -> a -> m (Fix t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> m (Fix t)) -> t a -> m (t (Fix t))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> m (t a)) -> a -> m (Fix t)
forall (m :: * -> *) (t :: * -> *) a.
(Applicative m, Monad m, Traversable t) =>
(a -> m (t a)) -> a -> m (Fix t)
anaM a -> m (t a)
f) (t a -> m (t (Fix t))) -> m (t a) -> m (t (Fix t))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (t a) -> m (t (Fix t))) -> (a -> m (t a)) -> a -> m (t (Fix t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (t a)
f
hyloM :: (Applicative m, Monad m, Traversable t)
=> (t b -> m b) -> (a -> m (t a)) -> (a -> m b)
hyloM :: (t b -> m b) -> (a -> m (t a)) -> a -> m b
hyloM phi :: t b -> m b
phi psi :: a -> m (t a)
psi = ((t b -> m b) -> Fix t -> m b
forall (m :: * -> *) (t :: * -> *) a.
(Applicative m, Monad m, Traversable t) =>
(t a -> m a) -> Fix t -> m a
cataM t b -> m b
phi (Fix t -> m b) -> m (Fix t) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (Fix t) -> m b) -> (a -> m (Fix t)) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (t a)) -> a -> m (Fix t)
forall (m :: * -> *) (t :: * -> *) a.
(Applicative m, Monad m, Traversable t) =>
(a -> m (t a)) -> a -> m (Fix t)
anaM a -> m (t a)
psi