module Satyros.BellmanFord.Effect where

import           Control.Monad.State.Strict  (MonadState, State, runState)
import           Control.Monad.Trans.Free    (FreeF, FreeT (runFreeT),
                                              MonadFree (wrap), hoistFreeT)
import           Data.Bifunctor              (first)
import           Data.Functor.Classes        (Show1 (liftShowsPrec),
                                              showsBinaryWith, showsPrec1,
                                              showsUnaryWith)
import           Data.Functor.Const          (Const (Const))
import           GHC.Generics                (Generic, Generic1)
import           Satyros.BellmanFord.Storage (IDLGraphVertex, Storage)
import qualified Satyros.QFIDL               as QFIDL
import           Satyros.Util                (showsTernaryWith)

newtype BellmanFord a = BellmanFord{ BellmanFord a -> FreeT BellmanFordF (State Storage) a
runBellmanFord :: FreeT BellmanFordF (State Storage) a }
  deriving stock ((forall x. BellmanFord a -> Rep (BellmanFord a) x)
-> (forall x. Rep (BellmanFord a) x -> BellmanFord a)
-> Generic (BellmanFord a)
forall x. Rep (BellmanFord a) x -> BellmanFord a
forall x. BellmanFord a -> Rep (BellmanFord a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BellmanFord a) x -> BellmanFord a
forall a x. BellmanFord a -> Rep (BellmanFord a) x
$cto :: forall a x. Rep (BellmanFord a) x -> BellmanFord a
$cfrom :: forall a x. BellmanFord a -> Rep (BellmanFord a) x
Generic, (forall a. BellmanFord a -> Rep1 BellmanFord a)
-> (forall a. Rep1 BellmanFord a -> BellmanFord a)
-> Generic1 BellmanFord
forall a. Rep1 BellmanFord a -> BellmanFord a
forall a. BellmanFord a -> Rep1 BellmanFord a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 BellmanFord a -> BellmanFord a
$cfrom1 :: forall a. BellmanFord a -> Rep1 BellmanFord a
Generic1)
  deriving newtype (a -> BellmanFord b -> BellmanFord a
(a -> b) -> BellmanFord a -> BellmanFord b
(forall a b. (a -> b) -> BellmanFord a -> BellmanFord b)
-> (forall a b. a -> BellmanFord b -> BellmanFord a)
-> Functor BellmanFord
forall a b. a -> BellmanFord b -> BellmanFord a
forall a b. (a -> b) -> BellmanFord a -> BellmanFord b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BellmanFord b -> BellmanFord a
$c<$ :: forall a b. a -> BellmanFord b -> BellmanFord a
fmap :: (a -> b) -> BellmanFord a -> BellmanFord b
$cfmap :: forall a b. (a -> b) -> BellmanFord a -> BellmanFord b
Functor, Functor BellmanFord
a -> BellmanFord a
Functor BellmanFord
-> (forall a. a -> BellmanFord a)
-> (forall a b.
    BellmanFord (a -> b) -> BellmanFord a -> BellmanFord b)
-> (forall a b c.
    (a -> b -> c) -> BellmanFord a -> BellmanFord b -> BellmanFord c)
-> (forall a b. BellmanFord a -> BellmanFord b -> BellmanFord b)
-> (forall a b. BellmanFord a -> BellmanFord b -> BellmanFord a)
-> Applicative BellmanFord
BellmanFord a -> BellmanFord b -> BellmanFord b
BellmanFord a -> BellmanFord b -> BellmanFord a
BellmanFord (a -> b) -> BellmanFord a -> BellmanFord b
(a -> b -> c) -> BellmanFord a -> BellmanFord b -> BellmanFord c
forall a. a -> BellmanFord a
forall a b. BellmanFord a -> BellmanFord b -> BellmanFord a
forall a b. BellmanFord a -> BellmanFord b -> BellmanFord b
forall a b. BellmanFord (a -> b) -> BellmanFord a -> BellmanFord b
forall a b c.
(a -> b -> c) -> BellmanFord a -> BellmanFord b -> BellmanFord c
forall (f :: * -> *).
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
<* :: BellmanFord a -> BellmanFord b -> BellmanFord a
$c<* :: forall a b. BellmanFord a -> BellmanFord b -> BellmanFord a
*> :: BellmanFord a -> BellmanFord b -> BellmanFord b
$c*> :: forall a b. BellmanFord a -> BellmanFord b -> BellmanFord b
liftA2 :: (a -> b -> c) -> BellmanFord a -> BellmanFord b -> BellmanFord c
$cliftA2 :: forall a b c.
(a -> b -> c) -> BellmanFord a -> BellmanFord b -> BellmanFord c
<*> :: BellmanFord (a -> b) -> BellmanFord a -> BellmanFord b
$c<*> :: forall a b. BellmanFord (a -> b) -> BellmanFord a -> BellmanFord b
pure :: a -> BellmanFord a
$cpure :: forall a. a -> BellmanFord a
$cp1Applicative :: Functor BellmanFord
Applicative, Applicative BellmanFord
a -> BellmanFord a
Applicative BellmanFord
-> (forall a b.
    BellmanFord a -> (a -> BellmanFord b) -> BellmanFord b)
-> (forall a b. BellmanFord a -> BellmanFord b -> BellmanFord b)
-> (forall a. a -> BellmanFord a)
-> Monad BellmanFord
BellmanFord a -> (a -> BellmanFord b) -> BellmanFord b
BellmanFord a -> BellmanFord b -> BellmanFord b
forall a. a -> BellmanFord a
forall a b. BellmanFord a -> BellmanFord b -> BellmanFord b
forall a b. BellmanFord a -> (a -> BellmanFord b) -> BellmanFord b
forall (m :: * -> *).
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
return :: a -> BellmanFord a
$creturn :: forall a. a -> BellmanFord a
>> :: BellmanFord a -> BellmanFord b -> BellmanFord b
$c>> :: forall a b. BellmanFord a -> BellmanFord b -> BellmanFord b
>>= :: BellmanFord a -> (a -> BellmanFord b) -> BellmanFord b
$c>>= :: forall a b. BellmanFord a -> (a -> BellmanFord b) -> BellmanFord b
$cp1Monad :: Applicative BellmanFord
Monad, MonadFree BellmanFordF, MonadState Storage)

instance Show1 BellmanFord where
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> BellmanFord a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
slp Int
d =
    (Int -> FreeT BellmanFordF (Const [Char]) a -> ShowS)
-> [Char] -> Int -> FreeT BellmanFordF (Const [Char]) a -> ShowS
forall a. (Int -> a -> ShowS) -> [Char] -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> FreeT BellmanFordF (Const [Char]) a
-> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
slp) [Char]
"BellmanFord" Int
d
    (FreeT BellmanFordF (Const [Char]) a -> ShowS)
-> (BellmanFord a -> FreeT BellmanFordF (Const [Char]) a)
-> BellmanFord a
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. State Storage a -> Const [Char] a)
-> FreeT BellmanFordF (State Storage) a
-> FreeT BellmanFordF (Const [Char]) a
forall (m :: * -> *) (f :: * -> *) (n :: * -> *) b.
(Monad m, Functor f) =>
(forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
hoistFreeT (Const [Char] a -> State Storage a -> Const [Char] a
forall a b. a -> b -> a
const (Const [Char] a -> State Storage a -> Const [Char] a)
-> Const [Char] a -> State Storage a -> Const [Char] a
forall a b. (a -> b) -> a -> b
$ [Char] -> Const [Char] a
forall k a (b :: k). a -> Const a b
Const [Char]
"<stateful computation>")
    (FreeT BellmanFordF (State Storage) a
 -> FreeT BellmanFordF (Const [Char]) a)
-> (BellmanFord a -> FreeT BellmanFordF (State Storage) a)
-> BellmanFord a
-> FreeT BellmanFordF (Const [Char]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BellmanFord a -> FreeT BellmanFordF (State Storage) a
forall a. BellmanFord a -> FreeT BellmanFordF (State Storage) a
runBellmanFord

instance (Show a) => Show (BellmanFord a) where
  showsPrec :: Int -> BellmanFord a -> ShowS
showsPrec = Int -> BellmanFord a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

stepBellmanFord :: BellmanFord a -> Storage -> (FreeF BellmanFordF a (BellmanFord a), Storage)
stepBellmanFord :: BellmanFord a
-> Storage -> (FreeF BellmanFordF a (BellmanFord a), Storage)
stepBellmanFord BellmanFord a
d Storage
s = (FreeF BellmanFordF a (FreeT BellmanFordF (State Storage) a)
 -> FreeF BellmanFordF a (BellmanFord a))
-> (FreeF BellmanFordF a (FreeT BellmanFordF (State Storage) a),
    Storage)
-> (FreeF BellmanFordF a (BellmanFord a), Storage)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((FreeT BellmanFordF (State Storage) a -> BellmanFord a)
-> FreeF BellmanFordF a (FreeT BellmanFordF (State Storage) a)
-> FreeF BellmanFordF a (BellmanFord a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FreeT BellmanFordF (State Storage) a -> BellmanFord a
forall a. FreeT BellmanFordF (State Storage) a -> BellmanFord a
BellmanFord) ((FreeF BellmanFordF a (FreeT BellmanFordF (State Storage) a),
  Storage)
 -> (FreeF BellmanFordF a (BellmanFord a), Storage))
-> (FreeF BellmanFordF a (FreeT BellmanFordF (State Storage) a),
    Storage)
-> (FreeF BellmanFordF a (BellmanFord a), Storage)
forall a b. (a -> b) -> a -> b
$ State
  Storage
  (FreeF BellmanFordF a (FreeT BellmanFordF (State Storage) a))
-> Storage
-> (FreeF BellmanFordF a (FreeT BellmanFordF (State Storage) a),
    Storage)
forall s a. State s a -> s -> (a, s)
runState (FreeT BellmanFordF (State Storage) a
-> State
     Storage
     (FreeF BellmanFordF a (FreeT BellmanFordF (State Storage) a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (BellmanFord a -> FreeT BellmanFordF (State Storage) a
forall a. BellmanFord a -> FreeT BellmanFordF (State Storage) a
runBellmanFord BellmanFord a
d)) Storage
s
{-# INLINE stepBellmanFord #-}

data BellmanFordF r
  = PropagationCheck (IDLGraphVertex, IDLGraphVertex) r
  | PropagationFindShorter IDLGraphVertex (IDLGraphVertex, Int) r
  | PropagationNth Int r
  | PropagationEnd
  | NegativeCycleCheck (IDLGraphVertex, IDLGraphVertex) r
  | NegativeCycleFind [QFIDL.Expressed]
  | NegativeCyclePass
  deriving stock ((forall x. BellmanFordF r -> Rep (BellmanFordF r) x)
-> (forall x. Rep (BellmanFordF r) x -> BellmanFordF r)
-> Generic (BellmanFordF r)
forall x. Rep (BellmanFordF r) x -> BellmanFordF r
forall x. BellmanFordF r -> Rep (BellmanFordF r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r x. Rep (BellmanFordF r) x -> BellmanFordF r
forall r x. BellmanFordF r -> Rep (BellmanFordF r) x
$cto :: forall r x. Rep (BellmanFordF r) x -> BellmanFordF r
$cfrom :: forall r x. BellmanFordF r -> Rep (BellmanFordF r) x
Generic, (forall a. BellmanFordF a -> Rep1 BellmanFordF a)
-> (forall a. Rep1 BellmanFordF a -> BellmanFordF a)
-> Generic1 BellmanFordF
forall a. Rep1 BellmanFordF a -> BellmanFordF a
forall a. BellmanFordF a -> Rep1 BellmanFordF a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 BellmanFordF a -> BellmanFordF a
$cfrom1 :: forall a. BellmanFordF a -> Rep1 BellmanFordF a
Generic1, Int -> BellmanFordF r -> ShowS
[BellmanFordF r] -> ShowS
BellmanFordF r -> [Char]
(Int -> BellmanFordF r -> ShowS)
-> (BellmanFordF r -> [Char])
-> ([BellmanFordF r] -> ShowS)
-> Show (BellmanFordF r)
forall r. Show r => Int -> BellmanFordF r -> ShowS
forall r. Show r => [BellmanFordF r] -> ShowS
forall r. Show r => BellmanFordF r -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BellmanFordF r] -> ShowS
$cshowList :: forall r. Show r => [BellmanFordF r] -> ShowS
show :: BellmanFordF r -> [Char]
$cshow :: forall r. Show r => BellmanFordF r -> [Char]
showsPrec :: Int -> BellmanFordF r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> BellmanFordF r -> ShowS
Show, a -> BellmanFordF b -> BellmanFordF a
(a -> b) -> BellmanFordF a -> BellmanFordF b
(forall a b. (a -> b) -> BellmanFordF a -> BellmanFordF b)
-> (forall a b. a -> BellmanFordF b -> BellmanFordF a)
-> Functor BellmanFordF
forall a b. a -> BellmanFordF b -> BellmanFordF a
forall a b. (a -> b) -> BellmanFordF a -> BellmanFordF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BellmanFordF b -> BellmanFordF a
$c<$ :: forall a b. a -> BellmanFordF b -> BellmanFordF a
fmap :: (a -> b) -> BellmanFordF a -> BellmanFordF b
$cfmap :: forall a b. (a -> b) -> BellmanFordF a -> BellmanFordF b
Functor)

instance Show1 BellmanFordF where
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> BellmanFordF a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (PropagationCheck (IDLGraphVertex, IDLGraphVertex)
vs a
r) = (Int -> (IDLGraphVertex, IDLGraphVertex) -> ShowS)
-> (Int -> a -> ShowS)
-> [Char]
-> Int
-> (IDLGraphVertex, IDLGraphVertex)
-> a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> [Char] -> Int -> a -> b -> ShowS
showsBinaryWith Int -> (IDLGraphVertex, IDLGraphVertex) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int -> a -> ShowS
sp [Char]
"PropagationCheck" Int
d (IDLGraphVertex, IDLGraphVertex)
vs a
r
  liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (PropagationFindShorter IDLGraphVertex
v (IDLGraphVertex, Int)
p a
r) = (Int -> IDLGraphVertex -> ShowS)
-> (Int -> (IDLGraphVertex, Int) -> ShowS)
-> (Int -> a -> ShowS)
-> [Char]
-> Int
-> IDLGraphVertex
-> (IDLGraphVertex, Int)
-> a
-> ShowS
forall a b c.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS)
-> (Int -> c -> ShowS)
-> [Char]
-> Int
-> a
-> b
-> c
-> ShowS
showsTernaryWith Int -> IDLGraphVertex -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int -> (IDLGraphVertex, Int) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int -> a -> ShowS
sp [Char]
"PropagationFindShorter" Int
d IDLGraphVertex
v (IDLGraphVertex, Int)
p a
r
  liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (PropagationNth Int
n a
r) = (Int -> Int -> ShowS)
-> (Int -> a -> ShowS) -> [Char] -> Int -> Int -> a -> ShowS
forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> [Char] -> Int -> a -> b -> ShowS
showsBinaryWith Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int -> a -> ShowS
sp [Char]
"PropagationNth" Int
d Int
n a
r
  liftShowsPrec Int -> a -> ShowS
_  [a] -> ShowS
_ Int
_ BellmanFordF a
PropagationEnd = [Char] -> ShowS
showString [Char]
"PropagationEnd"
  liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (NegativeCycleCheck (IDLGraphVertex, IDLGraphVertex)
vs a
r) = (Int -> (IDLGraphVertex, IDLGraphVertex) -> ShowS)
-> (Int -> a -> ShowS)
-> [Char]
-> Int
-> (IDLGraphVertex, IDLGraphVertex)
-> a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> [Char] -> Int -> a -> b -> ShowS
showsBinaryWith Int -> (IDLGraphVertex, IDLGraphVertex) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int -> a -> ShowS
sp [Char]
"NegativeCycleCheck" Int
d (IDLGraphVertex, IDLGraphVertex)
vs a
r
  liftShowsPrec Int -> a -> ShowS
_  [a] -> ShowS
_ Int
d (NegativeCycleFind [Expressed]
path) = (Int -> [Expressed] -> ShowS)
-> [Char] -> Int -> [Expressed] -> ShowS
forall a. (Int -> a -> ShowS) -> [Char] -> Int -> a -> ShowS
showsUnaryWith Int -> [Expressed] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [Char]
"NegativeCycleFind" Int
d [Expressed]
path
  liftShowsPrec Int -> a -> ShowS
_  [a] -> ShowS
_ Int
_ BellmanFordF a
NegativeCyclePass = [Char] -> ShowS
showString [Char]
"NegativeCyclePass"

propagationCheck :: (IDLGraphVertex, IDLGraphVertex) -> BellmanFord ()
propagationCheck :: (IDLGraphVertex, IDLGraphVertex) -> BellmanFord ()
propagationCheck (IDLGraphVertex, IDLGraphVertex)
vs = BellmanFordF (BellmanFord ()) -> BellmanFord ()
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (BellmanFordF (BellmanFord ()) -> BellmanFord ())
-> (BellmanFord () -> BellmanFordF (BellmanFord ()))
-> BellmanFord ()
-> BellmanFord ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IDLGraphVertex, IDLGraphVertex)
-> BellmanFord () -> BellmanFordF (BellmanFord ())
forall r. (IDLGraphVertex, IDLGraphVertex) -> r -> BellmanFordF r
PropagationCheck (IDLGraphVertex, IDLGraphVertex)
vs (BellmanFord () -> BellmanFord ())
-> BellmanFord () -> BellmanFord ()
forall a b. (a -> b) -> a -> b
$ () -> BellmanFord ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE propagationCheck #-}

propagationFindShorter :: IDLGraphVertex -> (IDLGraphVertex, Int) -> BellmanFord ()
propagationFindShorter :: IDLGraphVertex -> (IDLGraphVertex, Int) -> BellmanFord ()
propagationFindShorter IDLGraphVertex
v (IDLGraphVertex, Int)
p = BellmanFordF (BellmanFord ()) -> BellmanFord ()
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (BellmanFordF (BellmanFord ()) -> BellmanFord ())
-> (BellmanFord () -> BellmanFordF (BellmanFord ()))
-> BellmanFord ()
-> BellmanFord ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IDLGraphVertex
-> (IDLGraphVertex, Int)
-> BellmanFord ()
-> BellmanFordF (BellmanFord ())
forall r.
IDLGraphVertex -> (IDLGraphVertex, Int) -> r -> BellmanFordF r
PropagationFindShorter IDLGraphVertex
v (IDLGraphVertex, Int)
p (BellmanFord () -> BellmanFord ())
-> BellmanFord () -> BellmanFord ()
forall a b. (a -> b) -> a -> b
$ () -> BellmanFord ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE propagationFindShorter #-}

propagationNth :: Int -> BellmanFord ()
propagationNth :: Int -> BellmanFord ()
propagationNth Int
n = BellmanFordF (BellmanFord ()) -> BellmanFord ()
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (BellmanFordF (BellmanFord ()) -> BellmanFord ())
-> (BellmanFord () -> BellmanFordF (BellmanFord ()))
-> BellmanFord ()
-> BellmanFord ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BellmanFord () -> BellmanFordF (BellmanFord ())
forall r. Int -> r -> BellmanFordF r
PropagationNth Int
n (BellmanFord () -> BellmanFord ())
-> BellmanFord () -> BellmanFord ()
forall a b. (a -> b) -> a -> b
$ () -> BellmanFord ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE propagationNth #-}

propagationEnd :: BellmanFord ()
propagationEnd :: BellmanFord ()
propagationEnd = BellmanFordF (BellmanFord ()) -> BellmanFord ()
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap BellmanFordF (BellmanFord ())
forall r. BellmanFordF r
PropagationEnd
{-# INLINE propagationEnd #-}

negativeCycleCheck :: (IDLGraphVertex, IDLGraphVertex) -> BellmanFord ()
negativeCycleCheck :: (IDLGraphVertex, IDLGraphVertex) -> BellmanFord ()
negativeCycleCheck (IDLGraphVertex, IDLGraphVertex)
vs = BellmanFordF (BellmanFord ()) -> BellmanFord ()
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (BellmanFordF (BellmanFord ()) -> BellmanFord ())
-> (BellmanFord () -> BellmanFordF (BellmanFord ()))
-> BellmanFord ()
-> BellmanFord ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IDLGraphVertex, IDLGraphVertex)
-> BellmanFord () -> BellmanFordF (BellmanFord ())
forall r. (IDLGraphVertex, IDLGraphVertex) -> r -> BellmanFordF r
NegativeCycleCheck (IDLGraphVertex, IDLGraphVertex)
vs (BellmanFord () -> BellmanFord ())
-> BellmanFord () -> BellmanFord ()
forall a b. (a -> b) -> a -> b
$ () -> BellmanFord ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE negativeCycleCheck #-}

negativeCycleFind :: [QFIDL.Expressed] -> BellmanFord ()
negativeCycleFind :: [Expressed] -> BellmanFord ()
negativeCycleFind = BellmanFordF (BellmanFord ()) -> BellmanFord ()
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (BellmanFordF (BellmanFord ()) -> BellmanFord ())
-> ([Expressed] -> BellmanFordF (BellmanFord ()))
-> [Expressed]
-> BellmanFord ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expressed] -> BellmanFordF (BellmanFord ())
forall r. [Expressed] -> BellmanFordF r
NegativeCycleFind
{-# INLINE negativeCycleFind #-}

negativeCyclePass :: BellmanFord ()
negativeCyclePass :: BellmanFord ()
negativeCyclePass = BellmanFordF (BellmanFord ()) -> BellmanFord ()
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap BellmanFordF (BellmanFord ())
forall r. BellmanFordF r
NegativeCyclePass
{-# INLINE negativeCyclePass #-}