Recursive problems

Rec.hs

{-# LANGUAGE GADTs, InstanceSigs #-}

newtype Service a b = Service { unService :: a -> IO b }

newtype SF a b = SF { unSF :: Bool -> IO (Service a b) }

newtype Filter a b c d = Filter { unFilter :: c -> Service a b -> IO d }

class Profunctor p where
  dimap :: Filter a b c d -> p a b -> p c d

instance Profunctor (Filter s t) where
  dimap :: Filter a b c d -> Filter s t a b -> Filter s t c d
  dimap f p = Filter (\x q -> (unFilter f) x (Service (\y -> (unFilter p) y q)))

instance Profunctor Service where
  dimap :: Filter a b c d -> Service a b -> Service c d
  dimap f p = Service (\x -> (unFilter f) x p)

instance Profunctor SF where
  dimap :: Filter a b c d -> SF a b -> SF c d
  dimap f p = SF (\x -> fmap (dimap f) ((unSF p) x))

identity :: Filter a b a b
identity = Filter $ \c s -> (unService s) c

f :: Filter Int String [Int] String
f = Filter $ \c s -> (unService s) (head c)

g :: Filter Int Float Int String
g = Filter $ \c s -> fmap show ((unService s) c)

h :: Service Int Float
h = Service $ const (return 1.2)

data Dimap p a b c d where
  Pure :: p a b -> Dimap p a b a b
  Dimap :: Filter a b c d -> Dimap p s t a b -> Dimap p s t c d

j = f `dimap` g `dimap` h

flatten :: Profunctor p => Dimap p a b c d -> p c d
flatten (Pure    p) = p
flatten (Dimap f p) = dimap f (flatten p)