diff --git a/.gitignore b/.gitignore index 395b29dc79..9058bdc494 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,6 @@ dist-newstyle .stack-work -hie.yaml +/hie.yaml cabal.project.local *~ *.lock @@ -19,8 +19,5 @@ shake.yaml.lock stack*.yaml.lock shake.yaml.lock -# ignore hie.yaml's for testdata -test/**/*.yaml - # metadata files on macOS .DS_Store diff --git a/README.md b/README.md index ec5aff50b3..bcaa7b8531 100644 --- a/README.md +++ b/README.md @@ -15,6 +15,7 @@ background](https://neilmitchell.blogspot.com/2020/01/one-haskell-ide-to-rule-th This is *very* early stage software. - [Haskell Language Server (HLS)](#haskell-language-server) + - [Features](#features) - [Installation](#installation) - [Installation from source](#installation-from-source) - [Common pre-requirements](#common-pre-requirements) @@ -43,6 +44,14 @@ This is *very* early stage software. - [Contributing](#contributing) - [It's time to join the project!](#its-time-to-join-the-project) +## Features + + - Code evaluation (inspired by [Dante](https://github.com/jyp/dante#-reploid)) + + ![Eval](https://i.imgur.com/bh992sT.gif) + + - Many more (TBD) + ## Installation For now only installation from source is supported. @@ -490,7 +499,7 @@ args = ["--lsp"] ## Known limitations ### Preprocessor -HLS is not yet able to find project preprocessors, which may result in `could not execute: ` errors. This problem is +HLS is not yet able to find project preprocessors, which may result in `could not execute: ` errors. This problem is tracked in https://github.com/haskell/haskell-language-server/issues/176 and originally comes from https://github.com/mpickering/hie-bios/issues/125 As a workaround, you need to ensure the preprocessor is available in the path (install globally with Stack or Cabal, provide in `shell.nix`, etc.). diff --git a/exe/Main.hs b/exe/Main.hs index a6bbbfb93f..0e4d299900 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -97,6 +97,7 @@ import Development.IDE.Plugin.Completions as Completions import Development.IDE.LSP.HoverDefinition as HoverDefinition -- haskell-language-server plugins +import Ide.Plugin.Eval as Eval import Ide.Plugin.Example as Example import Ide.Plugin.Example2 as Example2 import Ide.Plugin.GhcIde as GhcIde @@ -143,6 +144,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins #if AGPL , Brittany.descriptor "brittany" #endif + , Eval.descriptor "eval" ] examplePlugins = [Example.descriptor "eg" diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index a74e4a92c0..d4095fa735 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -42,6 +42,7 @@ library Ide.Logger Ide.Plugin Ide.Plugin.Config + Ide.Plugin.Eval Ide.Plugin.Example Ide.Plugin.Example2 Ide.Plugin.GhcIde @@ -85,7 +86,9 @@ library , regex-tdfa >= 1.3.1.0 , shake >= 0.17.5 , stylish-haskell == 0.11.* + , temporary , text + , time , transformers , unordered-containers if os(windows) @@ -271,6 +274,7 @@ test-suite func-test , Deferred , Definition , Diagnostic + , Eval , Format , FunctionalBadProject , FunctionalCodeAction diff --git a/src/Ide/Plugin/Eval.hs b/src/Ide/Plugin/Eval.hs new file mode 100644 index 0000000000..9b452ece61 --- /dev/null +++ b/src/Ide/Plugin/Eval.hs @@ -0,0 +1,338 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} + +-- | A plugin inspired by the REPLoid feature of Dante[1] which allows +-- to evaluate code in comment prompts and splice the results right below: +-- +-- > example :: [String] +-- > example = ["This is an example", "of", "interactive", "evaluation"] +-- > +-- > -- >>> intercalate " " example +-- > -- "This is an example of interactive evaluation" +-- > -- +-- +-- [1] - https://github.com/jyp/dante +module Ide.Plugin.Eval where + +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT, + throwE) +import Data.Aeson (FromJSON, ToJSON, Value (Null), + toJSON) +import Data.Bifunctor (Bifunctor (first)) +import qualified Data.HashMap.Strict as Map +import Data.String (IsString (fromString)) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (getCurrentTime) +import Development.IDE.Core.Rules (runAction) +import Development.IDE.Core.RuleTypes (GetModSummary (..), + GhcSession (..)) +import Development.IDE.Core.Shake (use_) +import Development.IDE.GHC.Util (evalGhcEnv, hscEnv, + textToStringBuffer) +import Development.IDE.Types.Location (toNormalizedFilePath', + uriToFilePath') +import DynamicLoading (initializePlugins) +import DynFlags (targetPlatform) +import GHC (DynFlags, ExecResult (..), GeneralFlag (Opt_IgnoreHpcChanges, Opt_IgnoreOptimChanges, Opt_ImplicitImportQualified), + GhcLink (LinkInMemory), + GhcMode (CompManager), + HscTarget (HscInterpreted), + LoadHowMuch (LoadAllTargets), + SuccessFlag (..), + execLineNumber, execOptions, + execSourceFile, execStmt, + getContext, + getInteractiveDynFlags, + getSession, getSessionDynFlags, + ghcLink, ghcMode, hscTarget, + isImport, isStmt, load, + moduleName, packageFlags, + parseImportDecl, pkgDatabase, + pkgState, runDecls, setContext, + setInteractiveDynFlags, + setLogAction, + setSessionDynFlags, setTargets, + simpleImportDecl, ways) +import GHC.Generics (Generic) +import GhcMonad (modifySession) +import GhcPlugins (defaultLogActionHPutStrDoc, + gopt_set, gopt_unset, + interpWays, updateWays, + wayGeneralFlags, + wayUnsetGeneralFlags) +import HscTypes +import Ide.Plugin +import Ide.Types +import Language.Haskell.LSP.Core (LspFuncs (getVirtualFileFunc)) +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.VFS (virtualFileText) +import PrelNames (pRELUDE) +import System.FilePath +import System.IO (hClose) +import System.IO.Temp +import Data.Maybe (catMaybes) + +descriptor :: PluginId -> PluginDescriptor +descriptor plId = + (defaultPluginDescriptor plId) + { pluginId = plId, + pluginCodeLensProvider = Just provider, + pluginCommands = [evalCommand] + } + +extractMatches :: Maybe Text -> [([(Text, Int)], Range)] +extractMatches = goSearch 0 . maybe [] T.lines + where + checkMatch = T.stripPrefix "-- >>> " + looksLikeSplice l + | Just l' <- T.stripPrefix "--" l = + not (" >>>" `T.isPrefixOf` l') + | otherwise = + False + + goSearch _ [] = [] + goSearch line (l : ll) + | Just match <- checkMatch l = + goAcc (line + 1) [(match, line)] ll + | otherwise = + goSearch (line + 1) ll + + goAcc line acc [] = [(reverse acc, Range p p)] where p = Position line 0 + goAcc line acc (l : ll) + | Just match <- checkMatch l = + goAcc (line + 1) ([(match, line)] <> acc) ll + | otherwise = + (reverse acc, r) : goSearch (line + 1) ll + where + r = Range p p' + p = Position line 0 + p' = Position (line + spliceLength) 0 + spliceLength = length (takeWhile looksLikeSplice (l : ll)) + +provider :: CodeLensProvider +provider lsp _state plId CodeLensParams {_textDocument} = response $ do + let TextDocumentIdentifier uri = _textDocument + contents <- liftIO $ getVirtualFileFunc lsp $ toNormalizedUri uri + let text = virtualFileText <$> contents + let matches = extractMatches text + + cmd <- liftIO $ mkLspCommand plId evalCommandName "Evaluate..." (Just []) + + let lenses = + [ CodeLens range (Just cmd') Nothing + | (m, r) <- matches, + let (_, startLine) = head m + (endLineContents, endLine) = last m + range = Range start end + start = Position startLine 0 + end = Position endLine (T.length endLineContents) + args = EvalParams m r _textDocument, + let cmd' = + (cmd :: Command) + { _arguments = Just (List [toJSON args]), + _title = if trivial r then "Evaluate..." else "Refresh..." + } + ] + + return $ List lenses + where + trivial (Range p p') = p == p' + +evalCommandName :: CommandId +evalCommandName = "evalCommand" + +evalCommand :: PluginCommand +evalCommand = + PluginCommand evalCommandName "evaluate" runEvalCmd + +data EvalParams = EvalParams + { statements :: [(Text, Int)], + editTarget :: !Range, + module_ :: !TextDocumentIdentifier + } + deriving (Eq, Show, Generic, FromJSON, ToJSON) + +runEvalCmd :: CommandFunction EvalParams +runEvalCmd lsp state EvalParams {..} = response' $ do + let TextDocumentIdentifier {_uri} = module_ + fp <- handleMaybe "uri" $ uriToFilePath' _uri + contents <- liftIO $ getVirtualFileFunc lsp $ toNormalizedUri _uri + text <- handleMaybe "contents" $ virtualFileText <$> contents + +{- Note: GhcSessionDeps + +Depending on GhcSession means we do need to reload all the module +dependencies in the GHC session(from interface files, hopefully). + +The GhcSessionDeps dependency would allow us to reuse a GHC session preloaded +with all the dependencies. Unfortunately, the ModSummary objects that +GhcSessionDeps puts in the GHC session are not suitable for reuse since they +clear out the timestamps; this is done to avoid internal ghcide bugs and +can probably be relaxed so that plugins like Eval can reuse them. Once that's +done, we want to switch back to GhcSessionDeps: + +-- https://github.com/digital-asset/ghcide/pull/694 + + -} + session <- + liftIO $ + runAction "runEvalCmd.ghcSession" state $ + use_ GhcSession $ -- See the note on GhcSessionDeps + toNormalizedFilePath' $ + fp + + ms <- + liftIO $ + runAction "runEvalCmd.getModSummary" state $ + use_ GetModSummary $ + toNormalizedFilePath' $ + fp + + now <- liftIO getCurrentTime + + let tmp = withSystemTempFile (takeFileName fp) + + tmp $ \temp _h -> tmp $ \tempLog hLog -> do + liftIO $ hClose _h + let modName = moduleName $ ms_mod ms + thisModuleTarget = Target (TargetFile fp Nothing) False (Just (textToStringBuffer text, now)) + + hscEnv' <- ExceptT $ + evalGhcEnv (hscEnv session) $ do + df <- getSessionDynFlags + env <- getSession + df <- liftIO $ setupDynFlagsForGHCiLike env df + _lp <- setSessionDynFlags df + + -- copy the package state to the interactive DynFlags + idflags <- getInteractiveDynFlags + df <- getSessionDynFlags + setInteractiveDynFlags + idflags + { pkgState = pkgState df, + pkgDatabase = pkgDatabase df, + packageFlags = packageFlags df + } + + -- set up a custom log action + setLogAction $ \_df _wr _sev _span _style _doc -> + defaultLogActionHPutStrDoc _df hLog _doc _style + + -- load the module in the interactive environment + setTargets [thisModuleTarget] + loadResult <- load LoadAllTargets + case loadResult of + Failed -> liftIO $ do + hClose hLog + Left <$> readFile tempLog + Succeeded -> do + setContext [IIDecl (simpleImportDecl $ moduleName pRELUDE), IIModule modName] + Right <$> getSession + + df <- liftIO $ evalGhcEnv hscEnv' getSessionDynFlags + let eval (stmt, l) + | isStmt df stmt = do + -- set up a custom interactive print function + liftIO $ writeFile temp "" + ctxt <- getContext + setContext [IIDecl (simpleImportDecl $ moduleName pRELUDE)] + let printFun = "let ghcideCustomShow x = Prelude.writeFile " <> show temp <> " (Prelude.show x)" + interactivePrint <- + execStmt printFun execOptions >>= \case + ExecComplete (Right [interactivePrint]) _ -> pure interactivePrint + _ -> error "internal error binding print function" + modifySession $ \hsc -> hsc {hsc_IC = setInteractivePrintName (hsc_IC hsc) interactivePrint} + setContext ctxt + + let opts = + execOptions + { execSourceFile = fp, + execLineNumber = l + } + res <- execStmt stmt opts + case res of + ExecComplete (Left err) _ -> return $ Just $ T.pack $ pad $ show err + ExecComplete (Right _) _ -> do + out <- liftIO $ pad <$> readFile temp + -- Important to take the length in order to read the file eagerly + return $! if length out == 0 then Nothing else Just (T.pack out) + ExecBreak {} -> return $ Just $ T.pack $ pad "breakpoints are not supported" + + | isImport df stmt = do + ctxt <- getContext + idecl <- parseImportDecl stmt + setContext $ IIDecl idecl : ctxt + return Nothing + | otherwise = do + void $ runDecls stmt + return Nothing + + edits <- liftIO $ evalGhcEnv hscEnv' $ traverse (eval . first T.unpack) statements + + + let workspaceEditsMap = Map.fromList [(_uri, List [evalEdit])] + workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing + evalEdit = TextEdit editTarget (T.intercalate "\n" $ catMaybes edits) + + return (WorkspaceApplyEdit, ApplyWorkspaceEditParams workspaceEdits) + +pad :: String -> String +pad = unlines . map ("-- " <>) . lines + +------------------------------------------------------------------------------- + +handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b +handleMaybe msg = maybe (throwE msg) return + +handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b +handleMaybeM msg act = maybe (throwE msg) return =<< lift act + +response :: ExceptT String IO a -> IO (Either ResponseError a) +response = + fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing)) + . runExceptT + +response' :: ExceptT String IO a -> IO (Either ResponseError Value, Maybe a) +response' act = do + res <- runExceptT act + case res of + Left e -> + return (Left (ResponseError InternalError (fromString e) Nothing), Nothing) + Right a -> return (Right Null, Just a) + +setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags +setupDynFlagsForGHCiLike env dflags = do + let dflags3 = + dflags + { hscTarget = HscInterpreted, + ghcMode = CompManager, + ghcLink = LinkInMemory + } + platform = targetPlatform dflags3 + dflags3a = updateWays $ dflags3 {ways = interpWays} + dflags3b = + foldl gopt_set dflags3a $ + concatMap + (wayGeneralFlags platform) + interpWays + dflags3c = + foldl gopt_unset dflags3b $ + concatMap + (wayUnsetGeneralFlags platform) + interpWays + dflags4 = + dflags3c `gopt_set` Opt_ImplicitImportQualified + `gopt_set` Opt_IgnoreOptimChanges + `gopt_set` Opt_IgnoreHpcChanges + initializePlugins env dflags4 diff --git a/test/functional/Eval.hs b/test/functional/Eval.hs new file mode 100644 index 0000000000..4f4cc91691 --- /dev/null +++ b/test/functional/Eval.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Eval (tests) where + +import Control.Applicative.Combinators (skipManyTill) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import qualified Data.Text.IO as T +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types (ApplyWorkspaceEditRequest, + CodeLens (CodeLens, _command, _range), + Command (_title), + Position (..), Range (..)) +import System.FilePath +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = + testGroup + "eval" + [ testCase "Produces Evaluate code lenses" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T1.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map (fmap _title . _command) lenses @?= [Just "Evaluate..."], + testCase "Produces Refresh code lenses" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T2.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map (fmap _title . _command) lenses @?= [Just "Refresh..."], + testCase "Code lenses have ranges" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T1.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)], + testCase "Multi-line expressions have a multi-line range" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T3.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map _range lenses @?= [Range (Position 3 0) (Position 4 15)], + testCase "Executed expressions range covers only the expression" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T2.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)], + testCase "Evaluation of expressions" $ goldenTest "T1.hs", + testCase "Reevaluation of expressions" $ goldenTest "T2.hs", + testCase "Evaluation of expressions w/ imports" $ goldenTest "T3.hs", + testCase "Evaluation of expressions w/ lets" $ goldenTest "T4.hs", + testCase "Refresh an evaluation" $ goldenTest "T5.hs", + testCase "Refresh an evaluation w/ lets" $ goldenTest "T6.hs", + testCase "Refresh a multiline evaluation" $ goldenTest "T7.hs" + ] + +goldenTest :: FilePath -> IO () +goldenTest input = runSession hieCommand fullCaps evalPath $ do + doc <- openDoc input "haskell" + [CodeLens {_command = Just c}] <- getCodeLenses doc + executeCommand c + _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message + edited <- documentContents doc + expected <- liftIO $ T.readFile $ evalPath input <.> "expected" + liftIO $ edited @?= expected + +evalPath :: FilePath +evalPath = "test/testdata/eval" diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 7bffaf33d3..328a0e502f 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -10,6 +10,7 @@ import Completion import Deferred import Definition import Diagnostic +import Eval import Format import FunctionalBadProject import FunctionalCodeAction @@ -36,6 +37,7 @@ main = , Deferred.tests , Definition.tests , Diagnostic.tests + , Eval.tests , Format.tests , FunctionalBadProject.tests , FunctionalCodeAction.tests @@ -47,4 +49,4 @@ main = , Rename.tests , Symbol.tests , TypeDefinition.tests - ] \ No newline at end of file + ] diff --git a/test/testdata/eval/T1.hs b/test/testdata/eval/T1.hs new file mode 100644 index 0000000000..485cbf3748 --- /dev/null +++ b/test/testdata/eval/T1.hs @@ -0,0 +1,7 @@ +module T1 where + +import Data.List (unwords) + +-- >>> unwords example +example :: [String] +example = ["This","is","an","example","of","evaluation"] diff --git a/test/testdata/eval/T1.hs.expected b/test/testdata/eval/T1.hs.expected new file mode 100644 index 0000000000..622b9c1f85 --- /dev/null +++ b/test/testdata/eval/T1.hs.expected @@ -0,0 +1,8 @@ +module T1 where + +import Data.List (unwords) + +-- >>> unwords example +-- "This is an example of evaluation" +example :: [String] +example = ["This","is","an","example","of","evaluation"] diff --git a/test/testdata/eval/T2.hs b/test/testdata/eval/T2.hs new file mode 100644 index 0000000000..82e37b8b5a --- /dev/null +++ b/test/testdata/eval/T2.hs @@ -0,0 +1,8 @@ +module T2 where + +import Data.List (unwords) + +-- >>> unwords example +-- "Stale output" +example :: [String] +example = ["This","is","an","example","of","evaluation"] diff --git a/test/testdata/eval/T2.hs.expected b/test/testdata/eval/T2.hs.expected new file mode 100644 index 0000000000..48b3a52baf --- /dev/null +++ b/test/testdata/eval/T2.hs.expected @@ -0,0 +1,8 @@ +module T2 where + +import Data.List (unwords) + +-- >>> unwords example +-- "This is an example of evaluation" +example :: [String] +example = ["This","is","an","example","of","evaluation"] diff --git a/test/testdata/eval/T3.hs b/test/testdata/eval/T3.hs new file mode 100644 index 0000000000..82e87a040b --- /dev/null +++ b/test/testdata/eval/T3.hs @@ -0,0 +1,7 @@ +module T3 where + + +-- >>> import Data.List (unwords) +-- >>> unwords example +example :: [String] +example = ["This","is","an","example","of","evaluation"] diff --git a/test/testdata/eval/T3.hs.expected b/test/testdata/eval/T3.hs.expected new file mode 100644 index 0000000000..50fb1a7bfd --- /dev/null +++ b/test/testdata/eval/T3.hs.expected @@ -0,0 +1,8 @@ +module T3 where + + +-- >>> import Data.List (unwords) +-- >>> unwords example +-- "This is an example of evaluation" +example :: [String] +example = ["This","is","an","example","of","evaluation"] diff --git a/test/testdata/eval/T4.hs b/test/testdata/eval/T4.hs new file mode 100644 index 0000000000..72c88ed1d4 --- /dev/null +++ b/test/testdata/eval/T4.hs @@ -0,0 +1,8 @@ +module T4 where + +import Data.List (unwords) + +-- >>> let evaluation = " evaluation" +-- >>> unwords example ++ evaluation +example :: [String] +example = ["This","is","an","example","of"] diff --git a/test/testdata/eval/T4.hs.expected b/test/testdata/eval/T4.hs.expected new file mode 100644 index 0000000000..4b56dbf392 --- /dev/null +++ b/test/testdata/eval/T4.hs.expected @@ -0,0 +1,9 @@ +module T4 where + +import Data.List (unwords) + +-- >>> let evaluation = " evaluation" +-- >>> unwords example ++ evaluation +-- "This is an example of evaluation" +example :: [String] +example = ["This","is","an","example","of"] diff --git a/test/testdata/eval/T5.hs b/test/testdata/eval/T5.hs new file mode 100644 index 0000000000..18887a91e1 --- /dev/null +++ b/test/testdata/eval/T5.hs @@ -0,0 +1,6 @@ +module T5 where + +-- >>> unwords example +-- "This is a stale example of evaluation" +example :: [String] +example = ["This","is","an","example","of","evaluation"] diff --git a/test/testdata/eval/T5.hs.expected b/test/testdata/eval/T5.hs.expected new file mode 100644 index 0000000000..4fe595e671 --- /dev/null +++ b/test/testdata/eval/T5.hs.expected @@ -0,0 +1,6 @@ +module T5 where + +-- >>> unwords example +-- "This is an example of evaluation" +example :: [String] +example = ["This","is","an","example","of","evaluation"] diff --git a/test/testdata/eval/T6.hs b/test/testdata/eval/T6.hs new file mode 100644 index 0000000000..e67aa21c13 --- /dev/null +++ b/test/testdata/eval/T6.hs @@ -0,0 +1,9 @@ +module T6 where + +import Data.List (unwords) + +-- >>> let evaluation = " evaluation" +-- >>> unwords example ++ evaluation +-- "This is a stale example of evaluation" +example :: [String] +example = ["This","is","an","example","of"] diff --git a/test/testdata/eval/T6.hs.expected b/test/testdata/eval/T6.hs.expected new file mode 100644 index 0000000000..9eb9c57cf1 --- /dev/null +++ b/test/testdata/eval/T6.hs.expected @@ -0,0 +1,9 @@ +module T6 where + +import Data.List (unwords) + +-- >>> let evaluation = " evaluation" +-- >>> unwords example ++ evaluation +-- "This is an example of evaluation" +example :: [String] +example = ["This","is","an","example","of"] diff --git a/test/testdata/eval/T7.hs b/test/testdata/eval/T7.hs new file mode 100644 index 0000000000..c74ac7de63 --- /dev/null +++ b/test/testdata/eval/T7.hs @@ -0,0 +1,10 @@ +module T7 where + +import Data.List (unwords) + +-- >>> -- +-- >>> -- +-- >>> unwords example +-- "This is a stale example of" +example :: [String] +example = ["This","is","an","example","of"] diff --git a/test/testdata/eval/T7.hs.expected b/test/testdata/eval/T7.hs.expected new file mode 100644 index 0000000000..739c3db041 --- /dev/null +++ b/test/testdata/eval/T7.hs.expected @@ -0,0 +1,10 @@ +module T7 where + +import Data.List (unwords) + +-- >>> -- +-- >>> -- +-- >>> unwords example +-- "This is an example of" +example :: [String] +example = ["This","is","an","example","of"] diff --git a/test/testdata/eval/hie.yaml b/test/testdata/eval/hie.yaml new file mode 100644 index 0000000000..a2e9ed5148 --- /dev/null +++ b/test/testdata/eval/hie.yaml @@ -0,0 +1 @@ +cradle: {direct: {arguments: ["T1", "T2", "T3", "T4"]}} diff --git a/test/testdata/eval/test.cabal b/test/testdata/eval/test.cabal new file mode 100644 index 0000000000..fbc943a651 --- /dev/null +++ b/test/testdata/eval/test.cabal @@ -0,0 +1,17 @@ +name: test +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD3 +author: Author name here +maintainer: example@example.com +copyright: 2017 Author name here +category: Web +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: T1, T2, T3, T4 + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + ghc-options: -Wall -fwarn-unused-imports