module Main where 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) }) program StartIDE filePath -> do inputChan <- liftIO newTChanIO inputForwardingThread (atomically . writeTChan inputChan) runIDE filePath inputChan interpreterDebugInChanRef