summaryrefslogtreecommitdiff
path: root/tests/TestPsci.hs
blob: f758acb21b1d4512efbc3d2dbef7a5a176a54604 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

module TestPsci where

import Prelude ()
import Prelude.Compat

import Control.Monad.Trans.State.Strict (evalStateT)
import Control.Monad (when)

import Data.List (sort)
import qualified Data.Text as T

import System.Exit (exitFailure)
import System.Console.Haskeline
import System.FilePath ((</>))
import System.Directory (getCurrentDirectory)
import qualified System.FilePath.Glob as Glob

import Test.HUnit

import qualified Language.PureScript as P

import Language.PureScript.Interactive.Module (loadAllModules)
import Language.PureScript.Interactive.Completion
import Language.PureScript.Interactive.Types

import TestUtils (supportModules)

main :: IO ()
main = do
  Counts{..} <- runTestTT allTests
  when (errors + failures > 0) exitFailure

allTests :: Test
allTests = completionTests

completionTests :: Test
completionTests =
  TestLabel "completionTests"
    (TestList (map (TestCase . assertCompletedOk) completionTestData))

-- If the cursor is at the right end of the line, with the 1st element of the
-- pair as the text in the line, then pressing tab should offer all the
-- elements of the list (which is the 2nd element) as completions.
completionTestData :: [(String, [String])]
completionTestData =
  -- basic directives
  [ (":h",  [":help"])
  , (":re", [":reset"])
  , (":q",  [":quit"])
  , (":b",  [":browse"])

  -- :browse should complete module names
  , (":b Control.Monad.E",    map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
  , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])

  -- import should complete module names
  , ("import Control.Monad.E",    map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
  , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])

  -- :quit, :help, :reset should not complete
  , (":help ", [])
  , (":quit ", [])
  , (":reset ", [])

  -- :show should complete to "loaded" and "import"
  , (":show ", [":show import", ":show loaded"])
  , (":show a", [])

  -- :type should complete values and data constructors in scope
  , (":type Control.Monad.Eff.Console.lo", [":type Control.Monad.Eff.Console.log", ":type Control.Monad.Eff.Console.logShow"])
  --, (":type uni", [":type unit"])
  --, (":type E", [":type EQ"])

  -- :kind should complete types in scope
  --, (":kind C", [":kind Control.Monad.Eff.Pure"])
  --, (":kind O", [":kind Ordering"])

  -- Only one argument for directives should be completed
  , (":show import ", [])
  , (":type EQ ", [])
  , (":kind Ordering ", [])

  -- a few other import tests
  , ("impor", ["import"])
  , ("import ", map ("import " ++) supportModules)
  , ("import Prelude ", [])

  -- String and number literals should not be completed
  , ("\"hi", [])
  , ("34", [])

  -- Identifiers and data constructors should be completed
  --, ("uni", ["unit"])
  , ("Control.Monad.Eff.Class.", ["Control.Monad.Eff.Class.liftEff"])
  --, ("G", ["GT"])
  , ("Data.Ordering.L", ["Data.Ordering.LT"])

  -- if a module is imported qualified, values should complete under the
  -- qualified name, as well as the original name.
  , ("ST.new", ["ST.newSTRef"])
  , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])
  ]

assertCompletedOk :: (String, [String]) -> Assertion
assertCompletedOk (line, expecteds) = do
  (unusedR, completions) <- runCM (completion' (reverse line, ""))
  let unused = reverse unusedR
  let actuals = map ((unused ++) . replacement) completions
  sort expecteds @=? sort actuals

runCM :: CompletionM a -> IO a
runCM act = do
  psciState <- getPSCiState
  evalStateT (liftCompletionM act) psciState

getPSCiState :: IO PSCiState
getPSCiState = do
  cwd <- getCurrentDirectory
  let supportDir = cwd </> "tests" </> "support" </> "bower_components"
  let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir
  pursFiles <- supportFiles "purs"

  modulesOrFirstError <- loadAllModules pursFiles
  case modulesOrFirstError of
    Left err ->
      print err >> exitFailure
    Right modules ->
      let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName (T.pack "Prelude")], P.Implicit, Nothing)]
          dummyExterns = P.internalError "TestPsci: dummyExterns should not be used"
      in  return (PSCiState imports [] (zip (map snd modules) (repeat dummyExterns)))

controlMonadSTasST :: ImportedModule
controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
  where
  s = P.moduleNameFromString . T.pack