module Hydra.Monads (
module Hydra.Common,
module Hydra.Core,
module Hydra.Compute,
module Hydra.Monads,
) where
import Hydra.Common
import Hydra.Core
import Hydra.Compute
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Maybe as Y
import Control.Monad
import qualified System.IO as IO
type GraphFlow m = Flow (Context m)
instance Functor (Flow s) where
fmap :: forall a b. (a -> b) -> Flow s a -> Flow s b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative (Flow s) where
pure :: forall a. a -> Flow s a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. Flow s (a -> b) -> Flow s a -> Flow s b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (Flow s) where
return :: forall a. a -> Flow s a
return a
x = forall s a. (s -> Trace -> FlowState s a) -> Flow s a
Flow forall a b. (a -> b) -> a -> b
$ \s
s Trace
t -> forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState (forall a. a -> Maybe a
Just a
x) s
s Trace
t
Flow s a
p >>= :: forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
>>= a -> Flow s b
k = forall s a. (s -> Trace -> FlowState s a) -> Flow s a
Flow s -> Trace -> FlowState s b
q'
where
q' :: s -> Trace -> FlowState s b
q' s
s0 Trace
t0 = forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState Maybe b
y s
s2 Trace
t2
where
FlowState Maybe a
x s
s1 Trace
t1 = forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s a
p s
s0 Trace
t0
FlowState Maybe b
y s
s2 Trace
t2 = case Maybe a
x of
Just a
x' -> forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow (a -> Flow s b
k a
x') s
s1 Trace
t1
Maybe a
Nothing -> forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState forall a. Maybe a
Nothing s
s1 Trace
t1
instance MonadFail (Flow s) where
fail :: forall a. String -> Flow s a
fail String
msg = forall s a. (s -> Trace -> FlowState s a) -> Flow s a
Flow forall a b. (a -> b) -> a -> b
$ \s
s Trace
t -> forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState forall a. Maybe a
Nothing s
s (String -> Trace -> Trace
pushError String
msg Trace
t)
where
pushError :: String -> Trace -> Trace
pushError String
msg Trace
t = Trace
t {traceMessages :: [String]
traceMessages = String
errorMsgforall a. a -> [a] -> [a]
:(Trace -> [String]
traceMessages Trace
t)}
where
errorMsg :: String
errorMsg = String
"Error: " forall a. [a] -> [a] -> [a]
++ String
msg forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
L.intercalate String
" > " (forall a. [a] -> [a]
L.reverse forall a b. (a -> b) -> a -> b
$ Trace -> [String]
traceStack Trace
t) forall a. [a] -> [a] -> [a]
++ String
")"
emptyTrace :: Trace
emptyTrace :: Trace
emptyTrace = [String] -> [String] -> Map String (Term Meta) -> Trace
Trace [] [] forall k a. Map k a
M.empty
flowSucceeds :: s -> Flow s a -> Bool
flowSucceeds :: forall s a. s -> Flow s a -> Bool
flowSucceeds s
cx Flow s a
f = forall a. Maybe a -> Bool
Y.isJust forall a b. (a -> b) -> a -> b
$ forall s a. FlowState s a -> Maybe a
flowStateValue forall a b. (a -> b) -> a -> b
$ forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s a
f s
cx Trace
emptyTrace
flowWarning :: String -> Flow s a -> Flow s a
flowWarning :: forall s a. String -> Flow s a -> Flow s a
flowWarning String
msg Flow s a
b = forall s a. (s -> Trace -> FlowState s a) -> Flow s a
Flow s -> Trace -> FlowState s a
u'
where
u' :: s -> Trace -> FlowState s a
u' s
s0 Trace
t0 = forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState Maybe a
v s
s1 Trace
t2
where
FlowState Maybe a
v s
s1 Trace
t1 = forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s a
b s
s0 Trace
t0
t2 :: Trace
t2 = Trace
t1 {traceMessages :: [String]
traceMessages = (String
"Warning: " forall a. [a] -> [a] -> [a]
++ String
msg)forall a. a -> [a] -> [a]
:(Trace -> [String]
traceMessages Trace
t1)}
fromFlow :: s -> Flow s a -> a
fromFlow :: forall s a. s -> Flow s a -> a
fromFlow s
cx Flow s a
f = case forall s a. FlowState s a -> Maybe a
flowStateValue (forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s a
f s
cx Trace
emptyTrace) of
Just a
x -> a
x
fromFlowIo :: s -> Flow s a -> IO.IO a
fromFlowIo :: forall s a. s -> Flow s a -> IO a
fromFlowIo s
cx Flow s a
f = case Maybe a
mv of
Just a
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ Trace -> String
traceSummary Trace
trace
where
FlowState Maybe a
mv s
_ Trace
trace = forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s a
f s
cx Trace
emptyTrace
getState :: Flow s s
getState :: forall s. Flow s s
getState = forall s a. (s -> Trace -> FlowState s a) -> Flow s a
Flow s -> Trace -> FlowState s s
q
where
f :: Flow s ()
f = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
q :: s -> Trace -> FlowState s s
q s
s0 Trace
t0 = case Maybe ()
v1 of
Maybe ()
Nothing -> forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState forall a. Maybe a
Nothing s
s1 Trace
t1
Just ()
_ -> forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState (forall a. a -> Maybe a
Just s
s1) s
s1 Trace
t1
where
FlowState Maybe ()
v1 s
s1 Trace
t1 = forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s ()
f s
s0 Trace
t0
putState :: s -> Flow s ()
putState :: forall s. s -> Flow s ()
putState s
cx = forall s a. (s -> Trace -> FlowState s a) -> Flow s a
Flow forall {s}. s -> Trace -> FlowState s ()
q
where
q :: s -> Trace -> FlowState s ()
q s
s0 Trace
t0 = forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState Maybe ()
v s
cx Trace
t1
where
FlowState Maybe ()
v s
_ Trace
t1 = forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s ()
f s
s0 Trace
t0
f :: Flow s ()
f = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
traceSummary :: Trace -> String
traceSummary :: Trace -> String
traceSummary Trace
t = forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n" ([String]
messageLines forall a. [a] -> [a] -> [a]
++ [String]
keyvalLines)
where
messageLines :: [String]
messageLines = forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$ Trace -> [String]
traceMessages Trace
t
keyvalLines :: [String]
keyvalLines = if forall k a. Map k a -> Bool
M.null (Trace -> Map String (Term Meta)
traceOther Trace
t)
then []
else (String
"key/value pairs:")forall a. a -> [a] -> [a]
:(forall {a}. Show a => (String, a) -> String
toLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
M.toList (Trace -> Map String (Term Meta)
traceOther Trace
t))
where
toLine :: (String, a) -> String
toLine (String
k, a
v) = String
"\t" forall a. [a] -> [a] -> [a]
++ String
k forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v
unexpected :: (MonadFail m, Show a1) => String -> a1 -> m a2
unexpected :: forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
String -> a1 -> m a2
unexpected String
cat a1
obj = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"expected " forall a. [a] -> [a] -> [a]
++ String
cat forall a. [a] -> [a] -> [a]
++ String
" but found: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a1
obj
withState :: s1 -> Flow s1 a -> Flow s2 a
withState :: forall s1 a s2. s1 -> Flow s1 a -> Flow s2 a
withState s1
cx0 Flow s1 a
f = forall s a. (s -> Trace -> FlowState s a) -> Flow s a
Flow forall {s}. s -> Trace -> FlowState s a
q
where
q :: s -> Trace -> FlowState s a
q s
cx1 Trace
t1 = forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState Maybe a
v s
cx1 Trace
t2
where
FlowState Maybe a
v s1
_ Trace
t2 = forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s1 a
f s1
cx0 Trace
t1
withTrace :: String -> Flow s a -> Flow s a
withTrace :: forall s a. String -> Flow s a -> Flow s a
withTrace String
msg Flow s a
f = forall s a. (s -> Trace -> FlowState s a) -> Flow s a
Flow s -> Trace -> FlowState s a
q
where
q :: s -> Trace -> FlowState s a
q s
s0 Trace
t0 = forall s a. Maybe a -> s -> Trace -> FlowState s a
FlowState Maybe a
v s
s1 Trace
t3
where
FlowState Maybe a
v s
s1 Trace
t2 = forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s a
f s
s0 Trace
t1
t1 :: Trace
t1 = Trace
t0 {traceStack :: [String]
traceStack = String
msgforall a. a -> [a] -> [a]
:(Trace -> [String]
traceStack Trace
t0)}
t3 :: Trace
t3 = Trace
t2 {traceStack :: [String]
traceStack = Trace -> [String]
traceStack Trace
t0}
withWarning :: String -> a -> Flow s a
withWarning :: forall a s. String -> a -> Flow s a
withWarning String
msg a
x = forall s a. String -> Flow s a -> Flow s a
flowWarning String
msg forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x