spade-0.1.0.9: app/Main.hs

module Main where

import System.FilePath
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.IO.Class
import Data.Text as T
import Data.Text.IO as T
import Main.Utf8 (withUtf8)
import Paths_spade (version)
import System.Environment
import System.IO as SIO
import qualified System.Terminal as TERM

import Common
import Compiler.Parser
import IDE.IDE
import Interpreter
import Interpreter.Common
import UI.Widgets.Common

data CommandLineOptions
  = StartIDE FilePath
  | RunProgram FilePath
  | DebugInput
  | Version

getCommandLineOption :: IO CommandLineOptions
getCommandLineOption = do
  getArgs >>= \case
    ["version"] -> pure Version
    ["debug"] -> pure DebugInput
    ["run", filePath] -> pure $ RunProgram filePath
    [filePath] -> pure $ StartIDE filePath
    [] -> pure $ StartIDE "untitled.spd"
    _ -> do
      error "Unrecognized cmd line arguments. Pass a file name (existing or new) to load the program in the IDE, or using 'spade run filename.spd' command to just run the program without starting the IDE."

main :: IO ()
main = withUtf8 $ do
  SIO.hSetEcho stdin False
  SIO.hSetBuffering stdin NoBuffering
  SIO.hSetBuffering stdout (BlockBuffering Nothing)

  interpreterDebugInChanRef <- newEmptyTMVarIO
  -- Storing the thred id for the interpreter thread that runs the program
  -- in the IDE seems to be the most simple way to handle ctrl-c termination of the
  -- interpreted program. We catch the signal in the intputForwardingThread below
  -- and just kills the thread id stored in this reference (which will be populated
  -- on starting the interpreter thread, in the IDE)

  let
    inputForwardingThread :: (TerminalEvent -> IO ()) -> IO ()
    inputForwardingThread writeFn = do
      void $ forkIO $ TERM.withTerminal $ TERM.runTerminalT (do
        TERM.Size h w <- TERM.getWindowSize
        liftIO $ mapM_ writeFn [TerminalResize w h]

        forever $ do
          keys' <- readTerminalEvent
          case keys' of
            (TerminalInterrupt : _) ->
              liftIO $ atomically $ do
                (tryReadTMVar interpreterDebugInChanRef) >>= \case
                  Just debugInChan -> writeTBQueue debugInChan StartStep
                  Nothing          -> pass
            _ -> pass
          liftIO $ mapM_ writeFn keys'
        )

  getCommandLineOption >>= \case
    Version -> T.putStrLn $ T.pack $ show version
    DebugInput -> do
      -- print data read from stdin for 10 seconds.
      T.putStrLn "Will print input from stdin for 10 seconds..."
      SIO.hFlush stdout
      threadId <- forkIO $ forever $ do
        ks <- readKey_ stdin
        T.putStrLn "----------"
        T.putStrLn $ T.pack $ show ks
        T.putStrLn $ T.pack $ show $ strToKeyEvent ks
        T.putStrLn "----------"
        SIO.hFlush stdout
      -- wait for 10 sec
      wait 10
      killThread threadId

    RunProgram filePath -> do
      content <- T.readFile filePath
      program <- compile content
      TERM.Size h w <- TERM.withTerminal $ TERM.runTerminalT TERM.getWindowSize
      void $ interpret (\is -> is { isTerminalParams = Just (ScreenPos 0 0, Dimensions w h) }) (Just $ takeDirectory filePath) program

    StartIDE filePath -> do
      inputChan <- liftIO newTChanIO
      inputForwardingThread (atomically . writeTChan inputChan)
      runIDE filePath inputChan interpreterDebugInChanRef