{-# OPTIONS_GHC -Wno-orphans #-} module FlexTask.Interpreter.GenerationHelper ( getFormData, ) where import Capabilities.Alloy (MonadAlloy(..)) import Capabilities.Alloy.IO () import Capabilities.Diagrams (MonadDiagrams(..)) import Capabilities.Diagrams.IO () import Capabilities.Graphviz (MonadGraphviz(..)) import Capabilities.Graphviz.IO () import Control.Monad.Catch (MonadCatch(..), MonadThrow (..)) import Control.Monad.Trans.Random (RandT, liftCatch) import Control.Monad.Trans.Class (lift) import FlexTask.ConvertForm (getFormData) instance MonadThrow (RandT g IO) where throwM :: forall e a. (HasCallStack, Exception e) => e -> RandT g IO a throwM = IO a -> RandT g IO a forall (m :: * -> *) a. Monad m => m a -> RandT g m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (IO a -> RandT g IO a) -> (e -> IO a) -> e -> RandT g IO a forall b c a. (b -> c) -> (a -> b) -> a -> c . e -> IO a forall e a. (HasCallStack, Exception e) => e -> IO a forall (m :: * -> *) e a. (MonadThrow m, HasCallStack, Exception e) => e -> m a throwM instance MonadCatch (RandT g IO) where catch :: forall e a. (HasCallStack, Exception e) => RandT g IO a -> (e -> RandT g IO a) -> RandT g IO a catch = Catch e IO (a, g) -> Catch e (RandT g IO) a forall e (m :: * -> *) a g. Catch e m (a, g) -> Catch e (RandT g m) a liftCatch Catch e IO (a, g) forall e a. (HasCallStack, Exception e) => IO a -> (e -> IO a) -> IO a forall (m :: * -> *) e a. (MonadCatch m, HasCallStack, Exception e) => m a -> (e -> m a) -> m a catch instance MonadAlloy (RandT g IO) where getInstancesWith :: CallAlloyConfig -> String -> RandT g IO [AlloyInstance] getInstancesWith CallAlloyConfig config = IO [AlloyInstance] -> RandT g IO [AlloyInstance] forall (m :: * -> *) a. Monad m => m a -> RandT g m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (IO [AlloyInstance] -> RandT g IO [AlloyInstance]) -> (String -> IO [AlloyInstance]) -> String -> RandT g IO [AlloyInstance] forall b c a. (b -> c) -> (a -> b) -> a -> c . CallAlloyConfig -> String -> IO [AlloyInstance] forall (m :: * -> *). MonadAlloy m => CallAlloyConfig -> String -> m [AlloyInstance] getInstancesWith CallAlloyConfig config instance MonadDiagrams (RandT g IO) where lin :: forall n. (Read n, RealFloat n) => RandT g IO (PreparedFont n) lin = IO (PreparedFont n) -> RandT g IO (PreparedFont n) forall (m :: * -> *) a. Monad m => m a -> RandT g m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift IO (PreparedFont n) forall n. (Read n, RealFloat n) => IO (PreparedFont n) forall (m :: * -> *) n. (MonadDiagrams m, Read n, RealFloat n) => m (PreparedFont n) lin renderDiagram :: forall n o. (Show n, Typeable n, RealFloat n, Monoid o) => QDiagram SVG V2 n o -> RandT g IO ByteString renderDiagram = IO ByteString -> RandT g IO ByteString forall (m :: * -> *) a. Monad m => m a -> RandT g m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (IO ByteString -> RandT g IO ByteString) -> (QDiagram SVG V2 n o -> IO ByteString) -> QDiagram SVG V2 n o -> RandT g IO ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . QDiagram SVG V2 n o -> IO ByteString forall n o. (Show n, Typeable n, RealFloat n, Monoid o) => QDiagram SVG V2 n o -> IO ByteString forall (m :: * -> *) n o. (MonadDiagrams m, Show n, Typeable n, RealFloat n, Monoid o) => QDiagram SVG V2 n o -> m ByteString renderDiagram instance MonadGraphviz (RandT g IO) where errorWithoutGraphviz :: RandT g IO () errorWithoutGraphviz = IO () -> RandT g IO () forall (m :: * -> *) a. Monad m => m a -> RandT g m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift IO () forall (m :: * -> *). MonadGraphviz m => m () errorWithoutGraphviz layoutGraph :: forall (gr :: * -> * -> *) v e. Graph gr => GraphvizCommand -> gr v e -> RandT g IO (gr (AttributeNode v) (AttributeEdge e)) layoutGraph GraphvizCommand command = IO (gr (AttributeNode v) (AttributeEdge e)) -> RandT g IO (gr (AttributeNode v) (AttributeEdge e)) forall (m :: * -> *) a. Monad m => m a -> RandT g m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (IO (gr (AttributeNode v) (AttributeEdge e)) -> RandT g IO (gr (AttributeNode v) (AttributeEdge e))) -> (gr v e -> IO (gr (AttributeNode v) (AttributeEdge e))) -> gr v e -> RandT g IO (gr (AttributeNode v) (AttributeEdge e)) forall b c a. (b -> c) -> (a -> b) -> a -> c . GraphvizCommand -> gr v e -> IO (gr (AttributeNode v) (AttributeEdge e)) forall (m :: * -> *) (gr :: * -> * -> *) v e. (MonadGraphviz m, Graph gr) => GraphvizCommand -> gr v e -> m (gr (AttributeNode v) (AttributeEdge e)) forall (gr :: * -> * -> *) v e. Graph gr => GraphvizCommand -> gr v e -> IO (gr (AttributeNode v) (AttributeEdge e)) layoutGraph GraphvizCommand command layoutGraph' :: forall cl (gr :: * -> * -> *) v e l. (Ord cl, Graph gr) => GraphvizParams Node v e cl l -> GraphvizCommand -> gr v e -> RandT g IO (gr (AttributeNode v) (AttributeEdge e)) layoutGraph' GraphvizParams Node v e cl l params GraphvizCommand command = IO (gr (AttributeNode v) (AttributeEdge e)) -> RandT g IO (gr (AttributeNode v) (AttributeEdge e)) forall (m :: * -> *) a. Monad m => m a -> RandT g m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (IO (gr (AttributeNode v) (AttributeEdge e)) -> RandT g IO (gr (AttributeNode v) (AttributeEdge e))) -> (gr v e -> IO (gr (AttributeNode v) (AttributeEdge e))) -> gr v e -> RandT g IO (gr (AttributeNode v) (AttributeEdge e)) forall b c a. (b -> c) -> (a -> b) -> a -> c . GraphvizParams Node v e cl l -> GraphvizCommand -> gr v e -> IO (gr (AttributeNode v) (AttributeEdge e)) forall cl (gr :: * -> * -> *) v e l. (Ord cl, Graph gr) => GraphvizParams Node v e cl l -> GraphvizCommand -> gr v e -> IO (gr (AttributeNode v) (AttributeEdge e)) forall (m :: * -> *) cl (gr :: * -> * -> *) v e l. (MonadGraphviz m, Ord cl, Graph gr) => GraphvizParams Node v e cl l -> GraphvizCommand -> gr v e -> m (gr (AttributeNode v) (AttributeEdge e)) layoutGraph' GraphvizParams Node v e cl l params GraphvizCommand command