Commit a43bbb90 authored by Andrew Gibiansky's avatar Andrew Gibiansky

Completing reformatting and adding it to test suite

parent 2f060497
......@@ -48,6 +48,7 @@ script:
- travis_retry cabal configure --enable-tests
- travis_retry cabal test --show-details=always
- ./verify_formatting.py
- cabal sdist
# The following scriptlet checks that the resulting source distribution can be built & installed
......
......@@ -2,7 +2,7 @@
module IHaskell.Convert (convert) where
import Control.Monad.Identity (Identity(Identity), unless, when)
import IHaskell.Convert.Args (ConvertSpec(ConvertSpec, convertInput, convertLhsStyle, convertOutput, convertOverwriteFiles, convertToIpynb), fromJustConvertSpec, toConvertSpec)
import IHaskell.Convert.Args (ConvertSpec(..), fromJustConvertSpec, toConvertSpec)
import IHaskell.Convert.IpynbToLhs (ipynbToLhs)
import IHaskell.Convert.LhsToIpynb (lhsToIpynb)
import IHaskell.Flags (Argument)
......
......@@ -50,7 +50,6 @@ isFormatSpec (ConvertToFormat _) = True
isFormatSpec (ConvertFromFormat _) = True
isFormatSpec _ = False
toConvertSpec :: [Argument] -> ConvertSpec Maybe
toConvertSpec args = mergeArgs otherArgs (mergeArgs formatSpecArgs initialConvertSpec)
where
......
......@@ -13,8 +13,7 @@ import qualified Data.Text.Lazy as T (concat, fromStrict, Text, unlines)
import qualified Data.Text.Lazy.IO as T (writeFile)
import Data.Vector (Vector)
import qualified Data.Vector as V (map, mapM, toList)
import IHaskell.Flags (LhsStyle(lhsBeginCode, lhsBeginOutput, lhsCodePrefix, lhsEndCode,
lhsEndOutput, lhsOutputPrefix))
import IHaskell.Flags (LhsStyle(..))
ipynbToLhs :: LhsStyle T.Text
-> FilePath -- ^ the filename of an ipython notebook
......
......@@ -41,7 +41,6 @@ isEmptyMD :: (Eq a, Monoid a) => CellLine a -> Bool
isEmptyMD (MarkdownLine a) = a == mempty
isEmptyMD _ = False
untag :: CellLine t -> t
untag (CodeLine a) = a
untag (OutputLine a) = a
......
......@@ -86,8 +86,6 @@ instance IHaskellDisplay a => IHaskellDisplay [a] where
displays <- mapM display disps
return $ ManyDisplay displays
-- | Encode many displays into a single one. All will be output.
many :: [Display] -> Display
many = ManyDisplay
......
......@@ -60,6 +60,7 @@ data CompletionType = Empty
extName (FlagSpec { flagSpecName = name }) = name
#else
extName (name, _, _) = name
exposedName = id
#endif
complete :: String -> Int -> Interpreter (String, [String])
......@@ -250,13 +251,14 @@ completionTarget code cursor = expandCompletionPiece pieceToComplete
where
pieceToComplete = map fst <$> find (elem cursor . map snd) pieces
pieces = splitAlongCursor $ split splitter $ zip code [1 ..]
splitter = defaultSplitter {
-- Split using only the characters, which are the first elements of
-- the (char, index) tuple
delimiter = Delimiter [uncurry isDelim],
-- Condense multiple delimiters into one and then drop
-- them.
condensePolicy = Condense, delimPolicy = Drop }
splitter = defaultSplitter
{
-- Split using only the characters, which are the first elements of the (char, index) tuple
delimiter = Delimiter [uncurry isDelim]
-- Condense multiple delimiters into one and then drop them.
, condensePolicy = Condense
, delimPolicy = Drop
}
isDelim :: Char -> Int -> Bool
isDelim char idx = char `elem` neverIdent || isSymbol char
......
This diff is collapsed.
......@@ -64,7 +64,7 @@ query str = do
-- | Copied from the HTTP package.
urlEncode :: String -> String
urlEncode [] = []
urlEncode [] = []
urlEncode (ch:t)
| (isAscii ch && isAlphaNum ch) || ch `P.elem` "-_.~" = ch : urlEncode t
| not (isAscii ch) = P.foldr escape (urlEncode t) (eightBs [] (P.fromEnum ch))
......@@ -128,7 +128,6 @@ render HTML = renderHtml
-- | Render a Hoogle result to plain text.
renderPlain :: HoogleResult -> String
renderPlain (NoResult res) =
"No response available: " ++ res
......@@ -220,13 +219,13 @@ renderDocs doc =
let groups = groupBy bothAreCode $ lines doc
nonull = filter (not . null . strip)
bothAreCode s1 s2 =
startswith ">" (strip s1) &&
startswith ">" (strip s2)
startswith ">" (strip s1) &&
startswith ">" (strip s2)
isCode (s:_) = startswith ">" $ strip s
makeBlock lines =
if isCode lines
then div "hoogle-code" $ unlines $ nonull lines
else div "hoogle-text" $ unlines $ nonull lines
if isCode lines
then div "hoogle-code" $ unlines $ nonull lines
else div "hoogle-text" $ unlines $ nonull lines
in div "hoogle-doc" $ unlines $ map makeBlock groups
extractPackageName :: String -> Maybe String
......
......@@ -194,7 +194,6 @@ htmlSuggestions = concatMap toHtml
floating :: String -> String -> String
floating dir thing = [i| <div class="suggestion-row" style="float: ${dir};">${thing}</div> |]
showSuggestion :: String -> String
showSuggestion = remove lintIdent . dropDo
where
......
......@@ -225,7 +225,6 @@ joinFunctions blocks =
conjoin :: [CodeBlock] -> CodeBlock
conjoin = Declaration . intercalate "\n" . map str
-- | Parse a pragma of the form {-# LANGUAGE ... #-}
parsePragma :: String -- ^ Pragma string.
-> Int -- ^ Line number at which the directive appears.
......@@ -245,7 +244,6 @@ parsePragma ('{':'-':'#':pragma) line =
parseDirective :: String -- ^ Directive string.
-> Int -- ^ Line number at which the directive appears.
-> CodeBlock -- ^ Directive code block or a parse error.
parseDirective (':':'!':directive) line = Directive ShellCmd $ '!' : directive
parseDirective (':':directive) line =
case find rightDirective directives of
......@@ -254,9 +252,9 @@ parseDirective (':':directive) line =
_:restLine = words directive
Nothing ->
let directiveStart =
case words directive of
[] -> ""
first:_ -> first
case words directive of
[] -> ""
first:_ -> first
in ParseError (Loc line 1) $ "Unknown directive: '" ++ directiveStart ++ "'."
where
rightDirective (_, dirname) =
......
......@@ -72,12 +72,11 @@ extensionFlag ext =
-- Check if a FlagSpec matches "No<ExtensionName>". In that case, we disable the extension.
flagMatchesNo ext fs = ext == "No" ++ flagSpecName fs
#if !MIN_VERSION_ghc(7,10,0)
flagSpecName (name, _, _) = name
flagSpecFlag (_, flag, _) = flag
#endif
-- | Pretty-print dynamic flags (taken from 'InteractiveUI' module of `ghc-bin`)
pprDynFlags :: Bool -- ^ Whether to include flags which are on by default
-> DynFlags
......@@ -111,17 +110,20 @@ pprDynFlags show_all dflags =
default_dflags = defaultDynFlags (settings dflags)
fstr str = text "-f" <> text str
fnostr str = text "-fno-" <> text str
(ghciFlags, others) = partition (\f -> flagSpecFlag f `elem` flgs) DynFlags.fFlags
flgs = concat [flgs1, flgs2, flgs3]
flgs1 = [Opt_PrintExplicitForalls]
#if MIN_VERSION_ghc(7,8,0)
flgs2 = [Opt_PrintExplicitKinds]
#else
flgs2 = []
#endif
flgs3 = [Opt_PrintBindResult, Opt_BreakOnException, Opt_BreakOnError, Opt_PrintEvldWithShow]
flgs3 = [Opt_PrintBindResult, Opt_BreakOnException, Opt_BreakOnError, Opt_PrintEvldWithShow]
-- | Pretty-print the base language and active options (taken from `InteractiveUI` module of
-- `ghc-bin`)
......@@ -319,7 +321,6 @@ cleanUpDuplicateInstances = modifySession $ \hscEnv ->
#else
instEq _ _ = False
#endif
-- | Get the type of an expression and convert it to a string.
getType :: GhcMonad m => String -> m String
getType expr = do
......
......@@ -44,7 +44,6 @@ data LhsStyle string =
}
deriving (Eq, Functor, Show)
data NotebookFormat = LhsMarkdown
| IpynbFile
deriving (Eq, Show)
......@@ -155,6 +154,7 @@ convert = mode "convert" (Args ConvertLhs []) description unnamedArg convertFlag
lhsStyleBird, lhsStyleTex :: LhsStyle String
lhsStyleBird = LhsStyle "> " "\n<< " "" "" "" ""
lhsStyleTex = LhsStyle "" "" "\\begin{code}" "\\end{code}" "\\begin{verbatim}" "\\end{verbatim}"
ihaskellArgs :: Mode Args
......
......@@ -196,7 +196,6 @@ subHome path = shelly $ do
home <- unpack <$> fromMaybe "~" <$> get_env "HOME"
return $ replace "~" home path
-- | Get the path to an executable. If it doensn't exist, fail with an error message complaining
-- about it.
path :: Text -> Sh FilePath
......
......@@ -41,8 +41,8 @@ import IHaskell.IPython.Kernel
-- | A class for displayable Haskell types.
--
-- IHaskell's displaying of results behaves as if these two
-- overlapping/undecidable instances also existed:
-- IHaskell's displaying of results behaves as if these two overlapping/undecidable instances also
-- existed:
--
-- > instance (Show a) => IHaskellDisplay a
-- > instance Show a where shows _ = id
......@@ -51,12 +51,10 @@ class IHaskellDisplay a where
-- | Display as an interactive widget.
class IHaskellDisplay a => IHaskellWidget a where
-- | Output target name for this widget.
-- The actual input parameter should be ignored.
-- | Output target name for this widget. The actual input parameter should be ignored.
targetName :: a -> String
-- | Called when the comm is opened. Allows additional messages to be sent
-- after comm open.
-- | Called when the comm is opened. Allows additional messages to be sent after comm open.
open :: a -- ^ Widget to open a comm port with.
-> (Value -> IO ()) -- ^ Way to respond to the message.
-> IO ()
......@@ -76,7 +74,7 @@ class IHaskellDisplay a => IHaskellWidget a where
close _ _ = return ()
data Widget = forall a. IHaskellWidget a => Widget a
deriving Typeable
deriving Typeable
instance IHaskellDisplay Widget where
display (Widget widget) = display widget
......@@ -90,20 +88,20 @@ instance IHaskellWidget Widget where
instance Show Widget where
show _ = "<Widget>"
-- | Wrapper for ipython-kernel's DisplayData which allows sending multiple results from the same
-- expression.
data Display = Display [DisplayData]
| ManyDisplay [Display]
deriving (Show, Typeable, Generic)
instance Serialize Display
instance Monoid Display where
mempty = Display []
ManyDisplay a `mappend` ManyDisplay b = ManyDisplay (a ++ b)
ManyDisplay a `mappend` b = ManyDisplay (a ++ [b])
a `mappend` ManyDisplay b = ManyDisplay (a : b)
a `mappend` b = ManyDisplay [a,b]
mempty = Display []
ManyDisplay a `mappend` ManyDisplay b = ManyDisplay (a ++ b)
ManyDisplay a `mappend` b = ManyDisplay (a ++ [b])
a `mappend` ManyDisplay b = ManyDisplay (a : b)
a `mappend` b = ManyDisplay [a, b]
instance Semigroup Display where
a <> b = a `mappend` b
......
......@@ -196,7 +196,6 @@ createReplyHeader parent = do
-- | Compute a reply to a message.
replyTo :: ZeroMQInterface -> Message -> MessageHeader -> KernelState -> Interpreter (KernelState, Message)
-- Reply to kernel info requests with a kernel info reply. No computation needs to be done, as a
-- kernel info reply is a static object (all info is hard coded into the representation of that
-- message type).
......@@ -214,32 +213,29 @@ replyTo interface ShutdownRequest { restartPending = restartPending } replyHeade
writeChan (shellReplyChannel interface) $ ShutdownReply replyHeader restartPending
exitSuccess
-- Reply to an execution request. The reply itself does not require
-- computation, but this causes messages to be sent to the IOPub socket
-- with the output of the code in the execution request.
replyTo interface req@ExecuteRequest{ getCode = code } replyHeader state = do
-- Convenience function to send a message to the IOPub socket.
-- Reply to an execution request. The reply itself does not require computation, but this causes
-- messages to be sent to the IOPub socket with the output of the code in the execution request.
replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
-- Convenience function to send a message to the IOPub socket.
let send msg = liftIO $ writeChan (iopubChannel interface) msg
-- Log things so that we can use stdin.
dir <- liftIO getIHaskellDir
liftIO $ Stdin.recordParentHeader dir $ header req
-- Notify the frontend that the kernel is busy computing.
-- All the headers are copies of the reply header with a different
-- message type, because this preserves the session ID, parent header,
-- and other important information.
-- Notify the frontend that the kernel is busy computing. All the headers are copies of the reply
-- header with a different message type, because this preserves the session ID, parent header, and
-- other important information.
busyHeader <- liftIO $ dupHeader replyHeader StatusMessage
send $ PublishStatus busyHeader Busy
-- Construct a function for publishing output as this is going.
-- This function accepts a boolean indicating whether this is the final
-- output and the thing to display. Store the final outputs in a list so
-- that when we receive an updated non-final output, we can clear the
-- entire output and re-display with the updated output.
displayed <- liftIO $ newMVar []
-- Construct a function for publishing output as this is going. This function accepts a boolean
-- indicating whether this is the final output and the thing to display. Store the final outputs in
-- a list so that when we receive an updated non-final output, we can clear the entire output and
-- re-display with the updated output.
displayed <- liftIO $ newMVar []
updateNeeded <- liftIO $ newMVar False
pagerOutput <- liftIO $ newMVar ""
pagerOutput <- liftIO $ newMVar ""
let clearOutput = do
header <- dupHeader replyHeader ClearOutputMessage
send $ ClearOutput header True
......@@ -253,7 +249,7 @@ replyTo interface req@ExecuteRequest{ getCode = code } replyHeader state = do
convertSvgToHtml x = x
makeSvgImg base64data = unpack $ "<img src=\"data:image/svg+xml;base64," ++ base64data ++ "\"/>"
prependCss (DisplayData MimeHtml html) =
prependCss (DisplayData MimeHtml html) =
DisplayData MimeHtml $concat ["<style>", pack ihaskellCSS, "</style>", html]
prependCss x = x
......@@ -271,9 +267,10 @@ replyTo interface req@ExecuteRequest{ getCode = code } replyHeader state = do
publish :: EvaluationResult -> IO ()
publish result = do
let final = case result of
IntermediateResult {} -> False
FinalResult {} -> True
let final =
case result of
IntermediateResult{} -> False
FinalResult{} -> True
outs = outputs result
-- If necessary, clear all previous output and redraw.
......@@ -286,12 +283,11 @@ replyTo interface req@ExecuteRequest{ getCode = code } replyHeader state = do
-- Draw this message.
sendOutput outs
-- If this is the final message, add it to the list of completed
-- messages. If it isn't, make sure we clear it later by marking
-- update needed as true.
-- If this is the final message, add it to the list of completed messages. If it isn't, make sure we
-- clear it later by marking update needed as true.
modifyMVar_ updateNeeded (const $ return $ not final)
when final $ do
modifyMVar_ displayed (return . (outs:))
modifyMVar_ displayed (return . (outs :))
-- Start all comms that need to be started.
mapM_ startComm $ startComms result
......@@ -300,8 +296,8 @@ replyTo interface req@ExecuteRequest{ getCode = code } replyHeader state = do
let pager = pagerOut result
unless (null pager) $
if usePager state
then modifyMVar_ pagerOutput (return . (++ pager ++ "\n"))
else sendOutput $ Display [html pager]
then modifyMVar_ pagerOutput (return . (++ pager ++ "\n"))
else sendOutput $ Display [html pager]
let execCount = getExecutionCounter state
-- Let all frontends know the execution count and code that's about to run
......@@ -317,14 +313,15 @@ replyTo interface req@ExecuteRequest{ getCode = code } replyHeader state = do
-- Take pager output if we're using the pager.
pager <- if usePager state
then liftIO $ readMVar pagerOutput
else return ""
return (updatedState, ExecuteReply {
header = replyHeader,
pagerOutput = pager,
executionCounter = execCount,
status = Ok
})
then liftIO $ readMVar pagerOutput
else return ""
return
(updatedState, ExecuteReply
{ header = replyHeader
, pagerOutput = pager
, executionCounter = execCount
, status = Ok
})
replyTo _ req@CompleteRequest{} replyHeader state = do
......@@ -352,11 +349,11 @@ replyTo _ ObjectInfoRequest { objectName = oname } replyHeader state = do
-- TODO: Implement history_reply.
replyTo _ HistoryRequest{} replyHeader state = do
let reply = HistoryReply {
header = replyHeader,
-- FIXME
historyReply = []
}
let reply = HistoryReply
{ header = replyHeader
-- FIXME
, historyReply = []
}
return (state, reply)
handleComm :: (Message -> IO ()) -> KernelState -> Message -> MessageHeader -> IO KernelState
......
......@@ -14,6 +14,11 @@ def hindent(contents):
def diff(src1, src2):
# Ignore trailing newlines
if src1[-1] == "\n":
src1 = src1[:-1]
if src2[-1] == "\n":
src2 = src2[:-1]
with open(".tmp1", "w") as f1:
f1.write(src1)
......@@ -40,8 +45,6 @@ for root, dirnames, filenames in os.walk("src"):
for filename in filenames:
if filename.endswith(".hs"):
sources.append(os.path.join(root, filename))
break
break
hindent_outputs = {}
......
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