<commit_before>-- | This module defines the School of Haskell client's behavior.  It
-- handles updating the state based on responses from the backend, and
module Model where

import           Communication
import           Control.Exception (catch, throwIO, SomeException)
import qualified Data.ByteString.Lazy as BL
import           Data.Function (on)
import           Data.List (partition)
import qualified Data.List as L
import qualified Data.Text as T
import           Data.Text.Encoding (encodeUtf8, decodeUtf8)
import qualified Data.Vector as V
import           Import
import           PosMap (emptyPosMap)
import           React.Internal (appState)
import           SchoolOfHaskell.Scheduler.API (ContainerReceipt)
import           TermJs (writeTerminal)

-- | Given the number of snippets on the page, this creates the
-- initial state and App.  It needs to know the number of snippets in
-- order to initialize the Ace components.
getApp :: Int -> IO App
getApp cnt = do
  snippets <- V.replicateM cnt $ do
    editor <- getDefUnmanaged
    return Snippet
      { _snippetEditor = editor
      , _snippetPosMap = emptyPosMap
      , _snippetTypeInfo = Nothing
      }
  termjs <- getDefUnmanaged
  web <- getDefUnmanaged
  let state = State
        { _stateSnippets = snippets
        , _stateConsole = termjs
        , _stateWeb = web
        , _stateStatus = InitialStatus
        , _stateRunning = NotRunning
        , _stateTab = BuildTab
        , _stateDocs = Nothing
        , _stateBackend = Nothing
        }
  makeApp state id

-- | Runs the SoH client application.
runApp :: Text -> ContainerReceipt -> App -> IO void
runApp url receipt app = withUrl url receipt $ \backend -> do
  setTVarIO (appState app) stateBackend (Just backend)
  version <- expectWelcome backend
  putStrLn $ "Connection established with ide-backend " ++ show version
  let state = appState app
  br <- waitForTVarIO state (^? (stateStatus . _BuildRequested))
  mainLoop backend state br `catch` \ex -> do
    consoleErrorText $
      "Exited mainLoop with exception " <> tshow (ex :: SomeException)
    throwIO ex

-- | This is the main loop.  It takes the current 'BuildRequest',
-- compiles the code, runs it, and then waits for queries or further
-- build requests.  These build requests re-enter this 'mainLoop'
-- function.  As is implied by its @IO void@ return type, it never
-- returns.
mainLoop :: Backend -> TVar State -> BuildRequest -> IO void
mainLoop backend state br = do
  success <- buildSuccess <$> compileCode backend state br
  when success $ runConsole backend state
  --FIXME: Kill the running process
  br' <- runQueries backend state
  mainLoop backend state br'

-- | Whether there are no errors in a 'BuildInfo'.
buildSuccess :: BuildInfo -> Bool
buildSuccess bi = null (buildErrors bi) && null (buildServerDieds bi)

-- | Compiles a set of files and retrieves the resulting error
-- / warning messages.
compileCode :: Backend -> TVar State -> BuildRequest -> IO BuildInfo
compileCode backend state (BuildRequest sid files) = do
  --TODO: clear ide-backend state before the rest of the updates.
  let requestUpdate (fp, txt) = RequestUpdateSourceFile fp $
        BL.fromStrict (encodeUtf8 txt)
  -- Show the build's progress and wait for it to finish.
  updateSession backend
    (map requestUpdate files)
    (setTVarIO state stateStatus . Building sid)
  -- Retrieve the errors
  sourceErrors <- getAnnSourceErrors backend
  let partitionKind k = partition ((==k) . annErrorKind)<commit_msg>Set PORT environment variable for user code<commit_after>-- | This module defines the School of Haskell client's behavior.  It
-- handles updating the state based on responses from the backend, and
module Model where

