<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           Control.Exception (catch, throwIO, SomeException)
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)
import qualified Data.Vector as V
import           Import
import           JavaScript.Ace (getCharPosition, end)
import           JavaScript.IFrame (setIFrameUrl)
import           JavaScript.TermJs (writeTerminal)
import           Model.Protocol
import           Model.Server (lookupPort)
import           View.PosMap (emptyPosMap, spanToRange)
import           React.Internal (appState)
import           SchoolOfHaskell.Runner.API (webServerPort)
import           SchoolOfHaskell.Scheduler.API (ContainerReceipt, PortMappings)

-- | 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
  docs <- getDefUnmanaged
  let state = State
        { _stateSnippets = snippets
        , _stateConsole = termjs
        , _stateWeb = web
        , _stateDocs = docs
        , _stateStatus = InitialStatus
        , _stateRunning = NotRunning
        , _stateTab = BuildTab
        , _stateBackend = Nothing
        }
  makeApp state id

-- | Runs the SoH client application.
runApp :: Text -> PortMappings -> ContainerReceipt -> App -> IO void
runApp host ports receipt app = withUrl host ports 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 (show webServerPort))]]
  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
  (sid, bi) <- compileCode backend state br extraUpdates
  -- Kill the running process, if there is one.
  killProcess backend state sid bi
  when (buildSuccess bi) $ runConsole backend state
  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 (SnippetId, 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 $
        ByteString64 (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 <- getSourceErrors backend
  let partitionKind k = partition ((==k) . errorKind)
  let (errors, partitionKind KindWarning -> (warnings, serverDieds)) =
        partitionKind KindError sourceErrors
      buildInfo = BuildInfo
        { buildErrors = errors
        , buildWarnings = warnings
        , buildServerDieds = serverDieds
        }
  setTVarIO state stateStatus $ Built sid buildInfo<commit_msg>Switch to errors tab when the build errors<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           Control.Exception (catch, throwIO, SomeException)
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)
import qualified Data.Vector as V
import           Import
import           JavaScript.Ace (getCharPosition, end)
import           JavaScript.IFrame (setIFrameUrl)
import           JavaScript.TermJs (writeTerminal)
import           Model.Protocol
import           Model.Server (lookupPort)
import           View.PosMap (emptyPosMap, spanToRange)
import           React.Internal (appState)
import           SchoolOfHaskell.Runner.API (webServerPort)
import           SchoolOfHaskell.Scheduler.API (ContainerReceipt, PortMappings)

-- | 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
  docs <- getDefUnmanaged
  let state = State
        { _stateSnippets = snippets
        , _stateConsole = termjs
        , _stateWeb = web
        , _stateDocs = docs
        , _stateStatus = InitialStatus
        , _stateRunning = NotRunning
        , _stateTab = BuildTab
        , _stateBackend = Nothing
        }
  makeApp state id

-- | Runs the SoH client application.
runApp :: Text -> PortMappings -> ContainerReceipt -> App -> IO void
runApp host ports receipt app = withUrl host ports 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 (show webServerPort))]]
  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
  (sid, bi) <- compileCode backend state br extraUpdates
  -- Kill the running process, if there is one.
  killProcess backend state sid bi
  when (buildSuccess bi) $ runConsole backend state
  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 (SnippetId, 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 $
        ByteString64 (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 <- getSourceErrors backend
  let partitionKind k = partition ((==k) . errorKind)
  let (errors, partitionKind KindWarning -> (warnings, serverDieds)) =
        partitionKind KindError sourceErrors
      buildInfo = BuildInfo
        { buildErrors = errors
        , buildWarnings = warnings
        , buildServerDieds = serverDieds
        }
  setTVarIO state stateStatus $ Built sid buildInfo
  when (not (buildSuccess buildInfo)) $ switchTab state BuildTab
{'fraction_non_alphanumeric': 0.0756404593639576, 'fraction_numerical': 0.0008833922261484099, 'mean_word_length': 3.0325022261798753, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 39, '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': '3707836', 'n_tokens_mistral': 2517, 'n_tokens_neox': 2460, 'n_words': 939}