git.iko.soy/rowtype-yoga/purescript-native
on ebbc4e4 help sign in
rowtype-yoga/purescript-native/tests/TestPsci.hs
160 lines 5.2 kB history raw
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE TupleSections #-}
4module TestPsci where
6import Prelude ()
7import Prelude.Compat
9import Control.Monad.Trans.State.Strict (runStateT)
10import Control.Monad (when, forM)
11import Control.Monad.Writer.Strict (runWriterT)
12import Control.Monad.Trans.Except (runExceptT)
14import Data.List (sort)
16import System.Exit (exitFailure)
17import System.Console.Haskeline
18import System.FilePath ((</>))
19import System.Directory (getCurrentDirectory)
20import System.IO.UTF8 (readUTF8File)
21import qualified System.FilePath.Glob as Glob
23import Test.HUnit
25import qualified Language.PureScript as P
27import PSCi.Module (loadAllModules)
28import PSCi.Completion
29import PSCi.Types
31main :: IO ()
32main = do
33 Counts{..} <- runTestTT allTests
34 when (errors + failures > 0) exitFailure
36allTests :: Test
37allTests = completionTests
39completionTests :: Test
40completionTests =
41 TestLabel "completionTests"
42 (TestList (map (TestCase . assertCompletedOk) completionTestData))
44-- If the cursor is at the right end of the line, with the 1st element of the
45-- pair as the text in the line, then pressing tab should offer all the
46-- elements of the list (which is the 2nd element) as completions.
47completionTestData :: [(String, [String])]
48completionTestData =
49 -- basic directives
50 [ (":h", [":help"])
51 , (":re", [":reset"])
52 , (":q", [":quit"])
53 , (":mo", [":module"])
54 , (":b", [":browse"])
56 -- :browse should complete module names
57 , (":b Control.Monad.E", map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
58 , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
60 -- import should complete module names
61 , ("import Control.Monad.E", map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
62 , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
63 , ("import qualified Control.Monad.Eff.", map ("import qualified Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
65 -- :load, :module should complete file paths
66 , (":l tests/support/psci/", [":l tests/support/psci/Sample.purs"])
67 , (":module tests/support/psci/", [":module tests/support/psci/Sample.purs"])
69 -- :quit, :help, :reset should not complete
70 , (":help ", [])
71 , (":quit ", [])
72 , (":reset ", [])
74 -- :show should complete to "loaded" and "import"
75 , (":show ", [":show import", ":show loaded"])
76 , (":show a", [])
78 -- :type should complete values and data constructors in scope
79 , (":type Control.Monad.Eff.Console.lo", [":type Control.Monad.Eff.Console.log"])
80 , (":type uni", [":type unit"])
81 , (":type E", [":type EQ"])
83 -- :kind should complete types in scope
84 , (":kind C", [":kind Control.Monad.Eff.Pure"])
85 , (":kind O", [":kind Ordering"])
87 -- Only one argument for directives should be completed
88 , (":show import ", [])
89 , (":type EQ ", [])
90 , (":kind Ordering ", [])
92 -- a few other import tests
93 , ("impor", ["import"])
94 , ("import q", ["import qualified"])
95 , ("import ", map ("import " ++) supportModules ++ ["import qualified"])
96 , ("import Prelude ", [])
98 -- String and number literals should not be completed
99 , ("\"hi", [])
100 , ("34", [])
102 -- Identifiers and data constructors should be completed
103 , ("uni", ["unit"])
104 , ("Control.Monad.Eff.Class.", ["Control.Monad.Eff.Class.liftEff"])
105 , ("G", ["GT"])
106 , ("Prelude.L", ["Prelude.LT"])
108 -- if a module is imported qualified, values should complete under the
109 -- qualified name, as well as the original name.
110 , ("ST.new", ["ST.newSTRef"])
111 , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])
112 ]
113 where
115assertCompletedOk :: (String, [String]) -> Assertion
116assertCompletedOk (line, expecteds) = do
117 (unusedR, completions) <- runCM (completion' (reverse line, ""))
118 let unused = reverse unusedR
119 let actuals = map ((unused ++) . replacement) completions
120 sort expecteds @=? sort actuals
122runCM :: CompletionM a -> IO a
123runCM act = do
124 psciState <- getPSCiState
125 fmap fst (runStateT (liftCompletionM act) psciState)
127getPSCiState :: IO PSCiState
128getPSCiState = do
129 cwd <- getCurrentDirectory
130 let supportDir = cwd </> "tests" </> "support" </> "flattened"
131 let supportFiles ext = Glob.globDir1 (Glob.compile ("*." ++ ext)) supportDir
132 pursFiles <- supportFiles "purs"
133 jsFiles <- supportFiles "js"
135 modulesOrFirstError <- loadAllModules pursFiles
136 foreignFiles <- forM jsFiles (\f -> (f,) <$> readUTF8File f)
137 Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles
138 case modulesOrFirstError of
139 Left err ->
140 print err >> exitFailure
141 Right modules ->
142 let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
143 in return (mkPSCiState imports modules foreigns [] [])
145controlMonadSTasST :: ImportedModule
146controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
147 where
148 s = P.moduleNameFromString
150supportModules :: [String]
151supportModules =
152 [ "Control.Monad.Eff.Class"
153 , "Control.Monad.Eff.Console"
154 , "Control.Monad.Eff"
155 , "Control.Monad.Eff.Unsafe"
156 , "Control.Monad.ST"
157 , "Data.Function"
158 , "Prelude"
159 , "Test.Assert"
160 ]