hsdev 0.1.5.2 → 0.1.5.3

raw patch · 9 files changed

+109/−12 lines, 9 filesdep +aeson-lensdep +hspec

Dependencies added: aeson-lens, hspec

Files

• hsdev.cabal +9/−3
• src/HsDev.hs +10/−4
• src/HsDev/Inspect.hs +4/−2
• src/HsDev/Server/Base.hs +4/−1
• src/HsDev/Server/Types.hs +1/−1
• tests/Test.hs +34/−1
• tests/test-package/ModuleOne.hs +14/−0
• tests/test-package/ModuleTwo.hs +10/−0
• tests/test-package/test-package.cabal +23/−0

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.5.2
+version:             0.1.5.3
 synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
@@ -15,10 +15,13 @@ category:            Development
 build-type:          Simple
 cabal-version:       >=1.8
+extra-source-files:
+    tests/test-package/*.hs
+    tests/test-package/test-package.cabal
 
 library
   hs-source-dirs: src
-  ghc-options: -threaded -Wall -fno-warn-tabs
+  ghc-options: -Wall -fno-warn-tabs
   exposed-modules:
     Control.Apply.Util
     Control.Concurrent.FiniteChan
@@ -266,16 +269,19 @@ test-suite test
   main-is: Test.hs
   hs-source-dirs: tests
-  ghc-options: -Wall -fno-warn-tabs
+  ghc-options: -threaded -Wall -fno-warn-tabs
   type: exitcode-stdio-1.0
   build-depends:
     base >= 4.7 && < 5,
     hsdev,
+    aeson >= 0.7.0,
+    aeson-lens >= 0.5.0,
     async >= 2.0,
     data-default >= 0.5.0,
     containers >= 0.5.0,
     deepseq >= 1.4.0,
     hformat >= 0.1,
+    hspec,
     lens >= 4.8,
     mtl >= 2.2.0,
     text >= 1.2.0

@@ -1,4 +1,9 @@ module HsDev (
+	module Data.Default,
+
+	module HsDev.Server.Base,
+	module HsDev.Server.Commands,
+	module HsDev.Client.Commands,
 	module HsDev.Cache,
 	module HsDev.Commands,
 	module HsDev.Database,
@@ -6,11 +11,14 @@ 	module HsDev.Project,
 	module HsDev.Scan,
 	module HsDev.Symbols,
-	module HsDev.Tools.Base,
-	module HsDev.Tools.GhcMod,
 	module HsDev.Util
 	) where
 
+import Data.Default
+
+import HsDev.Server.Base
+import HsDev.Server.Commands
+import HsDev.Client.Commands
 import HsDev.Cache
 import HsDev.Commands
 import HsDev.Database
@@ -18,6 +26,4 @@ import HsDev.Project
 import HsDev.Scan
 import HsDev.Symbols
-import HsDev.Tools.Base
-import HsDev.Tools.GhcMod
 import HsDev.Util

@@ -400,16 +400,18 @@  -- | Get actual defines getDefines :: IO [(String, String)]-getDefines = do+getDefines = E.handle onIO $ do 	tmp <- Dir.getTemporaryDirectory 	writeFile (tmp </> "defines.hs") ""-	_ <- runWait "ghc.exe" ["-E", "-optP-dM", "-cpp", tmp </> "defines.hs"] ""+	_ <- runWait "ghc" ["-E", "-optP-dM", "-cpp", tmp </> "defines.hs"] "" 	cts <- readFileUtf8 (tmp </> "defines.hspp") 	Dir.removeFile (tmp </> "defines.hs") 	Dir.removeFile (tmp </> "defines.hspp") 	return $ mapMaybe (\g -> (,) <$> g 1 <*> g 2) $ mapMaybe (matchRx rx) $ lines cts 	where 		rx = "#define ([^\\s]+) (.*)"+		onIO :: E.IOException -> IO [(String, String)]+		onIO _ = return []  preprocess :: [(String, String)] -> FilePath -> String -> ExceptT String IO String preprocess defines fpath cts = do

@@ -23,6 +23,7 @@ import qualified System.Log.Simple.Base as Log
 
 import qualified Control.Concurrent.FiniteChan as F
+import System.Directory.Paths (canonicalize)
 import qualified System.Directory.Watcher as Watcher
 import Text.Format ((~~), FormatBuild(..))
 
@@ -119,7 +120,9 @@ startServer sopts = startWorker (runServer sopts . runReaderT) id id
 
 inServer :: Server -> Command -> IO Result
-inServer srv c = inWorker srv (ReaderT (`Client.runCommand` c))
+inServer srv c = do
+	c' <- canonicalize c
+	inWorker srv (ReaderT (`Client.runCommand` c'))
 
 chaner :: F.Chan String -> Consumer Text
 chaner ch = Consumer withChan where

@@ -453,7 +453,7 @@ 		"docs" .= docs',
 		"infer" .= infer']
 	toJSON (RefineDocs projs fs ms) = cmdJson "docs" ["projects" .= projs, "files" .= fs, "modules" .= ms]
-	toJSON (InferTypes projs fs ms) = cmdJson "docs" ["projects" .= projs, "files" .= fs, "modules" .= ms]
+	toJSON (InferTypes projs fs ms) = cmdJson "infer" ["projects" .= projs, "files" .= fs, "modules" .= ms]
 	toJSON (Remove projs packages cabals fs) = cmdJson "remove" ["projects" .= projs, "packages" .= packages, "sandboxes" .= cabals, "files" .= fs]
 	toJSON (InfoModules tf) = cmdJson "modules" ["filter" .= tf]
 	toJSON InfoPackages = cmdJson "packages" []

@@ -1,6 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}
+
 module Main (
 	main
 	) where
 
+import Control.Lens
+import Data.Aeson hiding (Error)
+import Data.Aeson.Lens
+import Data.Default
+import HsDev
+import Test.Hspec
+
+call :: Server -> Command -> IO (Maybe Value)
+call srv c = do
+	r <- inServer srv c
+	case r of
+		Result v -> return $ Just v
+		Error e _ -> do
+			expectationFailure $ "command result error: " ++ e
+			return Nothing
+
+exports :: Maybe Value -> [String]
+exports v = v ^.. key "exports" . traverseArray . each . key "name" . each . _Just
+
 main :: IO ()
-main = return ()
+main = hspec $ do
+	describe "scan project" $ do
+		it "should scan project" $ do
+			s <- startServer def
+			_ <- call s $ Scan ["tests\\test-package"] [] [] [] [] [] False False
+			one <- call s $ InfoResolve "tests\\test-package\\ModuleOne.hs" True
+			when (["test", "forkIO", "f"] /= exports one) $
+				expectationFailure "invalid exports of ModuleOne.hs"
+			two <- call s $ InfoResolve "tests\\test-package\\ModuleTwo.hs" True
+			when (["f", "twice"] /= exports two) $
+				expectationFailure "invalid exports of ModuleTwo.hs"
+			_ <- call s Exit
+			return ()

@@ -0,0 +1,14 @@+module ModuleOne (
+	test,
+	forkIO,
+	f
+	) where
+
+import Control.Concurrent (forkIO)
+
+-- | Some test function
+test :: IO ()
+test = return ()
+
+-- | Some function without type
+f x y = x + y

@@ -0,0 +1,10 @@+module ModuleTwo (
+	f,
+	twice
+	) where
+
+import ModuleOne (f)
+
+-- | Apply function twice
+twice :: (a -> a) -> a -> a
+twice f = f . f

@@ -0,0 +1,23 @@+name:                test-package
+version:             0.1.0.0
+synopsis:            hsdev test package
+-- description:         
+-- license:             
+license-file:        LICENSE
+author:              voidex
+maintainer:          voidex@live.com
+-- copyright:           
+-- category:            
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+library
+  exposed-modules:
+    ModuleOne
+    ModuleTwo
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:       base >=4.8 && <4.9
+  hs-source-dirs:      .
+  default-language:    Haskell2010