hyper-haskell-server 0.1.0.2 → 0.2.1.0
raw patch · 2 files changed
+70/−19 lines, 2 filesdep +haskell-src-extsdep ~basedep ~exceptionsdep ~hint
Dependencies added: haskell-src-exts
Dependency ranges changed: base, exceptions, hint
Files
- Main.hs +63/−14
- hyper-haskell-server.cabal +7/−5
Main.hs view
@@ -11,6 +11,8 @@ import Control.Monad import Control.Monad.Catch import Control.Exception (AsyncException(UserInterrupt), evaluate)+import Data.List (groupBy)+import Data.Maybe (catMaybes) import Data.Typeable import Text.Read (readMaybe) import System.Environment as System@@ -19,12 +21,15 @@ import Language.Haskell.Interpreter hiding (eval, setImports) import qualified Language.Haskell.Interpreter as Hint +-- Haskell language parsing+import qualified Language.Haskell.Exts as Haskell+ -- web import Data.Aeson (toJSON, (.=)) import qualified Data.Aeson as JSON import qualified Data.ByteString.Char8 as B-import Data.Text (Text)-import Data.String (fromString)+import Data.Text as T (Text, concat)+import Data.String (fromString) import Web.Scotty -- Interpreter@@ -64,6 +69,8 @@ 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 "/loadFiles" $@@ -89,22 +96,64 @@ {----------------------------------------------------------------------------- Exported interpreter functions ------------------------------------------------------------------------------}-setImports :: Hint -> [String] -> IO (Result ())-loadFiles :: Hint -> [FilePath] -> IO (Result ())-eval :: Hint -> String -> IO (Result Graphic)+setImports :: Hint -> [String] -> IO (Result ())+setExtensions :: Hint -> [String] -> IO (Result ())+loadFiles :: Hint -> [FilePath] -> IO (Result ())+eval :: Hint -> String -> IO (Result Graphic) -- NOTE: We implicitely load the Prelude and Hyper modules-setImports hint = run hint . Hint.setImports- . (++ ["Prelude", "Hyper"]) . filter (not . null)+setImports hint = run hint . Hint.setImports+ . (++ ["Prelude", "Hyper"]) . filter (not . null)+setExtensions hint xs = run hint $ Hint.set [Hint.languageExtensions Hint.:= ys]+ where+ readExtension :: String -> Extension+ readExtension x = case readMaybe x of+ Nothing -> error $ "Unknown language extension: " ++ x+ Just x -> x+ ys = map readExtension $ filter (not . null) xs -loadFiles hint = run hint . Hint.loadModules . filter (not . null)+loadFiles hint = run hint . Hint.loadModules . filter (not . null) -eval hint expr = run hint $ do- -- NOTE: We wrap results into an implicit call to Hyper.display- m <- Hint.interpret ("Hyper.displayIO " ++ Hint.parens expr) (as :: IO Graphic)- liftIO $ do- g <- m- evaluate (force g) -- See NOTE [EvaluateToNF]+-- | Evalute an input cell.+eval hint input = run hint $ do+ extensions <- Hint.get Hint.languageExtensions+ mgs <- forM (parseStmts extensions input) $ \(code, stmt) -> case stmt of+ Just (Haskell.Qualifier _ _) -> do+ -- NOTE: If it's a simple expression,+ -- we wrap results into an implicit call to Hyper.display+ m <- Hint.interpret ("Hyper.displayIO " ++ Hint.parens code) (as :: IO Graphic)+ liftIO $ do+ g <- m+ x <- evaluate (force g) -- See NOTE [EvaluateToNF]+ return $ Just x+ _ -> do+ -- In all other cases, we simply pass the code on to GHC+ Hint.runStmt code+ return Nothing+ return . combineGraphics $ catMaybes mgs++combineGraphics :: [Graphic] -> Graphic+combineGraphics xs = Graphic { gHtml = T.concat $ map gHtml xs }++-- | Statements that we can evaluate.+type Stmt = Haskell.Stmt Haskell.SrcSpanInfo++-- | Parse an input cell into a list of statements to evaluate.+parseStmts :: [Hint.Extension] -> String -> [(String, Maybe Stmt)]+parseStmts extensions =+ map parseStmt . map unlines . groupByIndent . stripIndent . lines+ where+ indent xs = if null xs then 0 else length . takeWhile (== ' ') $ head xs + stripIndent xs = map (drop $ indent xs) xs+ groupByIndent = groupBy (\x y -> indent [y] > 0)++ parseStmt s = (s, case Haskell.parseStmtWithMode mode s of+ Haskell.ParseOk x -> Just x+ _ -> Nothing)++ exts = map (Haskell.parseExtension . show) extensions+ mode = Haskell.defaultParseMode { Haskell.extensions = exts }+ {- NOTE [EvaluateToNF]
hyper-haskell-server.cabal view
@@ -1,16 +1,17 @@ Name: hyper-haskell-server-Version: 0.1.0.2+Version: 0.2.1.0 Synopsis: Server back-end for the HyperHaskell graphical Haskell interpreter Description: This package is part of the /HyperHaskell/ project and provides the server back-end. . Category: Compilers/Interpreters+Homepage: https://github.com/HeinrichApfelmus/hyper-haskell License: BSD3 License-file: LICENSE Author: Heinrich Apfelmus Maintainer: Heinrich Apfelmus <apfelmus quantentunnel de>-Copyright: (c) Heinrich Apfelmus 2016-2017+Copyright: (c) Heinrich Apfelmus 2016-2018 Cabal-version: >= 1.8 Build-type: Simple@@ -21,12 +22,13 @@ subdir: haskell/hyper-haskell-server/ Executable hyper-haskell-server- build-depends: base >= 4.6 && < 4.11+ build-depends: base >= 4.6 && < 4.13 , aeson (>= 0.7 && < 0.10) || == 0.11.* || (>= 1.0 && < 1.3) , bytestring >= 0.9 && < 0.11 , deepseq >= 1.2 && < 1.5- , exceptions >= 0.6 && < 0.9- , hint >= 0.4 && < 0.8+ , exceptions >= 0.6 && < 0.11+ , haskell-src-exts >= 1.17 && < 1.21+ , hint >= 0.8 && < 0.9 , hyper == 0.1.* , text >= 0.11 && < 1.3 , transformers >= 0.3 && < 0.6