{-# 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.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.Text                    (Text)
import Data.Text.Lazy.Encoding      (encodeUtf8)
import Data.Text.Lazy               (pack)
import Data.Typeable                (Typeable)
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 Test.QuickCheck.Gen         (Gen)
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 [Output])
validateSettings :: FilePath
-> FilePath
-> [(FilePath, FilePath)]
-> IO (Either InterpreterError [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 [Output] -> IO (Either InterpreterError [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 [Output] -> Interpreter [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 [Output]
validate)
  where
    validate :: Interpreter [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
      [Output] -> Interpreter [Output]
forall a. a -> InterpreterT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Output] -> Interpreter [Output])
-> [Output] -> Interpreter [Output]
forall a b. (a -> b) -> a -> b
$ Identity [Output] -> [Output]
forall a. Identity a -> a
runIdentity (Identity [Output] -> [Output]) -> Identity [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ LangM (ReportT Output Identity) -> Identity [Output]
forall (m :: * -> *).
Functor m =>
LangM (ReportT Output m) -> m [Output]
getOutputSequence 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
  -> (Gen GenOutput -> a -> GenOutput) -- ^ Method of running the random generator
  -> a                                 -- ^ Generator seed
  -> IO FlexInst
genFlexInst :: forall a.
FlexConf -> (Gen GenOutput -> a -> GenOutput) -> a -> 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
..}
  Gen GenOutput -> a -> GenOutput
genMethod
  a
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, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
extraModules
      Either InterpreterError (Gen GenOutput)
taskAndFormResult <- Interpreter (Gen GenOutput)
-> IO (Either InterpreterError (Gen GenOutput))
forall a. Interpreter a -> IO (Either InterpreterError a)
runWithPackageDB (Interpreter (Gen GenOutput)
 -> IO (Either InterpreterError (Gen GenOutput)))
-> Interpreter (Gen GenOutput)
-> IO (Either InterpreterError (Gen GenOutput))
forall a b. (a -> b) -> a -> b
$
                             [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
loadModules [FilePath]
filePaths InterpreterT IO ()
-> Interpreter (Gen GenOutput) -> Interpreter (Gen 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 (Gen GenOutput)
tfInter
      let gen :: Gen GenOutput
gen = Either InterpreterError (Gen GenOutput) -> Gen GenOutput
forall c. Either InterpreterError c -> c
extract Either InterpreterError (Gen GenOutput)
taskAndFormResult
      let (FilePath
taskData, FilePath
checkModule, IO ([Text], HtmlDict)
io) = Gen GenOutput -> a -> GenOutput
genMethod Gen GenOutput
gen a
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 (Gen GenOutput)
      tfInter :: Interpreter (Gen GenOutput)
tfInter = do
        [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setTopLevelModules [FilePath
"TaskData", FilePath
"Global", FilePath
"TaskSettings"]
        [FilePath] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [FilePath] -> m ()
setImports [
            FilePath
"Data.Generics.Text"
          , FilePath
"Data.Map"
          , FilePath
"Data.Text"
          , FilePath
"Data.Tuple.Extra"
          ]
        FilePath -> Gen GenOutput -> Interpreter (Gen GenOutput)
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
FilePath -> a -> m a
interpret FilePath
"first3 gshow <$> getTask " Gen 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
"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
"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
    helper :: FilePath
helper = FilePath
[rQ|module Helper (syntaxAndSemantics) where
      import FlexTask.InterpreterHelper|]



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]
gatherLinks
  where
    gatherLinks :: Output -> [FilePath]
    gatherLinks :: Output -> [FilePath]
gatherLinks (Image FilePath
l)        = [FilePath
l]
    gatherLinks (Images Map FilePath FilePath
m)       = Map FilePath FilePath -> [FilePath]
forall k a. Map k a -> [a]
elems Map FilePath FilePath
m
    gatherLinks (YesNo Bool
_ [Output]
os)     = [Output] -> [FilePath]
imageLinks [Output]
os
    gatherLinks (Paragraph [Output]
os)   = [Output] -> [FilePath]
imageLinks [Output]
os
    gatherLinks (Enumerated [([Output], [Output])]
os)  = [Output] -> [FilePath]
imageLinks ([Output] -> [FilePath]) -> [Output] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Output]]
together
      where
        together :: [[Output]]
together = (([Output], [Output]) -> [[Output]])
-> [([Output], [Output])] -> [[Output]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([Output]
a,[Output]
b) -> [[Output]
a,[Output]
b]) [([Output], [Output])]
os
    gatherLinks (Itemized [[Output]]
oss)   = [Output] -> [FilePath]
imageLinks ([Output] -> [FilePath]) -> [Output] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Output]]
oss
    gatherLinks (Indented [Output]
os)    = [Output] -> [FilePath]
imageLinks [Output]
os
    gatherLinks Output
_                = []


{- |
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)