{-# OPTIONS_GHC -Wno-orphans #-}
{-# language ApplicativeDo #-}
module FlexTask.InterpreterHelper (syntaxAndSemantics) where


import Control.Monad.Catch              (MonadCatch(..), MonadThrow(..))
import Control.Monad.Trans.Class        (lift)
import Control.Monad.Trans.Random       (RandT, liftCatch)
import Control.OutputCapable.Blocks     (LangM, LangM', Rated, ReportT)
import Control.OutputCapable.Blocks.Generic (($>>=))
import Control.OutputCapable.Blocks.Type (
  Output,
  getOutputSequenceWithResult,
  getOutputSequenceWithRating,
  )



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


type Report = ReportT Output IO


syntaxAndSemantics
  :: (String -> LangM' Report b)
  -> (FilePath -> a -> b -> LangM Report)
  -> (FilePath -> a -> b -> Rated Report)
  -> String
  -> FilePath
  -> a
  -> IO ([Output], Maybe (Maybe Rational, [Output]))
syntaxAndSemantics :: forall b a.
(String -> LangM' Report b)
-> (String -> a -> b -> LangM Report)
-> (String -> a -> b -> Rated Report)
-> String
-> String
-> a
-> IO ([Output], Maybe (Maybe Rational, [Output]))
syntaxAndSemantics String -> LangM' Report b
preprocess String -> a -> b -> LangM Report
syntax String -> a -> b -> Rated Report
semantics String
input String
path a
tData = do
  let parseRes :: LangM' Report b
parseRes = String -> LangM' Report b
preprocess String
input
  let syn :: b -> LangM Report
syn = String -> a -> b -> LangM Report
syntax String
path a
tData
  (Maybe ()
synSuccess,[Output]
synRes) <- LangM Report -> IO (Maybe (), [Output])
forall (m :: * -> *) a.
Functor m =>
LangM' (ReportT Output m) a -> m (Maybe a, [Output])
getOutputSequenceWithResult (LangM' Report b
parseRes LangM' Report b -> (b -> LangM Report) -> LangM Report
forall (m :: * -> *) l a b.
Monad m =>
GenericLangM l m a
-> (a -> GenericLangM l m b) -> GenericLangM l m b
$>>= b -> LangM Report
syn)
  case Maybe ()
synSuccess of
    Maybe ()
Nothing -> ([Output], Maybe (Maybe Rational, [Output]))
-> IO ([Output], Maybe (Maybe Rational, [Output]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Output]
synRes,Maybe (Maybe Rational, [Output])
forall a. Maybe a
Nothing)
    Just () -> do
      let sem :: b -> Rated Report
sem = String -> a -> b -> Rated Report
semantics String
path a
tData
      (Maybe Rational, [Output])
semRes <- Rated Report -> IO (Maybe Rational, [Output])
forall (m :: * -> *).
Functor m =>
Rated (ReportT Output m) -> m (Maybe Rational, [Output])
getOutputSequenceWithRating (LangM' Report b
parseRes LangM' Report b -> (b -> Rated Report) -> Rated Report
forall (m :: * -> *) l a b.
Monad m =>
GenericLangM l m a
-> (a -> GenericLangM l m b) -> GenericLangM l m b
$>>= b -> Rated Report
sem)
      pure ([Output]
synRes, (Maybe Rational, [Output]) -> Maybe (Maybe Rational, [Output])
forall a. a -> Maybe a
Just (Maybe Rational, [Output])
semRes)