never executed always true always false

    1 {-# LANGUAGE Rank2Types #-}
    2 {-# LANGUAGE StandaloneDeriving #-}
    3 {-# LANGUAGE KindSignatures #-}
    4 {-# LANGUAGE PolyKinds #-}
    5 {-# LANGUAGE UndecidableInstances #-}
    6 
    7 module Data.Indexed where
    8 
    9 
   10 -- Common typeclasses
   11 
   12 class IFunctor (f :: (k -> *) -> k -> *) where
   13    imap :: (forall i. a i -> b i) -> (forall i. f a i -> f b i)
   14 
   15 
   16 class Foldable (t :: (k -> *) -> k -> *) where
   17     foldMap :: Monoid m => (forall i. f i -> m) -> t f a -> m
   18 
   19 
   20 -- Recursion schemes
   21 
   22 newtype Fix (ann :: * -> *) (f :: (k -> *) -> k -> *) (i :: k)
   23     = Fix { unFix :: ann (f (Fix ann f) i) }
   24 
   25 deriving instance Show (ann (f (Fix ann f) i)) => Show (Fix ann f i)
   26 deriving instance Eq (ann (f (Fix ann f) i)) => Eq (Fix ann f i)
   27 deriving instance Ord (ann (f (Fix ann f) i)) => Ord (Fix ann f i)
   28 
   29 cata ::
   30     Functor ann =>
   31     IFunctor f =>
   32     (forall i. ann (f a i) -> a i)
   33     -> (forall i. Fix ann f i -> a i)
   34 cata f = f . fmap (imap $ cata f) . unFix
   35 
   36 
   37 ana ::
   38     Functor ann =>
   39     IFunctor f =>
   40     (forall i. a i -> ann (f a i))
   41     -> (forall i. a i -> Fix ann f i)
   42 ana f = Fix . fmap (imap $ ana f) . f
   43 
   44 
   45 convert ::
   46   Functor ann1 =>
   47   IFunctor f =>
   48   (forall x. ann1 x -> ann2 x) ->
   49   (forall i. Fix ann1 f i -> Fix ann2 f i)
   50 convert f = cata (Fix . f)