{-|
This defines types for performing a computation that
log progress incrementally before completing.
-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Macaw.Utils.IncComp
  ( IncComp(..)
  , incCompResult
  , processIncCompLogs
  , IncCompM(..)
  , runIncCompM
  , liftIncComp
  , liftFoldIncComp
  , joinIncComp
  , incCompLog
  , incCompDone
  , ContT(..)
  ) where

import Control.Monad.Cont ( cont, runCont, Cont, ContT(..) )

-- | @IncComp l r@ is an incremental computation.
--
-- This is effectively a lazy list of @l@ values terminated by an @r@ value.
data IncComp l r
    -- | Log a message
  = IncCompLog !l (IncComp l r)
    -- | Computation complete.
  | IncCompDone !r

incCompResult :: IncComp l r -> r
incCompResult :: forall l r. IncComp l r -> r
incCompResult (IncCompLog l
_ IncComp l r
r) = IncComp l r -> r
forall l r. IncComp l r -> r
incCompResult IncComp l r
r
incCompResult (IncCompDone r
r) = r
r

-- | Left fold over an incremental computation
foldIncComp :: (l -> r -> r) -> (a -> r) -> IncComp l a -> r
foldIncComp :: forall l r a. (l -> r -> r) -> (a -> r) -> IncComp l a -> r
foldIncComp l -> r -> r
f a -> r
g (IncCompLog l
l IncComp l a
m) = l -> r -> r
f l
l ((l -> r -> r) -> (a -> r) -> IncComp l a -> r
forall l r a. (l -> r -> r) -> (a -> r) -> IncComp l a -> r
foldIncComp l -> r -> r
f a -> r
g IncComp l a
m)
foldIncComp l -> r -> r
_ a -> r
g (IncCompDone a
r) = a -> r
g a
r


joinIncComp :: (l -> k) -> (a -> IncComp k b) -> IncComp l a -> IncComp k b
joinIncComp :: forall l k a b.
(l -> k) -> (a -> IncComp k b) -> IncComp l a -> IncComp k b
joinIncComp l -> k
f = (l -> IncComp k b -> IncComp k b)
-> (a -> IncComp k b) -> IncComp l a -> IncComp k b
forall l r a. (l -> r -> r) -> (a -> r) -> IncComp l a -> r
foldIncComp (\l
l IncComp k b
r -> k -> IncComp k b -> IncComp k b
forall l r. l -> IncComp l r -> IncComp l r
IncCompLog (l -> k
f l
l) IncComp k b
r)

processIncCompLogs :: Monad m => (l -> m ()) -> IncComp l r -> m r
processIncCompLogs :: forall (m :: Type -> Type) l r.
Monad m =>
(l -> m ()) -> IncComp l r -> m r
processIncCompLogs l -> m ()
_ (IncCompDone r
r) = r -> m r
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure r
r
processIncCompLogs l -> m ()
f (IncCompLog l
l IncComp l r
r) = l -> m ()
f l
l m () -> m r -> m r
forall a b. m a -> m b -> m b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> (l -> m ()) -> IncComp l r -> m r
forall (m :: Type -> Type) l r.
Monad m =>
(l -> m ()) -> IncComp l r -> m r
processIncCompLogs l -> m ()
f IncComp l r
r

-- | Continuation monad that yields an incremental computation.
newtype IncCompM l r a = IncCompTM { forall l r a. IncCompM l r a -> Cont (IncComp l r) a
_unIncCompTM :: Cont (IncComp l r) a }
  deriving ((forall a b. (a -> b) -> IncCompM l r a -> IncCompM l r b)
-> (forall a b. a -> IncCompM l r b -> IncCompM l r a)
-> Functor (IncCompM l r)
forall a b. a -> IncCompM l r b -> IncCompM l r a
forall a b. (a -> b) -> IncCompM l r a -> IncCompM l r b
forall l r a b. a -> IncCompM l r b -> IncCompM l r a
forall l r a b. (a -> b) -> IncCompM l r a -> IncCompM l r b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall l r a b. (a -> b) -> IncCompM l r a -> IncCompM l r b
fmap :: forall a b. (a -> b) -> IncCompM l r a -> IncCompM l r b
$c<$ :: forall l r a b. a -> IncCompM l r b -> IncCompM l r a
<$ :: forall a b. a -> IncCompM l r b -> IncCompM l r a
Functor, Functor (IncCompM l r)
Functor (IncCompM l r) =>
(forall a. a -> IncCompM l r a)
-> (forall a b.
    IncCompM l r (a -> b) -> IncCompM l r a -> IncCompM l r b)
-> (forall a b c.
    (a -> b -> c)
    -> IncCompM l r a -> IncCompM l r b -> IncCompM l r c)
-> (forall a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b)
-> (forall a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r a)
-> Applicative (IncCompM l r)
forall a. a -> IncCompM l r a
forall l r. Functor (IncCompM l r)
forall a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r a
forall a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b
forall a b.
IncCompM l r (a -> b) -> IncCompM l r a -> IncCompM l r b
forall l r a. a -> IncCompM l r a
forall a b c.
(a -> b -> c) -> IncCompM l r a -> IncCompM l r b -> IncCompM l r c
forall l r a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r a
forall l r a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b
forall l r a b.
IncCompM l r (a -> b) -> IncCompM l r a -> IncCompM l r b
forall l r a b c.
(a -> b -> c) -> IncCompM l r a -> IncCompM l r b -> IncCompM l r c
forall (f :: Type -> Type).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall l r a. a -> IncCompM l r a
pure :: forall a. a -> IncCompM l r a
$c<*> :: forall l r a b.
IncCompM l r (a -> b) -> IncCompM l r a -> IncCompM l r b
<*> :: forall a b.
IncCompM l r (a -> b) -> IncCompM l r a -> IncCompM l r b
$cliftA2 :: forall l r a b c.
(a -> b -> c) -> IncCompM l r a -> IncCompM l r b -> IncCompM l r c
liftA2 :: forall a b c.
(a -> b -> c) -> IncCompM l r a -> IncCompM l r b -> IncCompM l r c
$c*> :: forall l r a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b
*> :: forall a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b
$c<* :: forall l r a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r a
<* :: forall a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r a
Applicative, Applicative (IncCompM l r)
Applicative (IncCompM l r) =>
(forall a b.
 IncCompM l r a -> (a -> IncCompM l r b) -> IncCompM l r b)
-> (forall a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b)
-> (forall a. a -> IncCompM l r a)
-> Monad (IncCompM l r)
forall a. a -> IncCompM l r a
forall l r. Applicative (IncCompM l r)
forall a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b
forall a b.
IncCompM l r a -> (a -> IncCompM l r b) -> IncCompM l r b
forall l r a. a -> IncCompM l r a
forall l r a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b
forall l r a b.
IncCompM l r a -> (a -> IncCompM l r b) -> IncCompM l r b
forall (m :: Type -> Type).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall l r a b.
IncCompM l r a -> (a -> IncCompM l r b) -> IncCompM l r b
>>= :: forall a b.
IncCompM l r a -> (a -> IncCompM l r b) -> IncCompM l r b
$c>> :: forall l r a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b
>> :: forall a b. IncCompM l r a -> IncCompM l r b -> IncCompM l r b
$creturn :: forall l r a. a -> IncCompM l r a
return :: forall a. a -> IncCompM l r a
Monad)

runIncCompM :: IncCompM l r r -> IncComp l r
runIncCompM :: forall l r. IncCompM l r r -> IncComp l r
runIncCompM (IncCompTM Cont (IncComp l r) r
m) = Cont (IncComp l r) r -> (r -> IncComp l r) -> IncComp l r
forall r a. Cont r a -> (a -> r) -> r
runCont Cont (IncComp l r) r
m r -> IncComp l r
forall l r. r -> IncComp l r
IncCompDone

-- | Log a warning
incCompLog :: l -> IncCompM l r ()
incCompLog :: forall l r. l -> IncCompM l r ()
incCompLog l
msg = Cont (IncComp l r) () -> IncCompM l r ()
forall l r a. Cont (IncComp l r) a -> IncCompM l r a
IncCompTM (Cont (IncComp l r) () -> IncCompM l r ())
-> Cont (IncComp l r) () -> IncCompM l r ()
forall a b. (a -> b) -> a -> b
$ ((() -> IncComp l r) -> IncComp l r) -> Cont (IncComp l r) ()
forall a r. ((a -> r) -> r) -> Cont r a
cont (((() -> IncComp l r) -> IncComp l r) -> Cont (IncComp l r) ())
-> ((() -> IncComp l r) -> IncComp l r) -> Cont (IncComp l r) ()
forall a b. (a -> b) -> a -> b
$ \() -> IncComp l r
f -> l -> IncComp l r -> IncComp l r
forall l r. l -> IncComp l r -> IncComp l r
IncCompLog l
msg (() -> IncComp l r
f ())

-- | Terminate computation early.
incCompDone :: r -> IncCompM l r a
incCompDone :: forall r l a. r -> IncCompM l r a
incCompDone r
e = Cont (IncComp l r) a -> IncCompM l r a
forall l r a. Cont (IncComp l r) a -> IncCompM l r a
IncCompTM (Cont (IncComp l r) a -> IncCompM l r a)
-> Cont (IncComp l r) a -> IncCompM l r a
forall a b. (a -> b) -> a -> b
$ ((a -> IncComp l r) -> IncComp l r) -> Cont (IncComp l r) a
forall a r. ((a -> r) -> r) -> Cont r a
cont (((a -> IncComp l r) -> IncComp l r) -> Cont (IncComp l r) a)
-> ((a -> IncComp l r) -> IncComp l r) -> Cont (IncComp l r) a
forall a b. (a -> b) -> a -> b
$ \a -> IncComp l r
_ -> r -> IncComp l r
forall l r. r -> IncComp l r
IncCompDone r
e

-- | Lift a incremental computation to the monad with the given modification
liftIncComp :: (l -> k) -> IncComp l a -> IncCompM k r a
liftIncComp :: forall l k a r. (l -> k) -> IncComp l a -> IncCompM k r a
liftIncComp l -> k
f IncComp l a
m = Cont (IncComp k r) a -> IncCompM k r a
forall l r a. Cont (IncComp l r) a -> IncCompM l r a
IncCompTM (Cont (IncComp k r) a -> IncCompM k r a)
-> Cont (IncComp k r) a -> IncCompM k r a
forall a b. (a -> b) -> a -> b
$ ((a -> IncComp k r) -> IncComp k r) -> Cont (IncComp k r) a
forall a r. ((a -> r) -> r) -> Cont r a
cont (((a -> IncComp k r) -> IncComp k r) -> Cont (IncComp k r) a)
-> ((a -> IncComp k r) -> IncComp k r) -> Cont (IncComp k r) a
forall a b. (a -> b) -> a -> b
$ \a -> IncComp k r
c -> (l -> k) -> (a -> IncComp k r) -> IncComp l a -> IncComp k r
forall l k a b.
(l -> k) -> (a -> IncComp k b) -> IncComp l a -> IncComp k b
joinIncComp l -> k
f a -> IncComp k r
c IncComp l a
m

-- | Allows a incremental computation to be merged into an existing
-- one by folding over events.
liftFoldIncComp :: (l -> IncComp k r -> IncComp k r) -> IncComp l a -> IncCompM k r a
liftFoldIncComp :: forall l k r a.
(l -> IncComp k r -> IncComp k r) -> IncComp l a -> IncCompM k r a
liftFoldIncComp l -> IncComp k r -> IncComp k r
f IncComp l a
m = Cont (IncComp k r) a -> IncCompM k r a
forall l r a. Cont (IncComp l r) a -> IncCompM l r a
IncCompTM (Cont (IncComp k r) a -> IncCompM k r a)
-> Cont (IncComp k r) a -> IncCompM k r a
forall a b. (a -> b) -> a -> b
$ ((a -> IncComp k r) -> IncComp k r) -> Cont (IncComp k r) a
forall a r. ((a -> r) -> r) -> Cont r a
cont (((a -> IncComp k r) -> IncComp k r) -> Cont (IncComp k r) a)
-> ((a -> IncComp k r) -> IncComp k r) -> Cont (IncComp k r) a
forall a b. (a -> b) -> a -> b
$ \a -> IncComp k r
c -> (l -> IncComp k r -> IncComp k r)
-> (a -> IncComp k r) -> IncComp l a -> IncComp k r
forall l r a. (l -> r -> r) -> (a -> r) -> IncComp l a -> r
foldIncComp l -> IncComp k r -> IncComp k r
f a -> IncComp k r
c IncComp l a
m