{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# Language QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}

{- |
Functions using `Interpreter` to run time compile and evaluate various aspects of a task.
The interpreted code is usually supplied by accessing data stored in `FlexInst` or `FlexConf`.
-}

module FlexTask.Interpreter
  ( checkSolution
  , genFlexInst
  , prettyError
  , validateSettings
  , validDescription
  ) where


import Control.Monad                (unless, void)
import Control.Monad.Identity       (runIdentity)
import Control.Monad.Random         (RandT, StdGen, evalRandT, mkStdGen)
import Control.OutputCapable.Blocks.Type
import Control.OutputCapable.Blocks (OutputCapable, LangM)
import Data.Digest.Pure.SHA         (sha256, showDigest)
import Data.List.Extra              (replace)
import Data.Map                     (elems)
import Data.Maybe                   (isJust)
import Data.Text                    (Text)
import Data.Text.Lazy.Encoding      (encodeUtf8)
import Data.Text.Lazy               (pack)
import Data.Typeable                (Typeable)
import Data.Tuple.Extra             (first)
import Language.Haskell.Interpreter (
    GhcError(errMsg),
    Interpreter,
    InterpreterError(..),
    infer,
    interpret,
    loadModules,
    parens,
    setImports,
    setTopLevelModules
    )
import Language.Haskell.Interpreter.Unsafe (
    unsafeRunInterpreterWithArgs
    )
import System.Directory (
    createDirectoryIfMissing,
    doesFileExist,
    getTemporaryDirectory,
    )
import System.Environment          (getEnv)
import System.FilePath             ((</>), (<.>))
import Text.RawString.QQ (rQ)

import FlexTask.Types (
  CommonModules(..),
  FlexConf(..),
  FlexInst(..),
  HtmlDict,
  )
import FlexTask.Processing.Text    (removeUnicodeEscape)




type GenOutput = (String, String, IO ([Text],HtmlDict))


{- |
-}
validateSettings
  :: String   -- ^ Global module
  -> String   -- ^ Module containing configuration options
  -> [(String,String)] -- ^ Additional code modules
  -> IO (Either InterpreterError (Bool,[Output]))
validateSettings :: FilePath
-> FilePath
-> [(FilePath, FilePath)]
-> IO (Either InterpreterError (Bool, [Output]))
validateSettings FilePath
globalCode FilePath
settingsCode [(FilePath, FilePath)]
extraCode = do
    [FilePath]
filePaths <- [(FilePath, FilePath)] -> IO [FilePath]
writeUncachedAndGetPaths ([(FilePath, FilePath)] -> IO [FilePath])
-> [(FilePath, FilePath)] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
      [ (FilePath
"Global", FilePath
globalCode)
      , (FilePath
"TaskSettings", FilePath
settingsCode)
      ] [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
extraCode
    Interpreter (Bool, [Output])
-> IO (Either InterpreterError (Bool, [Output]))
forall a. Interpreter a -> IO (Either InterpreterError a)
runWithPackageDB ([FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
loadModules [FilePath]
filePaths InterpreterT IO ()
-> Interpreter (Bool, [Output]) -> Interpreter (Bool, [Output])
forall a b.
InterpreterT IO a -> InterpreterT IO b -> InterpreterT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Interpreter (Bool, [Output])
validate)
  where
    validate :: Interpreter (Bool, [Output])
validate = do
      [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setImports
        [ FilePath
"Control.Monad.Identity"
        , FilePath
"Control.OutputCapable.Blocks.Generic.Type"
        , FilePath
"Control.OutputCapable.Blocks"
        , FilePath
"Data.Text"
        ]
      [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setTopLevelModules [FilePath
"TaskSettings", FilePath
"Global"]
      LangM' (ReportT Output Identity) ()
out <- FilePath
-> LangM' (ReportT Output Identity) ()
-> InterpreterT IO (LangM' (ReportT Output Identity) ())
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
FilePath -> a -> m a
interpret FilePath
"validateSettings" LangM' (ReportT Output Identity) ()
forall a. Typeable a => a
infer
      (Bool, [Output]) -> Interpreter (Bool, [Output])
forall a. a -> InterpreterT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bool, [Output]) -> Interpreter (Bool, [Output]))
-> (Bool, [Output]) -> Interpreter (Bool, [Output])
forall a b. (a -> b) -> a -> b
$ (Maybe () -> Bool) -> (Maybe (), [Output]) -> (Bool, [Output])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (forall a. Maybe a -> Bool
isJust @()) ((Maybe (), [Output]) -> (Bool, [Output]))
-> (Maybe (), [Output]) -> (Bool, [Output])
forall a b. (a -> b) -> a -> b
$ Identity (Maybe (), [Output]) -> (Maybe (), [Output])
forall a. Identity a -> a
runIdentity (Identity (Maybe (), [Output]) -> (Maybe (), [Output]))
-> Identity (Maybe (), [Output]) -> (Maybe (), [Output])
forall a b. (a -> b) -> a -> b
$ LangM' (ReportT Output Identity) ()
-> Identity (Maybe (), [Output])
forall (m :: * -> *) a.
Functor m =>
LangM' (ReportT Output m) a -> m (Maybe a, [Output])
getOutputSequenceWithResult LangM' (ReportT Output Identity) ()
out

{- |
Use a `FlexConf` to generate a `FlexInst`.
Interprets `taskDataModule` to generate the input form and task data.
Apply the given method to run the generator with a seed.
-}
genFlexInst
  :: FlexConf
  -> Int          -- ^ Generator seed
  -> IO FlexInst
genFlexInst :: FlexConf -> Int -> IO FlexInst
genFlexInst
  FlexConf{ commonModules :: FlexConf -> CommonModules
commonModules = commonModules :: CommonModules
commonModules@CommonModules{
    FilePath
globalModule :: FilePath
globalModule :: CommonModules -> FilePath
globalModule,
    FilePath
settingsModule :: FilePath
settingsModule :: CommonModules -> FilePath
settingsModule,
    [(FilePath, FilePath)]
extraModules :: [(FilePath, FilePath)]
extraModules :: CommonModules -> [(FilePath, FilePath)]
extraModules
    },
    FilePath
taskDataModule :: FlexConf -> FilePath
taskDataModule :: FilePath
..}
  Int
seed
  = do
      [FilePath]
filePaths <- [(FilePath, FilePath)] -> IO [FilePath]
writeUncachedAndGetPaths ([(FilePath, FilePath)] -> IO [FilePath])
-> [(FilePath, FilePath)] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
        [ (FilePath
"Global", FilePath
globalModule)
        , (FilePath
"TaskSettings", FilePath
settingsModule)
        , (FilePath
"TaskData", FilePath
taskDataModule)
        , (FilePath
"Helper", FilePath
helper)
        ] [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
extraModules
      Either InterpreterError (RandT StdGen IO GenOutput)
taskAndFormResult <- Interpreter (RandT StdGen IO GenOutput)
-> IO (Either InterpreterError (RandT StdGen IO GenOutput))
forall a. Interpreter a -> IO (Either InterpreterError a)
runWithPackageDB (Interpreter (RandT StdGen IO GenOutput)
 -> IO (Either InterpreterError (RandT StdGen IO GenOutput)))
-> Interpreter (RandT StdGen IO GenOutput)
-> IO (Either InterpreterError (RandT StdGen IO GenOutput))
forall a b. (a -> b) -> a -> b
$
                             [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
loadModules [FilePath]
filePaths InterpreterT IO ()
-> Interpreter (RandT StdGen IO GenOutput)
-> Interpreter (RandT StdGen IO GenOutput)
forall a b.
InterpreterT IO a -> InterpreterT IO b -> InterpreterT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Interpreter (RandT StdGen IO GenOutput)
tfInter
      let gen :: RandT StdGen IO GenOutput
gen = Either InterpreterError (RandT StdGen IO GenOutput)
-> RandT StdGen IO GenOutput
forall c. Either InterpreterError c -> c
extract Either InterpreterError (RandT StdGen IO GenOutput)
taskAndFormResult
      (FilePath
taskData, FilePath
checkModule, IO ([Text], HtmlDict)
io) <- RandT StdGen IO GenOutput -> StdGen -> IO GenOutput
forall (m :: * -> *) g a. Monad m => RandT g m a -> g -> m a
evalRandT RandT StdGen IO GenOutput
gen (StdGen -> IO GenOutput) -> StdGen -> IO GenOutput
forall a b. (a -> b) -> a -> b
$ Int -> StdGen
mkStdGen Int
seed
      ([Text], HtmlDict)
form <- IO ([Text], HtmlDict)
io
      FlexInst -> IO FlexInst
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FlexInst -> IO FlexInst) -> FlexInst -> IO FlexInst
forall a b. (a -> b) -> a -> b
$ FlexInst {
        ([Text], HtmlDict)
form :: ([Text], HtmlDict)
form :: ([Text], HtmlDict)
form,
        FilePath
taskData :: FilePath
taskData :: FilePath
taskData,
        FilePath
checkModule :: FilePath
checkModule :: FilePath
checkModule,
        CommonModules
commonModules :: CommonModules
commonModules :: CommonModules
commonModules
      }
    where
      tfInter :: Interpreter (RandT StdGen IO GenOutput)
      tfInter :: Interpreter (RandT StdGen IO GenOutput)
tfInter = do
        [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setTopLevelModules [FilePath
"TaskData", FilePath
"Global", FilePath
"TaskSettings", FilePath
"Helper"]
        [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setImports [
            FilePath
"Capabilities.Alloy.IO"
          , FilePath
"Capabilities.Diagrams.IO"
          , FilePath
"Capabilities.Graphviz.IO"
          , FilePath
"Control.Monad.Random"
          , FilePath
"Data.Generics.Text"
          , FilePath
"Data.Map"
          , FilePath
"Data.Text"
          , FilePath
"Data.Tuple.Extra"
          ]
        FilePath
-> RandT StdGen IO GenOutput
-> Interpreter (RandT StdGen IO GenOutput)
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
FilePath -> a -> m a
interpret FilePath
"first3 gshow <$> getTask " RandT StdGen IO GenOutput
forall a. Typeable a => a
infer



makeDescription
  :: (OutputCapable m, Typeable m)
  => String
  -> String
  -> String
  -> String
  -> [(String,String)]
  -> FilePath
  -> IO (Either InterpreterError (LangM m))
makeDescription :: forall (m :: * -> *).
(OutputCapable m, Typeable m) =>
FilePath
-> FilePath
-> FilePath
-> FilePath
-> [(FilePath, FilePath)]
-> FilePath
-> IO (Either InterpreterError (LangM m))
makeDescription FilePath
taskData FilePath
global FilePath
settings FilePath
description [(FilePath, FilePath)]
extras FilePath
picPath = do
    [FilePath]
filePaths <- [(FilePath, FilePath)] -> IO [FilePath]
writeUncachedAndGetPaths ([(FilePath, FilePath)] -> IO [FilePath])
-> [(FilePath, FilePath)] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
          [ (FilePath
"Global", FilePath
global)
          , (FilePath
"TaskSettings", FilePath
settings)
          , (FilePath
"Description", FilePath
description)
          ] [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
extras
    Interpreter (LangM m) -> IO (Either InterpreterError (LangM m))
forall a. Interpreter a -> IO (Either InterpreterError a)
runWithPackageDB (Interpreter (LangM m) -> IO (Either InterpreterError (LangM m)))
-> Interpreter (LangM m) -> IO (Either InterpreterError (LangM m))
forall a b. (a -> b) -> a -> b
$ [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
loadModules [FilePath]
filePaths InterpreterT IO ()
-> Interpreter (LangM m) -> Interpreter (LangM m)
forall a b.
InterpreterT IO a -> InterpreterT IO b -> InterpreterT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Interpreter (LangM m)
descInter
  where
    descInter :: Interpreter (LangM m)
descInter = do
      [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setTopLevelModules [FilePath
"Description", FilePath
"Global", FilePath
"TaskSettings"]
      [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setImports
        [ FilePath
"Capabilities.Graphviz.IO"
        , FilePath
"Capabilities.Cache.IO"
        , FilePath
"Capabilities.Diagrams.IO"
        , FilePath
"Capabilities.LatexSvg.IO"
        , FilePath
"Capabilities.WriteFile.IO"
        , FilePath
"Control.OutputCapable.Blocks.Generic.Type"
        , FilePath
"Data.Text"
        ]
      FilePath -> LangM m -> Interpreter (LangM m)
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
FilePath -> a -> m a
interpret (FilePath
"description " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
picPath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
parens FilePath
taskData) LangM m
forall a. Typeable a => a
infer



{- |
Produce the task description by using task data
and two interpreted modules or restore a cached result.
Should the solution not yet exist on disc,
then it will be created by interpreting /description/ and saved in a file.
If the task description already exists on disc, it is read.
Then, if any of the image links of that description are invalid (have been deleted),
the description is interpreted again to regenerate the missing files.
-}
validDescription
  :: OutputCapable m
  => String       -- ^ Data available for making the description
  -> String       -- ^ Global module
  -> String       -- ^ Settings module
  -> String       -- ^ Module containing the /description/ function
  -> [(String,String)] -- ^ Additional code modules
  -> FilePath     -- ^ Path images will be stored in
  -> IO (LangM m) -- ^ `OutputCapable` representation of task description
validDescription :: forall (m :: * -> *).
OutputCapable m =>
FilePath
-> FilePath
-> FilePath
-> FilePath
-> [(FilePath, FilePath)]
-> FilePath
-> IO (LangM m)
validDescription FilePath
taskData FilePath
globalModule FilePath
settingsModule FilePath
descModule [(FilePath, FilePath)]
extras FilePath
picPath = do
  let fileName :: FilePath
fileName = FilePath -> FilePath
forall a. Show a => a -> FilePath
hash (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [
          FilePath
descModule
        , FilePath
taskData
        , FilePath
globalModule
        , FilePath
settingsModule
        ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd [(FilePath, FilePath)]
extras
  FilePath
cDir <- IO FilePath
cacheDir
  let path :: FilePath
path = FilePath
cDir FilePath -> FilePath -> FilePath
</> FilePath
fileName
  Bool
isThere <- FilePath -> IO Bool
doesFileExist FilePath
path
  if Bool
isThere
    then do
      [Output]
output <- FilePath -> [Output]
forall a. Read a => FilePath -> a
read (FilePath -> [Output]) -> IO FilePath -> IO [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile FilePath
path
      let fileLinks :: [FilePath]
fileLinks = [Output] -> [FilePath]
imageLinks [Output]
output
      [Bool]
exist <- (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO Bool
doesFileExist [FilePath]
fileLinks
      if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
exist
        then
          LangM m -> IO (LangM m)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LangM m -> IO (LangM m)) -> LangM m -> IO (LangM m)
forall a b. (a -> b) -> a -> b
$ [Output] -> LangM m
forall (m :: * -> *). OutputCapable m => [Output] -> LangM m
toOutputCapable [Output]
output
        else
          Maybe [Output] -> FilePath -> IO (LangM m)
forall {m :: * -> *}.
OutputCapable m =>
Maybe [Output] -> FilePath -> IO (LangM m)
makeDescAndWrite ([Output] -> Maybe [Output]
forall a. a -> Maybe a
Just [Output]
output) FilePath
path
    else
      Maybe [Output] -> FilePath -> IO (LangM m)
forall {m :: * -> *}.
OutputCapable m =>
Maybe [Output] -> FilePath -> IO (LangM m)
makeDescAndWrite Maybe [Output]
forall a. Maybe a
Nothing FilePath
path
  where
    makeDescAndWrite :: Maybe [Output] -> FilePath -> IO (LangM m)
makeDescAndWrite Maybe [Output]
mOldOutput FilePath
p = do
      Either InterpreterError (LangM (ReportT Output IO))
res <- FilePath
-> FilePath
-> FilePath
-> FilePath
-> [(FilePath, FilePath)]
-> FilePath
-> IO (Either InterpreterError (LangM (ReportT Output IO)))
forall (m :: * -> *).
(OutputCapable m, Typeable m) =>
FilePath
-> FilePath
-> FilePath
-> FilePath
-> [(FilePath, FilePath)]
-> FilePath
-> IO (Either InterpreterError (LangM m))
makeDescription FilePath
taskData FilePath
globalModule FilePath
settingsModule FilePath
descModule [(FilePath, FilePath)]
extras FilePath
picPath
      [Output]
output <- LangM (ReportT Output IO) -> IO [Output]
forall (m :: * -> *).
Functor m =>
LangM (ReportT Output m) -> m [Output]
getOutputSequence (LangM (ReportT Output IO) -> IO [Output])
-> LangM (ReportT Output IO) -> IO [Output]
forall a b. (a -> b) -> a -> b
$ Either InterpreterError (LangM (ReportT Output IO))
-> LangM (ReportT Output IO)
forall c. Either InterpreterError c -> c
extract Either InterpreterError (LangM (ReportT Output IO))
res
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe [Output]
mOldOutput Maybe [Output] -> Maybe [Output] -> Bool
forall a. Eq a => a -> a -> Bool
== [Output] -> Maybe [Output]
forall a. a -> Maybe a
Just [Output]
output) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
p (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [Output] -> FilePath
forall a. Show a => a -> FilePath
show [Output]
output
      LangM m -> IO (LangM m)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LangM m -> IO (LangM m)) -> LangM m -> IO (LangM m)
forall a b. (a -> b) -> a -> b
$ [Output] -> LangM m
forall (m :: * -> *). OutputCapable m => [Output] -> LangM m
toOutputCapable [Output]
output



{- |
Run the interpreter with a custom package database.
The filepath is given externally via an environment variable /FLEX_PKGDB/.
-}
runWithPackageDB :: Interpreter a -> IO (Either InterpreterError a)
runWithPackageDB :: forall a. Interpreter a -> IO (Either InterpreterError a)
runWithPackageDB Interpreter a
interpreter = do
  FilePath
path <- FilePath -> IO FilePath
getEnv FilePath
"FLEX_PKGDB"
  [FilePath] -> Interpreter a -> IO (Either InterpreterError a)
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
[FilePath] -> InterpreterT m a -> m (Either InterpreterError a)
unsafeRunInterpreterWithArgs [FilePath
"-package-db " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path] Interpreter a
interpreter



{- |
Use task data and interpret three code modules to evaluate a submission.
The submission ist parsed by function /parseSubmission/.
The result is evaluated by functions /checkSyntax/ and /checkSemantics/.
The result is a tuple of syntax feedback and optional semantics feedback.
If the syntax check fails, then no semantics feedback is provided.
Semantics feedback is coupled with a rating given as a Rational (0 to 1).
-}
checkSolution
  :: String   -- ^ Data made available to checker functions
  -> String   -- ^ Global module
  -> String   -- ^ Module containing configuration options
  -> String   -- ^ Module containing /parseSubmission/
  -> String   -- ^ Module containing /checkSyntax/ and /checkSemantics/
  -> [(String,String)] -- ^ Additional code modules
  -> String   -- ^ Student solution
  -> FilePath -- ^ Path images will be stored in
  -> IO (Either InterpreterError ([Output], Maybe (Maybe Rational, [Output])))
checkSolution :: FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> [(FilePath, FilePath)]
-> FilePath
-> FilePath
-> IO
     (Either
        InterpreterError ([Output], Maybe (Maybe Rational, [Output])))
checkSolution FilePath
taskData FilePath
globalCode FilePath
settingsCode FilePath
parseCode FilePath
checkCode [(FilePath, FilePath)]
extraCode FilePath
submission FilePath
picPath = do
    [FilePath]
filePaths <- [(FilePath, FilePath)] -> IO [FilePath]
writeUncachedAndGetPaths ([(FilePath, FilePath)] -> IO [FilePath])
-> [(FilePath, FilePath)] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
      [ (FilePath
"Global", FilePath
globalCode)
      , (FilePath
"TaskSettings", FilePath
settingsCode)
      , (FilePath
"Parse", FilePath
parseCode)
      , (FilePath
"Check", FilePath
checkCode)
      , (FilePath
"Helper", FilePath
helper)
      ] [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
extraCode
    Interpreter (IO ([Output], Maybe (Maybe Rational, [Output])))
-> IO
     (Either
        InterpreterError (IO ([Output], Maybe (Maybe Rational, [Output]))))
forall a. Interpreter a -> IO (Either InterpreterError a)
runWithPackageDB ([FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
loadModules [FilePath]
filePaths InterpreterT IO ()
-> Interpreter (IO ([Output], Maybe (Maybe Rational, [Output])))
-> Interpreter (IO ([Output], Maybe (Maybe Rational, [Output])))
forall a b.
InterpreterT IO a -> InterpreterT IO b -> InterpreterT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Interpreter (IO ([Output], Maybe (Maybe Rational, [Output])))
runCheck) IO
  (Either
     InterpreterError (IO ([Output], Maybe (Maybe Rational, [Output]))))
-> (Either
      InterpreterError (IO ([Output], Maybe (Maybe Rational, [Output])))
    -> IO
         (Either
            InterpreterError ([Output], Maybe (Maybe Rational, [Output]))))
-> IO
     (Either
        InterpreterError ([Output], Maybe (Maybe Rational, [Output])))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either
  InterpreterError (IO ([Output], Maybe (Maybe Rational, [Output])))
-> IO
     (Either
        InterpreterError ([Output], Maybe (Maybe Rational, [Output])))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
Either InterpreterError (m a) -> m (Either InterpreterError a)
sequence
  where
    runCheck :: Interpreter (IO ([Output], Maybe (Maybe Rational, [Output])))
runCheck = do
      [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setImports
        [ FilePath
"Capabilities.Cache.IO"
        , FilePath
"Capabilities.Diagrams.IO"
        , FilePath
"Capabilities.LatexSvg.IO"
        , FilePath
"Capabilities.Graphviz.IO"
        , FilePath
"Capabilities.WriteFile.IO"
        , FilePath
"Control.OutputCapable.Blocks.Generic.Type"
        , FilePath
"Control.OutputCapable.Blocks"
        , FilePath
"Data.Ratio"
        , FilePath
"Data.Text"
        ]
      [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setTopLevelModules [FilePath
"Check", FilePath
"Global", FilePath
"Helper", FilePath
"Parse"]
      FilePath
-> IO ([Output], Maybe (Maybe Rational, [Output]))
-> Interpreter (IO ([Output], Maybe (Maybe Rational, [Output])))
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
FilePath -> a -> m a
interpret (FilePath
"syntaxAndSemantics parseSubmission checkSyntax checkSemantics " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tData) IO ([Output], Maybe (Maybe Rational, [Output]))
forall a. Typeable a => a
infer

    tData :: FilePath
tData = FilePath -> FilePath
parens FilePath
taskData
    input :: FilePath
input = FilePath -> FilePath
removeUnicodeEscape (FilePath -> FilePath
forall a. Show a => a -> FilePath
show (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace FilePath
"\\\\" FilePath
"\\" FilePath
submission)
    path :: FilePath
path = FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
picPath



writeUncachedAndGetPaths :: [(String, String)] -> IO [FilePath]
writeUncachedAndGetPaths :: [(FilePath, FilePath)] -> IO [FilePath]
writeUncachedAndGetPaths [(FilePath, FilePath)]
xs = do
    [(FilePath, FilePath)]
paths <- [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
getCachePaths [(FilePath, FilePath)]
xs
    [(FilePath, FilePath)] -> IO ()
writeUncachedFiles [(FilePath, FilePath)]
paths
    [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst [(FilePath, FilePath)]
paths
  where
    getCachePaths :: [(String,String)] -> IO [(FilePath,String)]
    getCachePaths :: [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
getCachePaths [(FilePath, FilePath)]
files = do
      FilePath
dir <- IO FilePath
cacheDir
      [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(FilePath, FilePath)] -> IO [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> (FilePath, FilePath))
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
prefix, FilePath
content) ->
                 (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
prefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a. Show a => a -> FilePath
hash FilePath
content FilePath -> FilePath -> FilePath
<.> FilePath
"hs",FilePath
content)) [(FilePath, FilePath)]
files

    writeUncachedFiles :: [(FilePath,String)] -> IO ()
    writeUncachedFiles :: [(FilePath, FilePath)] -> IO ()
writeUncachedFiles = IO [()] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [()] -> IO ())
-> ([(FilePath, FilePath)] -> IO [()])
-> [(FilePath, FilePath)]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, FilePath) -> IO ())
-> [(FilePath, FilePath)] -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ (FilePath
path,FilePath
content) ->
      FilePath -> IO Bool
doesFileExist FilePath
path IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> FilePath -> IO ()
writeFile FilePath
path FilePath
content))



extract :: Either InterpreterError c -> c
extract :: forall c. Either InterpreterError c -> c
extract = (InterpreterError -> c)
-> (c -> c) -> Either InterpreterError c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> c
forall a. HasCallStack => FilePath -> a
error (FilePath -> c)
-> (InterpreterError -> FilePath) -> InterpreterError -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterError -> FilePath
prettyError) c -> c
forall a. a -> a
id


hash :: Show a => a -> String
hash :: forall a. Show a => a -> FilePath
hash = Digest SHA256State -> FilePath
forall t. Digest t -> FilePath
showDigest (Digest SHA256State -> FilePath)
-> (a -> Digest SHA256State) -> a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256 (ByteString -> Digest SHA256State)
-> (a -> ByteString) -> a -> Digest SHA256State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack (FilePath -> Text) -> (a -> FilePath) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
forall a. Show a => a -> FilePath
show



cacheDir :: IO FilePath
cacheDir :: IO FilePath
cacheDir = do
  FilePath
temporary <- IO FilePath
getTemporaryDirectory
  let dir :: FilePath
dir = FilePath
temporary FilePath -> FilePath -> FilePath
</> FilePath
"FlexCache"
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
dir
  FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
dir



imageLinks :: [Output] -> [FilePath]
imageLinks :: [Output] -> [FilePath]
imageLinks = (Output -> [FilePath]) -> [Output] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Output -> [FilePath]) -> [Output] -> [FilePath])
-> (Output -> [FilePath]) -> [Output] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> [FilePath] -> [FilePath])
-> (Output -> [FilePath]) -> Output -> [FilePath]
forall a element.
(a -> a -> a)
-> (SpecialOutput element -> a) -> SpecialOutput element -> a
foldMapOutputBy [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
(++) (\case
  Image FilePath
l       -> [FilePath
l]
  Images Map FilePath FilePath
m      -> Map FilePath FilePath -> [FilePath]
forall k a. Map k a -> [a]
elems Map FilePath FilePath
m
  YesNo {}      -> []
  Paragraph {}  -> []
  Enumerated {} -> []
  Itemized {}   -> []
  Indented {}   -> []
  Folded {}     -> []
  Latex {}      -> []
  Code {}       -> []
  Translated {} -> []
  Special {}    -> []
  )


helper :: String
helper :: FilePath
helper = FilePath
[rQ|
  module Helper (syntaxAndSemantics) where
  import FlexTask.InterpreterHelper
  |]


{- |
Custom display of Hint InterpreterError messages.
-}
prettyError :: InterpreterError -> String
prettyError :: InterpreterError -> FilePath
prettyError (UnknownError FilePath
s) = FilePath
"Unknown error:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
prettyError (NotAllowed FilePath
s) = FilePath
"Not allowed:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
prettyError (GhcException FilePath
s) = FilePath
"GHC exception occurred:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
prettyError (WontCompile [GhcError]
ghcErrors) = FilePath
"Won't compile:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines ((GhcError -> FilePath) -> [GhcError] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map GhcError -> FilePath
errMsg [GhcError]
ghcErrors)