git.iko.soy/rowtype-yoga/purescript-native
on cd4c708 help sign in
rowtype-yoga/purescript-native/tests/TestPsci.hs
138 lines 4.6 kB history raw
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE TupleSections #-}
4module TestPsci where
6import Prelude ()
7import Prelude.Compat
9import Control.Monad.Trans.State.Strict (evalStateT)
10import Control.Monad (when)
12import Data.List (sort)
14import System.Exit (exitFailure)
15import System.Console.Haskeline
16import System.FilePath ((</>))
17import System.Directory (getCurrentDirectory)
18import qualified System.FilePath.Glob as Glob
20import Test.HUnit
22import qualified Language.PureScript as P
24import Language.PureScript.Interactive.Module (loadAllModules)
25import Language.PureScript.Interactive.Completion
26import Language.PureScript.Interactive.Types
28import TestUtils (supportModules)
30main :: IO ()
31main = do
32 Counts{..} <- runTestTT allTests
33 when (errors + failures > 0) exitFailure
35allTests :: Test
36allTests = completionTests
38completionTests :: Test
39completionTests =
40 TestLabel "completionTests"
41 (TestList (map (TestCase . assertCompletedOk) completionTestData))
43-- If the cursor is at the right end of the line, with the 1st element of the
44-- pair as the text in the line, then pressing tab should offer all the
45-- elements of the list (which is the 2nd element) as completions.
46completionTestData :: [(String, [String])]
47completionTestData =
48 -- basic directives
49 [ (":h", [":help"])
50 , (":re", [":reset"])
51 , (":q", [":quit"])
52 , (":b", [":browse"])
54 -- :browse should complete module names
55 , (":b Control.Monad.E", map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
56 , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
58 -- import should complete module names
59 , ("import Control.Monad.E", map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
60 , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
62 -- :quit, :help, :reset should not complete
63 , (":help ", [])
64 , (":quit ", [])
65 , (":reset ", [])
67 -- :show should complete to "loaded" and "import"
68 , (":show ", [":show import", ":show loaded"])
69 , (":show a", [])
71 -- :type should complete values and data constructors in scope
72 , (":type Control.Monad.Eff.Console.lo", [":type Control.Monad.Eff.Console.log", ":type Control.Monad.Eff.Console.logShow"])
73 --, (":type uni", [":type unit"])
74 --, (":type E", [":type EQ"])
76 -- :kind should complete types in scope
77 --, (":kind C", [":kind Control.Monad.Eff.Pure"])
78 --, (":kind O", [":kind Ordering"])
80 -- Only one argument for directives should be completed
81 , (":show import ", [])
82 , (":type EQ ", [])
83 , (":kind Ordering ", [])
85 -- a few other import tests
86 , ("impor", ["import"])
87 , ("import ", map ("import " ++) supportModules)
88 , ("import Prelude ", [])
90 -- String and number literals should not be completed
91 , ("\"hi", [])
92 , ("34", [])
94 -- Identifiers and data constructors should be completed
95 --, ("uni", ["unit"])
96 , ("Control.Monad.Eff.Class.", ["Control.Monad.Eff.Class.liftEff"])
97 --, ("G", ["GT"])
98 , ("Data.Ordering.L", ["Data.Ordering.LT"])
100 -- if a module is imported qualified, values should complete under the
101 -- qualified name, as well as the original name.
102 , ("ST.new", ["ST.newSTRef"])
103 , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])
104 ]
105 where
107assertCompletedOk :: (String, [String]) -> Assertion
108assertCompletedOk (line, expecteds) = do
109 (unusedR, completions) <- runCM (completion' (reverse line, ""))
110 let unused = reverse unusedR
111 let actuals = map ((unused ++) . replacement) completions
112 sort expecteds @=? sort actuals
114runCM :: CompletionM a -> IO a
115runCM act = do
116 psciState <- getPSCiState
117 evalStateT (liftCompletionM act) psciState
119getPSCiState :: IO PSCiState
120getPSCiState = do
121 cwd <- getCurrentDirectory
122 let supportDir = cwd </> "tests" </> "support" </> "bower_components"
123 let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir
124 pursFiles <- supportFiles "purs"
126 modulesOrFirstError <- loadAllModules pursFiles
127 case modulesOrFirstError of
128 Left err ->
129 print err >> exitFailure
130 Right modules ->
131 let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
132 dummyExterns = P.internalError "TestPsci: dummyExterns should not be used"
133 in return (PSCiState imports [] (zip (map snd modules) (repeat dummyExterns)))
135controlMonadSTasST :: ImportedModule
136controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
137 where
138 s = P.moduleNameFromString