hyper-haskell-server 0.2.1.0 → 0.2.3.0
raw patch · 2 files changed
+112/−35 lines, 2 filesdep +filepathdep ~aesondep ~basedep ~bytestring
Dependencies added: filepath
Dependency ranges changed: aeson, base, bytestring, haskell-src-exts, hint, hyper, scotty
Files
- Main.hs +100/−25
- hyper-haskell-server.cabal +12/−10
Main.hs view
@@ -15,7 +15,8 @@ import Data.Maybe (catMaybes) import Data.Typeable import Text.Read (readMaybe)-import System.Environment as System+import System.Environment as System+import System.FilePath.Posix as System -- Haskell interpreter import Language.Haskell.Interpreter hiding (eval, setImports)@@ -28,12 +29,12 @@ import Data.Aeson (toJSON, (.=)) import qualified Data.Aeson as JSON import qualified Data.ByteString.Char8 as B-import Data.Text as T (Text, concat)+import Data.Text as T (Text, concat, pack) import Data.String (fromString) import Web.Scotty -- Interpreter-import Hyper.Internal+import Hyper.Internal as Hyper say = putStrLn @@ -73,6 +74,10 @@ 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@@ -96,14 +101,13 @@ {----------------------------------------------------------------------------- Exported interpreter functions ------------------------------------------------------------------------------}-setImports :: Hint -> [String] -> IO (Result ()) setExtensions :: Hint -> [String] -> IO (Result ())+setImports :: Hint -> [String] -> IO (Result ())+setSearchPath :: Hint -> String -> FilePath -> 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)+-- | Set Haskell language extensions used in the current interpreter session. setExtensions hint xs = run hint $ Hint.set [Hint.languageExtensions Hint.:= ys] where readExtension :: String -> Extension@@ -112,44 +116,88 @@ Just x -> x ys = map readExtension $ filter (not . null) xs -loadFiles hint = run hint . Hint.loadModules . filter (not . null) --- | Evalute an input cell.+-- | Set module imports used in the current interpreter session.+-- NOTE: We implicitly always load the Prelude and Hyper modules+setImports hint = run hint . Hint.setImportsF+ . (++ map simpleImport ["Prelude", "Hyper"])+ . map (parseImport . words)+ . filter (not . null)++moduleImport m q = Hint.ModuleImport m q NoImportList++simpleImport :: String -> Hint.ModuleImport+simpleImport m = moduleImport m NotQualified++parseImport :: [String] -> Hint.ModuleImport+parseImport (x:xs) = if x == "import" then parse xs else parse (x:xs)+ where+ parse ("qualified":m:"as":alias:[]) = moduleImport m (QualifiedAs $ Just alias)+ parse ("qualified":m:[]) = moduleImport m (QualifiedAs Nothing)+ parse (m:"as":alias:[]) = moduleImport m (ImportAs alias)+ parse (m:[]) = moduleImport m NotQualified+++-- | Set search path for loading `.hs` source files+setSearchPath hint xs dir = run hint $ Hint.set [Hint.searchPath Hint.:= paths]+ where paths = [if isRelative x then dir </> x else x | x <- splitSearchPath xs]++-- | Load `.hs` source files.+loadFiles hint xs = run hint $ do+ -- liftIO . print =<< Hint.get Hint.searchPath+ Main.finalizeSession -- finalize the old session+ Hint.loadModules $ filter (not . null) xs++-- | Evaluate 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)+ mgs <- forM (parsePrompts extensions input) $ \prompt -> case prompt of+ Expr code -> do+ -- To show the result of an 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+ Other code -> do+ -- Otherwise, there is nothing to show and we pass the code on to GHC Hint.runStmt code return Nothing+ TypeOf code -> do+ -- Query type information+ let pre s = "<pre>" ++ code ++ " :: "++ s ++ "</pre>"+ Just . Hyper.html . T.pack . pre <$> Hint.typeOf code+ Unknown code -> do+ return . Just . string $ "Unknown interpreter command :" ++ code 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+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+data Prompt = Expr String | TypeOf String | Other String | Unknown String++-- | Parse an input cell into a list of prompts to evaluate+parsePrompts :: [Hint.Extension] -> String -> [Prompt]+parsePrompts extensions =+ map parsePrompt . 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)+ parsePrompt code@(':':command) = case words command of+ ("type":xs) -> TypeOf $ unwords xs+ (x:_) -> Unknown x+ [] -> Unknown "(empty)"+ parsePrompt code =+ case Haskell.parseStmtWithMode mode code :: Haskell.ParseResult Stmt of+ Haskell.ParseOk (Haskell.Qualifier _ _) -> Expr code+ _ -> Other code exts = map (Haskell.parseExtension . show) extensions mode = Haskell.defaultParseMode { Haskell.extensions = exts }@@ -167,7 +215,34 @@ -} {------------------------------------------------------------------------------ Interpreter Backend+ Internal interpreter functions+------------------------------------------------------------------------------}+-- | +finalizeSession :: Interpreter ()+finalizeSession = do+ Main.setImportsInternal+ Hint.runStmt ("Hyper.Internal.finalizeSession")++-- | Clear imports and import only the "Hyper.Internal" module qualified.+setImportsInternal :: Interpreter ()+setImportsInternal = do+ let name = "Hyper.Internal"+ Hint.setImportsF [Hint.ModuleImport name (QualifiedAs $ Just name) NoImportList]++{-+-- | Run an interpreter action with only the "Hyper.Internal" module loaded.+withInternal :: Interpreter a -> Interpreter a+withInternal m = do+ xs <- Hint.getLoadedModules+ let name = "Hyper.Internal"+ Hint.setImportsQ [Hint.ModuleImport name (QualifiedAs $ Just name) NoImportList]+ a <- m+ Hint.setImportsQ xs+ return a+-}++{-----------------------------------------------------------------------------+ Interpreter Thread ------------------------------------------------------------------------------} type Result a = Either InterpreterError a
hyper-haskell-server.cabal view
@@ -1,5 +1,5 @@ Name: hyper-haskell-server-Version: 0.2.1.0+Version: 0.2.3.0 Synopsis: Server back-end for the HyperHaskell graphical Haskell interpreter Description: This package is part of the /HyperHaskell/ project and provides@@ -11,9 +11,9 @@ License-file: LICENSE Author: Heinrich Apfelmus Maintainer: Heinrich Apfelmus <apfelmus quantentunnel de>-Copyright: (c) Heinrich Apfelmus 2016-2018+Copyright: (c) Heinrich Apfelmus 2016-2020 -Cabal-version: >= 1.8+Cabal-version: >= 1.10 Build-type: Simple Source-repository head@@ -22,17 +22,19 @@ subdir: haskell/hyper-haskell-server/ Executable hyper-haskell-server- build-depends: base >= 4.6 && < 4.13- , aeson (>= 0.7 && < 0.10) || == 0.11.* || (>= 1.0 && < 1.3)- , bytestring >= 0.9 && < 0.11+ 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 , exceptions >= 0.6 && < 0.11- , haskell-src-exts >= 1.17 && < 1.21- , hint >= 0.8 && < 0.9- , hyper == 0.1.*+ , filepath >= 1.0 && < 1.5+ , 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.12+ , scotty >= 0.6 && < 0.13 ghc-options: -threaded cpp-Options: -DCABAL main-is: Main.hs+ default-language: Haskell2010