-- | Functions and type class implementations for working with Hydra's built-in Flow monad

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