hyper-haskell-server 0.2.3.0 → 0.2.3.1
raw patch · 2 files changed
+81/−35 lines, 2 filesdep ~aesondep ~basedep ~bytestring
Dependency ranges changed: aeson, base, bytestring, deepseq, filepath, scotty, text, transformers
Files
- Main.hs +60/−25
- hyper-haskell-server.cabal +21/−10
Main.hs view
@@ -10,13 +10,26 @@ import Control.DeepSeq import Control.Monad import Control.Monad.Catch-import Control.Exception (AsyncException(UserInterrupt), evaluate)+ ( SomeException+ , catch+ , displayException+ , fromException+ )+import Control.Exception+ ( AsyncException(UserInterrupt)+ , evaluate+ ) import Data.List (groupBy) import Data.Maybe (catMaybes) import Data.Typeable import Text.Read (readMaybe)++-- System environment and Inter-Process-Communication (IPC)+import Foreign.C.Types ( CInt )+import GHC.IO.Handle.FD ( fdToHandle ) import System.Environment as System import System.FilePath.Posix as System+import System.IO as System -- Haskell interpreter import Language.Haskell.Interpreter hiding (eval, setImports)@@ -31,7 +44,7 @@ import qualified Data.ByteString.Char8 as B import Data.Text as T (Text, concat, pack) import Data.String (fromString)-import Web.Scotty+import qualified Web.Scotty as Web -- Interpreter import Hyper.Internal as Hyper@@ -46,13 +59,31 @@ main :: IO () main = do+ -- get port number from environment env <- System.getEnvironment let port = maybe defaultPort id $ readMaybe =<< Prelude.lookup "PORT" env - (hint, interpreterLoop) <- newInterpreter- forkIO $ scotty port (jsonAPI hint)- interpreterLoop -- See NOTE [MainThread]+ -- get file descriptor (pipe) from the first argument+ args <- System.getArgs+ let writeReady = case args of+ (x:_) -> maybe (return ()) writeReadyMsgToFD $ readMaybe x+ _ -> return () + -- Start interpreter and web server. See NOTE [MainThread]+ (hint, interpreterLoop) <- newInterpreter writeReady+ forkIO $ Web.scotty port (jsonAPI hint)+ interpreterLoop++-- | Write the message "ready" to the specified file descriptor (pipe).+writeReadyMsgToFD :: CInt -> IO ()+writeReadyMsgToFD fd0 = do+ handle <- GHC.IO.Handle.FD.fdToHandle (fromIntegral fd0)+ System.hSetBinaryMode handle False+ System.hSetEncoding handle System.utf8+ System.hSetBuffering handle LineBuffering+ System.hPutStr handle "ready"++ {- NOTE [MainThread] We fork the web server and run GHC in the main thread.@@ -65,29 +96,31 @@ {----------------------------------------------------------------------------- Exported JSON REST API ------------------------------------------------------------------------------}-jsonAPI :: Hint -> ScottyM ()+jsonAPI :: Hint -> Web.ScottyM () jsonAPI hint = do- post "/cancel" $ do+ Web.post "/cancel" $ do liftIO $ cancel hint- json $ JSON.object [ "status" .= t "ok" ]- post "/setExtensions" $- json . result =<< liftIO . setExtensions hint =<< param "query"- post "/setImports" $- json . result =<< liftIO . setImports hint =<< param "query"- post "/setSearchPath" $ do- x <- param "query"- y <- param "dir"- json . result =<< (liftIO $ setSearchPath hint x y)- post "/loadFiles" $- json . result =<< liftIO . loadFiles hint =<< param "query"- post "/eval" $ do- json . result =<< liftIO . eval hint =<< param "query"+ Web.json $ JSON.object [ "status" .= t "ok" ]+ Web.post "/setExtensions" $+ Web.json . result =<< liftIO . setExtensions hint =<< Web.param "query"+ Web.post "/setImports" $+ Web.json . result =<< liftIO . setImports hint =<< Web.param "query"+ Web.post "/setSearchPath" $ do+ x <- Web.param "query"+ y <- Web.param "dir"+ Web.json . result =<< (liftIO $ setSearchPath hint x y)+ Web.post "/loadFiles" $+ Web.json . result =<< liftIO . loadFiles hint =<< Web.param "query"+ Web.post "/eval" $ do+ Web.json . result =<< liftIO . eval hint =<< Web.param "query" -t s = fromString s :: Text+t :: String -> Text+t s = fromString s +-- | Convert an interpreter result to JSON. result :: JSON.ToJSON a => Result a -> JSON.Value result (Left e) = JSON.object [ "status" .= t "error", "errors" .= err e]- where+ where err e = toJSON $ case e of UnknownError s -> [t s] WontCompile xs -> map (t . errMsg) xs@@ -269,8 +302,10 @@ debug s = liftIO $ putStrLn s -- | Create and initialize a Haskell interpreter.-newInterpreter :: IO (Hint, IO ()) -- ^ (send commands, interpreter loop)-newInterpreter = do+-- Arguments:+-- writeReady = function to call when the interpreter is ready to evaluate expressions.+newInterpreter :: IO () -> IO (Hint, IO ()) -- ^ (send commands, interpreter loop)+newInterpreter writeReady = do vin <- newEmptyMVar evalThreadId <- newEmptyMVar -- ThreadID of the thread responsible for evaluation @@ -307,6 +342,6 @@ putMVar evalThreadId =<< myThreadId -- NOTE: The failure branch of `catch` will `mask` asynchronous exceptions. let go = forever $ handler `catch` (\UserInterrupt -> return ())- void $ runInterpreter go+ void $ runInterpreter $ liftIO writeReady >> go return (Hint run cancel, interpreterLoop)
hyper-haskell-server.cabal view
@@ -1,5 +1,5 @@ Name: hyper-haskell-server-Version: 0.2.3.0+Version: 0.2.3.1 Synopsis: Server back-end for the HyperHaskell graphical Haskell interpreter Description: This package is part of the /HyperHaskell/ project and provides@@ -11,10 +11,21 @@ License-file: LICENSE Author: Heinrich Apfelmus Maintainer: Heinrich Apfelmus <apfelmus quantentunnel de>-Copyright: (c) Heinrich Apfelmus 2016-2020+Copyright: (c) Heinrich Apfelmus 2016-2024 Cabal-version: >= 1.10 Build-type: Simple+Tested-With: + GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.2.8+ , GHC == 9.4.7+ , GHC == 9.6.4+ , GHC == 9.8.1 Source-repository head type: git@@ -22,18 +33,18 @@ subdir: haskell/hyper-haskell-server/ Executable hyper-haskell-server- build-depends: base >= 4.6 && < 4.15- , aeson (>= 0.7 && < 0.10) || == 0.11.* || (>= 1.0 && < 1.6)- , bytestring >= 0.9 && < 0.12- , deepseq >= 1.2 && < 1.5+ build-depends: base >= 4.6 && < 4.20+ , aeson (>= 0.7 && < 0.10) || == 0.11.* || (>= 1.0 && < 2.3)+ , bytestring >= 0.9 && < 0.13+ , deepseq >= 1.2 && < 1.6 , exceptions >= 0.6 && < 0.11- , filepath >= 1.0 && < 1.5+ , filepath >= 1.0 && < 1.6 , haskell-src-exts >= 1.17 && < 1.24 , hint >= 0.8 && < 0.10 , hyper == 0.2.*- , text >= 0.11 && < 1.3- , transformers >= 0.3 && < 0.6- , scotty >= 0.6 && < 0.13+ , text >= 0.11 && < 2.2+ , transformers >= 0.3 && < 0.7+ , scotty >= 0.6 && < 0.22 ghc-options: -threaded cpp-Options: -DCABAL main-is: Main.hs