{-# 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              (headDef, intercalate, replace)
import Data.Map                     (elems)
import Data.Maybe                   (isJust)
import Data.String.Interpolate      (i)
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 FlexTask.Types (
  CommonModules(..),
  FlexConf(..),
  FlexInst(..),
  HtmlDict,
  )
import FlexTask.Processing.Text    (removeUnicodeEscape)




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


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

{- |
Use a `FlexConf` to generate a `FlexInst`.
Interprets `taskDataModule` to generate the input form and task data.
The given Integer is used as a seed for the generator.
-}
genFlexInst
  :: FlexConf
  -> Int          -- ^ Generator seed
  -> IO FlexInst
genFlexInst :: FlexConf -> Int -> IO FlexInst
genFlexInst
  FlexConf{ commonModules :: FlexConf -> CommonModules
commonModules = commonModules :: CommonModules
commonModules@CommonModules{
    [Char]
taskName :: [Char]
taskName :: CommonModules -> [Char]
taskName,
    [Char]
globalModule :: [Char]
globalModule :: CommonModules -> [Char]
globalModule,
    [Char]
settingsModule :: [Char]
settingsModule :: CommonModules -> [Char]
settingsModule,
    [([Char], [Char])]
extraModules :: [([Char], [Char])]
extraModules :: CommonModules -> [([Char], [Char])]
extraModules
    },
    [Char]
taskDataModule :: FlexConf -> [Char]
taskDataModule :: [Char]
..}
  Int
seed
  = do
      filePaths <- [Char] -> [([Char], [Char])] -> IO [[Char]]
writeUncachedAndGetPaths [Char]
taskName ([([Char], [Char])] -> IO [[Char]])
-> [([Char], [Char])] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$
        [ ([Char]
"Global", [Char]
globalModule)
        , ([Char]
"TaskSettings", [Char]
settingsModule)
        , ([Char]
"TaskData", [Char]
taskDataModule)
        ] [([Char], [Char])] -> [([Char], [Char])] -> [([Char], [Char])]
forall a. [a] -> [a] -> [a]
++ [([Char], [Char])]
extraModules
      helperPath <- cacheHelper "GenerationHelper" []
      taskAndFormResult <- runWithPackageDB $
          loadModules (helperPath : filePaths) >> tfInter
      let 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
      (taskData, checkModule, io) <- evalRandT gen $ mkStdGen seed
      form <- io
      pure $ FlexInst {
        form,
        taskData,
        checkModule,
        commonModules
      }
    where
      tfInter :: Interpreter (RandT StdGen IO GenOutput)
      tfInter :: Interpreter (RandT StdGen IO GenOutput)
tfInter = do
        [[Char]] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [[Char]] -> m ()
setTopLevelModules [[Char]
"TaskData", [Char]
"Global", [Char]
"TaskSettings", [Char]
"GenerationHelper"]
        [[Char]] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [[Char]] -> m ()
setImports [
            [Char]
"Control.Monad.Random"
          , [Char]
"Data.Generics.Text"
          , [Char]
"Data.Map"
          , [Char]
"Data.Text"
          , [Char]
"Data.Tuple.Extra"
          ]
        [Char]
-> RandT StdGen IO GenOutput
-> Interpreter (RandT StdGen IO GenOutput)
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
[Char] -> a -> m a
interpret [Char]
"third3 getFormData . first3 gshow <$> getTask " RandT StdGen IO GenOutput
forall a. Typeable a => a
infer



makeDescription
  :: (OutputCapable m, Typeable m)
  => String
  -> String
  -> String
  -> String
  -> String
  -> [(String,String)]
  -> FilePath
  -> IO (Either InterpreterError (LangM m))
makeDescription :: forall (m :: * -> *).
(OutputCapable m, Typeable m) =>
[Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [([Char], [Char])]
-> [Char]
-> IO (Either InterpreterError (LangM m))
makeDescription [Char]
taskName [Char]
taskData [Char]
global [Char]
settings [Char]
description [([Char], [Char])]
extras [Char]
picPath = do
    filePaths <- [Char] -> [([Char], [Char])] -> IO [[Char]]
writeUncachedAndGetPaths [Char]
taskName ([([Char], [Char])] -> IO [[Char]])
-> [([Char], [Char])] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$
          [ ([Char]
"Global", [Char]
global)
          , ([Char]
"TaskSettings", [Char]
settings)
          , ([Char]
"Description", [Char]
description)
          ] [([Char], [Char])] -> [([Char], [Char])] -> [([Char], [Char])]
forall a. [a] -> [a] -> [a]
++ [([Char], [Char])]
extras
    runWithPackageDB $ loadModules filePaths >> descInter
  where
    descInter :: Interpreter (LangM m)
descInter = do
      [[Char]] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [[Char]] -> m ()
setTopLevelModules [[Char]
"Description", [Char]
"Global", [Char]
"TaskSettings"]
      [[Char]] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [[Char]] -> m ()
setImports
        [ [Char]
"Capabilities.Graphviz.IO"
        , [Char]
"Capabilities.Cache.IO"
        , [Char]
"Capabilities.Diagrams.IO"
        , [Char]
"Capabilities.LatexSvg.IO"
        , [Char]
"Capabilities.WriteFile.IO"
        , [Char]
"Control.OutputCapable.Blocks.Generic.Type"
        , [Char]
"Data.Generics.Text"
        , [Char]
"Data.List.Extra"
        , [Char]
"Data.Text"
        ]
      [Char] -> LangM m -> Interpreter (LangM m)
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
[Char] -> a -> m a
interpret ([Char]
"description " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
picPath [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
parens ([Char] -> [Char]
greadError [Char]
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       -- ^ The task identifier used for caching
  -> 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 =>
[Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [([Char], [Char])]
-> [Char]
-> IO (LangM m)
validDescription [Char]
taskName [Char]
taskData [Char]
globalModule [Char]
settingsModule [Char]
descModule [([Char], [Char])]
extras [Char]
picPath = do
  let ([[Char]]
firstHalf,[[Char]]
secondHalf) = Int -> [[Char]] -> ([[Char]], [[Char]])
forall a. Int -> [a] -> ([a], [a])
splitAt ([([Char], [Char])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Char], [Char])]
extras Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ([[Char]] -> ([[Char]], [[Char]]))
-> [[Char]] -> ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd [([Char], [Char])]
extras
  let fileName :: [Char]
fileName = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"-" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"DescriptionCache" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
forall a. Show a => a -> [Char]
hash
        [ [Char]
descModule [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
firstHalf
        , [Char]
taskData [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
secondHalf
        , [Char]
globalModule [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
settingsModule
        ]
  cDir <- [Char] -> IO [Char]
cacheDir [Char]
taskName
  let path = [Char]
cDir [Char] -> [Char] -> [Char]
</> [Char]
fileName
  isThere <- doesFileExist path
  if isThere
    then do
      output <- read <$> readFile path
      let fileLinks = [Output] -> [[Char]]
imageLinks [Output]
output
      exist <- mapM doesFileExist fileLinks
      if and exist
        then
          return $ toOutputCapable output
        else
          makeDescAndWrite (Just output) path
    else
      makeDescAndWrite Nothing path
  where
    makeDescAndWrite :: Maybe [Output] -> [Char] -> IO (LangM m)
makeDescAndWrite Maybe [Output]
mOldOutput [Char]
p = do
      res <- [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [([Char], [Char])]
-> [Char]
-> IO (Either InterpreterError (LangM (ReportT Output IO)))
forall (m :: * -> *).
(OutputCapable m, Typeable m) =>
[Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [([Char], [Char])]
-> [Char]
-> IO (Either InterpreterError (LangM m))
makeDescription [Char]
taskName [Char]
taskData [Char]
globalModule [Char]
settingsModule [Char]
descModule [([Char], [Char])]
extras [Char]
picPath
      output <- getOutputSequence $ extract res
      unless (mOldOutput == Just output) $ writeFile p $ show output
      return $ toOutputCapable 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
  path <- [Char] -> IO [Char]
getEnv [Char]
"FLEX_PKGDB"
  unsafeRunInterpreterWithArgs ["-package-db " <> path] 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   -- ^ The task identifier used for caching
  -> 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 :: [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [([Char], [Char])]
-> [Char]
-> [Char]
-> IO
     (Either
        InterpreterError ([Output], Maybe (Maybe Rational, [Output])))
checkSolution [Char]
taskName [Char]
taskData [Char]
globalCode [Char]
settingsCode [Char]
parseCode [Char]
checkCode [([Char], [Char])]
extraCode [Char]
submission [Char]
picPath = do
    filePaths <- [Char] -> [([Char], [Char])] -> IO [[Char]]
writeUncachedAndGetPaths [Char]
taskName ([([Char], [Char])] -> IO [[Char]])
-> [([Char], [Char])] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$
      [ ([Char]
"Global", [Char]
globalCode)
      , ([Char]
"TaskSettings", [Char]
settingsCode)
      , ([Char]
"Parse", [Char]
parseCode)
      , ([Char]
"Check", [Char]
checkCode)
      ] [([Char], [Char])] -> [([Char], [Char])] -> [([Char], [Char])]
forall a. [a] -> [a] -> [a]
++ [([Char], [Char])]
extraCode
    helperPath <- cacheHelper "EvaluationHelper" ["syntaxAndSemantics"]
    runWithPackageDB (loadModules (helperPath : filePaths) >> runCheck) >>= sequence
  where
    runCheck :: Interpreter (IO ([Output], Maybe (Maybe Rational, [Output])))
runCheck = do
      [[Char]] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [[Char]] -> m ()
setImports
        [ [Char]
"Capabilities.Cache.IO"
        , [Char]
"Capabilities.Diagrams.IO"
        , [Char]
"Capabilities.LatexSvg.IO"
        , [Char]
"Capabilities.Graphviz.IO"
        , [Char]
"Capabilities.WriteFile.IO"
        , [Char]
"Control.OutputCapable.Blocks.Generic.Type"
        , [Char]
"Control.OutputCapable.Blocks"
        , [Char]
"Data.Generics.Text"
        , [Char]
"Data.List.Extra"
        , [Char]
"Data.Ratio"
        , [Char]
"Data.Text"
        ]
      [[Char]] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [[Char]] -> m ()
setTopLevelModules [[Char]
"Check", [Char]
"Global", [Char]
"EvaluationHelper", [Char]
"Parse"]
      [Char]
-> IO ([Output], Maybe (Maybe Rational, [Output]))
-> Interpreter (IO ([Output], Maybe (Maybe Rational, [Output])))
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
[Char] -> a -> m a
interpret ([Char]
"syntaxAndSemantics parseSubmission checkSyntax checkSemantics " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
input [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tData) IO ([Output], Maybe (Maybe Rational, [Output]))
forall a. Typeable a => a
infer

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



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

    writeUncachedFiles :: [(FilePath,String)] -> IO ()
    writeUncachedFiles :: [([Char], [Char])] -> IO ()
writeUncachedFiles = IO [()] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [()] -> IO ())
-> ([([Char], [Char])] -> IO [()]) -> [([Char], [Char])] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], [Char]) -> IO ()) -> [([Char], [Char])] -> 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 (\ ([Char]
path,[Char]
content) ->
      [Char] -> IO Bool
doesFileExist [Char]
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 ([Char] -> [Char] -> IO ()
writeFile [Char]
path [Char]
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 ([Char] -> c
forall a. HasCallStack => [Char] -> a
error ([Char] -> c)
-> (InterpreterError -> [Char]) -> InterpreterError -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterError -> [Char]
prettyError) c -> c
forall a. a -> a
id


hash :: Show a => a -> String
hash :: forall a. Show a => a -> [Char]
hash = Digest SHA256State -> [Char]
forall t. Digest t -> [Char]
showDigest (Digest SHA256State -> [Char])
-> (a -> Digest SHA256State) -> a -> [Char]
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
. [Char] -> Text
pack ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show



cacheDir :: FilePath -> IO FilePath
cacheDir :: [Char] -> IO [Char]
cacheDir [Char]
prefix = do
  temporary <- IO [Char]
getTemporaryDirectory
  let dir = [Char]
temporary [Char] -> [Char] -> [Char]
</> [Char]
"FlexCache" [Char] -> [Char] -> [Char]
</> [Char]
prefix
  createDirectoryIfMissing True dir
  pure dir



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


cacheHelper :: String -> [String] -> IO FilePath
cacheHelper :: [Char] -> [[Char]] -> IO [Char]
cacheHelper [Char]
moduleName [[Char]]
exports = [Char] -> [[Char]] -> [Char]
forall a. a -> [a] -> a
headDef [Char]
forall {a}. a
cachingError ([[Char]] -> [Char]) -> IO [[Char]] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Char] -> [([Char], [Char])] -> IO [[Char]]
writeUncachedAndGetPaths [Char]
"" [([Char]
moduleName,[Char]
helperCode)]
  where
    cachingError :: a
cachingError = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [i|Caching the internal #{moduleName} module failed.|]
    helperCode :: [Char]
helperCode = [i|
module #{moduleName} (#{intercalate "," exports}) where

import FlexTask.Interpreter.#{moduleName}
|]


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


greadError :: String -> String
greadError :: [Char] -> [Char]
greadError [Char]
term = [Char]
"fst $ headDef (error " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
errorMessage [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
") $ gread " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
term [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" :: TaskData"
  where
    errorMessage :: [Char]
errorMessage = [Char]
"Failed reading stored TaskData. Encountered this: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
term