haskell-tools-cli 1.0.0.4 → 1.0.1.1

raw patch · 6 files changed

+44/−39 lines, 6 filesdep ~aesondep ~criterionPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, criterion

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/Refactor/CLI.hs +33/−24
• benchmark/Main.hs +2/−4
• exe/Main.hs +2/−2
• haskell-tools-cli.cabal +3/−3
• test-stackage/Main.hs +2/−4
• test/Main.hs +2/−2

@@ -1,8 +1,5 @@-{-# LANGUAGE FlexibleContexts
-           , TypeFamilies
-           , RecordWildCards
-           , ScopedTypeVariables
-           #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds, RecordWildCards, ScopedTypeVariables #-}+
 -- | The command line interface for Haskell-tools. It uses the Haskell-tools daemon package starting
 -- the daemon in the same process and communicating with it through a channel.
 -- It can be used in a one-shot mode, listing all actions in a command-line parameter or using its
@@ -28,12 +25,12 @@ import Language.Haskell.Tools.Refactor
 import Paths_haskell_tools_cli (version)
 -- | Normal entry point of the cli.
-normalRefactorSession :: [RefactoringChoice] -> Handle -> Handle -> CLIOptions -> IO Bool
-normalRefactorSession refactorings input output options@CLIOptions{..}
+normalRefactorSession :: [RefactoringChoice] -> [QueryChoice] -> Handle -> Handle -> CLIOptions -> IO Bool
+normalRefactorSession refactorings queries input output options@CLIOptions{..}
   = do hSetBuffering stdout LineBuffering -- to synch our output with GHC's
        hSetBuffering stderr LineBuffering -- to synch our output with GHC's
-       refactorSession refactorings
-         (\st -> void $ forkIO $ do runDaemon refactorings channelMode st
+       refactorSession refactorings queries
+         (\st -> void $ forkIO $ do runDaemon refactorings queries channelMode st
                                       (DaemonOptions False 0 (not cliVerbose) sharedOptions))
          input output options
 
@@ -47,11 +44,12 @@ 
 -- | Entry point with configurable initialization. Mainly for testing, call 'normalRefactorSession'
 -- to use the command-line.
-refactorSession :: [RefactoringChoice] -> ServerInit -> Handle -> Handle -> CLIOptions -> IO Bool
-refactorSession _ _ _ output CLIOptions{..} | displayVersion
+refactorSession :: [RefactoringChoice] -> [QueryChoice] -> ServerInit -> Handle -> Handle
+                     -> CLIOptions -> IO Bool
+refactorSession _ _ _ _ output CLIOptions{..} | displayVersion
   = do hPutStrLn output $ showVersion version
        return True
-refactorSession refactorings init input output CLIOptions{..} = do
+refactorSession refactorings queries init input output CLIOptions{..} = do
   connStore <- newEmptyMVar
   init connStore
   (recv,send) <- takeMVar connStore -- wait for the server to establish connection
@@ -59,28 +57,30 @@   writeChan send (SetWorkingDir wd)
   writeChan send (AddPackages packageRoots)
   case executeCommands of
-    Just cmds -> performCmdOptions refactorings output send (splitOn ";" cmds)
+    Just cmds -> performCmdOptions refactorings queries output send (splitOn ";" cmds)
     Nothing -> return ()
-  when (isNothing executeCommands) (void $ forkIO $ do processUserInput refactorings input output send)
+  when (isNothing executeCommands) (void $ forkIO $ processUserInput refactorings queries input output send)
   readFromSocket (isJust executeCommands) output recv
 
 -- | An initialization action for the daemon.
 type ServerInit = MVar (Chan ResponseMsg, Chan ClientMessage) -> IO ()
 
 -- | Reads commands from standard input and executes them.
-processUserInput :: [RefactoringChoice] -> Handle -> Handle -> Chan ClientMessage -> IO ()
-processUserInput refactorings input output chan = do
+processUserInput :: [RefactoringChoice] -> [QueryChoice] -> Handle -> Handle
+                      -> Chan ClientMessage -> IO ()
+processUserInput refactorings queries input output chan = do
     cmd <- hGetLine input
-    continue <- processCommand False refactorings output chan cmd
-    when continue $ processUserInput refactorings input output chan
+    continue <- processCommand False refactorings queries output chan cmd
+    when continue $ processUserInput refactorings queries input output chan
   `catch` \e -> if isEOFError e then return ()
                                 else putStrLn (show e) >> return ()
 
 -- | Perform a command received from the user. The resulting boolean states if the user may continue
 -- (True), or the session is over (False).
-processCommand :: Bool -> [RefactoringChoice] -> Handle -> Chan ClientMessage -> String -> IO Bool
-processCommand _ _ _ _ "" = return True
-processCommand shutdown refactorings output chan cmd = do
+processCommand :: Bool -> [RefactoringChoice] -> [QueryChoice] -> Handle -> Chan ClientMessage
+                    -> String -> IO Bool
+processCommand _ _ _ _ _ "" = return True
+processCommand shutdown refactorings queries output chan cmd = do
   case splitOn " " cmd of
     ["Exit"] -> writeChan chan Disconnect >> return False
     ["AddFile", fn] -> writeChan chan (ReLoad [fn] [] []) >> return True
@@ -96,6 +96,10 @@                , ref `elem` refactorCommands refactorings
        -> do writeChan chan (PerformRefactoring ref modPath selection details shutdown False)
              return (not shutdown)
+    ref : rest | let modPath:selection:details = rest ++ (replicate (2 - length rest) "")
+               , ref `elem` queryCommands queries
+       -> do writeChan chan (PerformQuery ref modPath selection details shutdown)
+             return (not shutdown)
     "Try" : ref : rest | let modPath:selection:details = rest ++ (replicate (2 - length rest) "")
                        , ref `elem` refactorCommands refactorings
        -> do writeChan chan (PerformRefactoring ref modPath selection details shutdown True)
@@ -124,6 +128,9 @@ processMessage _ output (LoadedModule fp name)
   = do hPutStrLn output $ "Loaded module: " ++ name ++ "( " ++ fp ++ ") "
        return Nothing
+processMessage _ output (QueryResult value)
+  = do hPutStrLn output $ "Query result: " ++ show value
+       return Nothing
 processMessage _ output (DiffInfo diff)
   = do hPutStrLn output diff
        return Nothing
@@ -139,9 +146,11 @@ processMessage _ _ _ = return Nothing
 
 -- | Perform the commands specified by the user as a command line argument.
-performCmdOptions :: [RefactoringChoice] -> Handle -> Chan ClientMessage -> [String] -> IO ()
-performCmdOptions refactorings output chan cmds = do
-    continue <- mapM (\(shutdown, cmd) -> processCommand shutdown refactorings output chan cmd)
+performCmdOptions :: [RefactoringChoice] -> [QueryChoice] -> Handle -> Chan ClientMessage
+                       -> [String] -> IO ()
+performCmdOptions refactorings queries output chan cmds = do
+    continue <- mapM (\(shutdown, cmd) -> processCommand shutdown refactorings
+                                            queries output chan cmd)
                      (zip lastIsShutdown cmds)
     when (and continue) $ writeChan chan Disconnect
   where lastIsShutdown = replicate (length cmds - 1) False ++ [True]

@@ -1,8 +1,6 @@ 
-{-# LANGUAGE TypeFamilies
-           , RecordWildCards
-           , DeriveGeneric
-           #-}
+{-# LANGUAGE DeriveGeneric, MonoLocalBinds, RecordWildCards #-}+
 module Main where
 
 import Criterion.Measurement hiding (runBenchmark)

@@ -8,11 +8,11 @@ import System.IO (IO, stdout, stdin)
 
 import Language.Haskell.Tools.Daemon.Options (sharedOptionsParser)
-import Language.Haskell.Tools.Refactor.Builtin (builtinRefactorings)
+import Language.Haskell.Tools.Refactor.Builtin (builtinRefactorings, builtinQueries)
 import Language.Haskell.Tools.Refactor.CLI (normalRefactorSession, CLIOptions(..))
 
 main :: IO ()
-main = exit =<< normalRefactorSession builtinRefactorings stdin stdout =<< execParser opts
+main = exit =<< normalRefactorSession builtinRefactorings builtinQueries stdin stdout =<< execParser opts
   where exit :: Bool -> IO ()
         exit True = exitSuccess
         exit False = exitFailure

@@ -1,5 +1,5 @@ name:                haskell-tools-cli
-version:             1.0.0.4
+version:             1.0.1.1
 synopsis:            Command-line frontend for Haskell-tools Refact
 description:         Command-line frontend for Haskell-tools Refact. Not meant as a final product, only for demonstration purposes.
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -82,9 +82,9 @@   type:                exitcode-stdio-1.0
   ghc-options:         -with-rtsopts=-M2g
   build-depends:       base                      >= 4.10 && < 4.11
-                     , criterion                 >= 1.1 && < 1.4
+                     , criterion                 >= 1.1 && < 1.5
                      , time                      >= 1.6 && < 1.9
-                     , aeson                     >= 1.0 && < 1.3
+                     , aeson                     >= 1.0 && < 1.4
                      , directory                 >= 1.2 && < 1.4
                      , filepath                  >= 1.4 && < 2.0
                      , knob                      >= 0.1 && < 0.2

@@ -1,7 +1,5 @@-{-# LANGUAGE LambdaCase
-           , TypeApplications
-           , ScopedTypeVariables
-           #-}
+{-# LANGUAGE LambdaCase, ScopedTypeVariables, TypeApplications #-}
+
 module Main where
 
 import Control.Applicative ((<$>))

@@ -11,7 +11,7 @@ import System.FilePath
 import System.IO
 
-import Language.Haskell.Tools.Refactor.Builtin (builtinRefactorings)
+import Language.Haskell.Tools.Refactor.Builtin (builtinRefactorings, builtinQueries)
 import Language.Haskell.Tools.Refactor.CLI (SharedDaemonOptions(..), CLIOptions(..), normalRefactorSession)
 
 main :: IO ()
@@ -43,7 +43,7 @@       inHandle <- newFileHandle inKnob "<input>" ReadMode
       outKnob <- newKnob (pack [])
       outHandle <- newFileHandle outKnob "<output>" WriteMode
-      normalRefactorSession builtinRefactorings inHandle outHandle (args suffix testdirs)
+      normalRefactorSession builtinRefactorings builtinQueries inHandle outHandle (args suffix testdirs)
       actualOut <- Data.Knob.getContents outKnob
       assertBool ("The result is not what is expected. Output: " ++ (unpack actualOut))
         =<< outputCheck suffix (unpack actualOut)