Commit 692860f6 authored by Andrew Gibiansky's avatar Andrew Gibiansky

haddocks?

parent 70c4e806
...@@ -75,6 +75,3 @@ executable IHaskell ...@@ -75,6 +75,3 @@ executable IHaskell
knob ==0.1.*, knob ==0.1.*,
directory ==1.2.*, directory ==1.2.*,
deepseq ==1.3.* deepseq ==1.3.*
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | This module exports all functions used for evaluation of IHaskell input. -- | This module exports all functions used for evaluation of IHaskell input.
module IHaskell.Eval.Evaluate ( module IHaskell.Eval.Evaluate (
interpret, evaluate, Interpreter, liftIO interpret, evaluate, Interpreter, liftIO
...@@ -15,7 +17,6 @@ import Language.Haskell.Exts.Syntax hiding (Name) ...@@ -15,7 +17,6 @@ import Language.Haskell.Exts.Syntax hiding (Name)
import InteractiveEval import InteractiveEval
import HscTypes import HscTypes
import Name
import GhcMonad (liftIO) import GhcMonad (liftIO)
import GHC hiding (Stmt) import GHC hiding (Stmt)
import GHC.Paths import GHC.Paths
...@@ -32,6 +33,7 @@ type Interpreter = Ghc ...@@ -32,6 +33,7 @@ type Interpreter = Ghc
data Command data Command
= Directive String = Directive String
| Import String | Import String
| Declaration String
| Statement String | Statement String
| ParseError LineNumber ColumnNumber String | ParseError LineNumber ColumnNumber String
deriving Show deriving Show
...@@ -47,6 +49,8 @@ globalImports = ...@@ -47,6 +49,8 @@ globalImports =
directiveChar :: Char directiveChar :: Char
directiveChar = ':' directiveChar = ':'
-- | Run an interpreting action. This is effectively runGhc with
-- initialization and importing.
interpret :: Interpreter a -> IO a interpret :: Interpreter a -> IO a
interpret action = runGhc (Just libdir) $ do interpret action = runGhc (Just libdir) $ do
-- Set the dynamic session flags -- Set the dynamic session flags
...@@ -81,13 +85,26 @@ parseCommands :: String -- ^ Code containing commands. ...@@ -81,13 +85,26 @@ parseCommands :: String -- ^ Code containing commands.
-> [Command] -- ^ Commands contained in code string. -> [Command] -- ^ Commands contained in code string.
parseCommands code = concatMap makeCommands pieces parseCommands code = concatMap makeCommands pieces
where where
pieces = groupBy ((==) `on` isDirective) $ lines code -- Group the text into different pieces.
-- Pieces can be declarations, statement lists, or directives.
-- We distinguish declarations from statements via the first line an
-- indentation, and directives based on the first character.
samePiece x y = not (isDirective x || isDirective y) && indentLevel x <= indentLevel y
indentLevel (' ':str) = 1 + indentLevel str
indentLevel _ = 0 :: Int
pieces = groupBy samePiece $ lines code
makeCommands lines makeCommands lines
| any isDirective lines = map createDirective lines | any isDirective lines = map createDirective lines
| any isDeclaration lines =
case parseDecl $ unlines lines of
ParseOk declaration -> [Declaration $ prettyPrint declaration]
ParseFailed srcLoc errMsg -> [ParseError (srcLine srcLoc) (srcColumn srcLoc) errMsg]
| otherwise = | otherwise =
case parseStmts $ unlines lines of case parseStmts $ trace (show $ unlines lines) $ unlines lines of
Left (srcLine, srcColumn, errMsg) -> [ParseError srcLine srcColumn errMsg] Left (srcLine, srcColumn, errMsg) -> [ParseError srcLine srcColumn errMsg]
Right stmts -> map (Statement . prettyPrint) $ init stmts Right stmts -> map (Statement . prettyPrint) $ init stmts
isDeclaration line = any (`isInfixOf` line) ["type", "newtype", "data"]
isDirective line = startswith [directiveChar] stripped || startswith "import" stripped isDirective line = startswith [directiveChar] stripped || startswith "import" stripped
where stripped = strip line where stripped = strip line
createDirective line = createDirective line =
...@@ -113,7 +130,7 @@ evalCommand (Statement stmt) = do ...@@ -113,7 +130,7 @@ evalCommand (Statement stmt) = do
(printed, result) <- capturedStatement stmt (printed, result) <- capturedStatement stmt
case result of case result of
RunOk names -> --concat <$> mapM showName names RunOk _ ->
return [Display PlainText printed] return [Display PlainText printed]
RunException exception -> do RunException exception -> do
write $ "RunException: " ++ show exception write $ "RunException: " ++ show exception
...@@ -126,8 +143,17 @@ evalCommand (Statement stmt) = do ...@@ -126,8 +143,17 @@ evalCommand (Statement stmt) = do
write $ concat ["Break: ", show exception, "\nfrom statement:\n", stmt] write $ concat ["Break: ", show exception, "\nfrom statement:\n", stmt]
return [Display MimeHtml $ makeError $ show exception] return [Display MimeHtml $ makeError $ show exception]
evalCommand (Declaration decl) = do
write $ "Declaration: " ++ decl
ghandle handler $ runDecls decl >> return []
where
handler :: SomeException -> Interpreter [DisplayData]
handler exception = do
write $ concat ["Break: ", show exception, "\nfrom declaration:\n", decl]
return [Display MimeHtml $ makeError $ show exception]
evalCommand (ParseError line col err) = evalCommand (ParseError line col err) =
return [Display MimeHtml $ makeError $ printf "error Error (line %d, column %d): %s" line col err] return [Display MimeHtml $ makeError $ printf "Error (line %d, column %d): %s" line col err]
capturedStatement :: String -> Interpreter (String, RunResult) capturedStatement :: String -> Interpreter (String, RunResult)
capturedStatement stmt = capturedStatement stmt =
...@@ -155,10 +181,6 @@ capturedStatement stmt = ...@@ -155,10 +181,6 @@ capturedStatement stmt =
return (printedOutput, result) return (printedOutput, result)
showName :: Name -> Interpreter [DisplayData]
showName _ =
return [Display PlainText "Hello!"]
parseStmts :: String -> Either (LineNumber, ColumnNumber, String) [Stmt] parseStmts :: String -> Either (LineNumber, ColumnNumber, String) [Stmt]
parseStmts code = parseStmts code =
case parseResult of case parseResult of
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | This module is responsible for converting from low-level ByteStrings -- | This module is responsible for converting from low-level ByteStrings
-- | obtained from the 0MQ sockets into Messages. The only exposed function is -- | obtained from the 0MQ sockets into Messages. The only exposed function is
-- | `parseMessage`, which should only be used in the low-level 0MQ interface. -- | `parseMessage`, which should only be used in the low-level 0MQ interface.
......
...@@ -22,8 +22,9 @@ data UUID = UUID String deriving Eq ...@@ -22,8 +22,9 @@ data UUID = UUID String deriving Eq
instance Show UUID where instance Show UUID where
show (UUID s) = s show (UUID s) = s
-- | Generate an infinite list of random UUIDs. -- | Generate a list of random UUIDs.
randoms :: Int -> IO [UUID] randoms :: Int -- ^ Number of UUIDs to generate.
-> IO [UUID]
randoms n = replicateM n random randoms n = replicateM n random
-- | Generate a single random UUID. -- | Generate a single random UUID.
......
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module IHaskell.Types ( module IHaskell.Types (
Profile (..), Profile (..),
Message (..), Message (..),
...@@ -139,7 +141,7 @@ data Message ...@@ -139,7 +141,7 @@ data Message
getUserExpressions :: [ByteString] -- ^ Unused. getUserExpressions :: [ByteString] -- ^ Unused.
} }
-- | A reply to an execute request. -- | A reply to an execute request.
| ExecuteReply { | ExecuteReply {
header :: MessageHeader, header :: MessageHeader,
status :: ExecuteReplyStatus, -- ^ The status of the output. status :: ExecuteReplyStatus, -- ^ The status of the output.
......
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
import ClassyPrelude hiding (liftIO) import ClassyPrelude hiding (liftIO)
import Control.Concurrent.Chan import Control.Concurrent.Chan
import Data.Aeson import Data.Aeson
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment