class Lazy1 f where defer1 :: forall a. (Unit -> f a) -> f a about purescript-control HOT 10 CLOSED

data ListT m a = ListT (m (StepT a (ListT m a )))

unListT (ListT m) =  m

data StepT a x = Nil | Cons a x

instance lLazy :: Lazy (m (StepT a (ListT m a))) => Lazy (ListT m a) where
  defer f = ListT $ defer (f >>> unListT)

class Lazy1 f where
  defer1 :: forall a. (Unit -> f a) -> f a
  
  
instance lLazy1 :: Lazy1 m => Lazy1 (ListT m) where
  defer1 f = ListT $ defer1 (f >>> unListT)

module FreeApLazy where

import Prelude

import Control.Alternative (class Alternative)
import Control.Applicative.Free (FreeAp, foldFreeAp, liftFreeAp)
import Control.Lazy (class Lazy, defer)
import Data.Newtype (class Newtype, un)


newtype FreeApLazy f a = FreeApLazy (FreeAp (FreeApLazyF f) a)

data FreeApLazyF f a
  = FreeApLazyF (Unit -> (FreeApLazy f a))
  | FreeApLazyLifted (f a)

derive instance newtypeFreeApLazy :: Newtype (FreeApLazy f a) _
derive newtype instance altFunctor :: Functor (FreeApLazy f)
derive newtype instance altApply :: Apply (FreeApLazy f)
derive newtype instance altApplicative :: Applicative (FreeApLazy f)
instance altLazy :: Lazy (FreeApLazy f a) where defer = defer1
instance altLazy1 :: Lazy1 (FreeApLazy f) where defer1 = FreeApLazyF >>> liftFreeAp >>> FreeApLazy

liftApL :: forall f. f ~> FreeApLazy f
liftApL = FreeApLazyLifted >>> liftFreeAp >>> FreeApLazy

foldFreeApLazy :: forall f g a. Lazy1 g => Alternative g => (f ~> g) -> FreeApLazy f a -> g a
foldFreeApLazy f = un FreeApLazy >>> foldFreeAp case _ of
  FreeApLazyF cont -> defer1 $ cont >>> foldFreeApLazy f
  FreeApLazyLifted a -> f a

class Lazy1 f where
  defer1 :: forall a. (Unit -> f a) -> f a

foldFreeApLazy :: forall f g a. Alternative g => (forall x. Lazy (g x) => f x -> g x) -> FreeApLazy f a -> g a
foldFreeApLazy f = un FreeApLazy >>> foldFreeAp case _ of
  FreeApLazyF cont -> defer $ cont >>> foldFreeApLazy f
  FreeApLazyLifted a -> f a