import           Communication
import           Control.Exception (catch, throwIO, SomeException)
import qualified Data.ByteString.Lazy as BL
import           Data.Function (on)
import           Data.List (partition)
import qualified Data.List as L
import qualified Data.Text as T
import           Data.Text.Encoding (encodeUtf8, decodeUtf8)
import qualified Data.Vector as V
import           Import
import           PosMap (emptyPosMap)
import           React.Internal (appState)
import           SchoolOfHaskell.Scheduler.API (ContainerReceipt)
import           TermJs (writeTerminal)

-- | Given the number of snippets on the page, this creates the
-- initial state and App.  It needs to know the number of snippets in
-- order to initialize the Ace components.
getApp :: Int -> IO App
getApp cnt = do
  snippets <- V.replicateM cnt $ do
    editor <- getDefUnmanaged
    return Snippet
      { _snippetEditor = editor
      , _snippetPosMap = emptyPosMap
      , _snippetTypeInfo = Nothing
      }
  termjs <- getDefUnmanaged
  web <- getDefUnmanaged
  let state = State
        { _stateSnippets = snippets
        , _stateConsole = termjs
        , _stateWeb = web
        , _stateStatus = InitialStatus
        , _stateRunning = NotRunning
        , _stateTab = BuildTab
        , _stateDocs = Nothing
        , _stateBackend = Nothing
        }
  makeApp state id

-- | Runs the SoH client application.
runApp :: Text -> ContainerReceipt -> App -> IO void
runApp url receipt app = withUrl url receipt $ \backend -> do
  setTVarIO (appState app) stateBackend (Just backend)
  version <- expectWelcome backend
  putStrLn $ "Connection established with ide-backend " ++ show version
  let state = appState app
      -- TODO: Other env variables from old SoH?  APPROOT,
      -- FP_ENVIRONMENT_NAME, FP_ENVIRONMENT_TYPE, IMAGE_DIR, and etc
      initialUpdates = [RequestUpdateEnv [("PORT", Just "3000")]]
  br <- waitForTVarIO state (^? (stateStatus . _BuildRequested))
  mainLoop backend state br initialUpdates `catch` \ex -> do
    consoleErrorText $
      "Exited mainLoop with exception " <> tshow (ex :: SomeException)
    throwIO ex

-- | This is the main loop.  It takes the current 'BuildRequest',
-- compiles the code, runs it, and then waits for queries or further
-- build requests.  These build requests re-enter this 'mainLoop'
-- function.  As is implied by its @IO void@ return type, it never
-- returns.
mainLoop
  :: Backend
  -> TVar State
  -> BuildRequest
  -> [RequestSessionUpdate]
  -> IO void
mainLoop backend state br extraUpdates = do
  success <- buildSuccess <$> compileCode backend state br extraUpdates
  when success $ runConsole backend state
  --FIXME: Kill the running process
  br' <- runQueries backend state
  mainLoop backend state br' []

-- | Whether there are no errors in a 'BuildInfo'.
buildSuccess :: BuildInfo -> Bool
buildSuccess bi = null (buildErrors bi) && null (buildServerDieds bi)

-- | Compiles a set of files and retrieves the resulting error
-- / warning messages.
compileCode
  :: Backend
  -> TVar State
  -> BuildRequest
  -> [RequestSessionUpdate]
  -> IO BuildInfo
compileCode backend state (BuildRequest sid files) extraUpdates = do
  --TODO: clear ide-backend state before the rest of the updates.
  let requestUpdate (fp, txt) = RequestUpdateSourceFile fp $
        BL.fromStrict (encodeUtf8 txt)
  -- Show the build's progress and wait for it to finish.
  updateSession backend
    (extraUpdates ++ map requestUpdate files)
    (setTVarIO state stateStatus . Building sid)
  -- Retrieve the errors
  sourceErrors <- getAnnSourceErrors backend
  let partitionKind k = partition ((==k) . annErrorKind)
{'fraction_non_alphanumeric': 0.07565522831667117, 'fraction_numerical': 0.0013509862199405566, 'mean_word_length': 3.0453551912568306, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 35, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4359542', 'n_tokens_mistral': 2054, 'n_tokens_neox': 2003, 'n_words': 810}