Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 37785a7

Browse files
cocreaturecocreature
committed
Bump deps and adapt to new apis
1 parent b27542f commit 37785a7

File tree

12 files changed

+61
-87
lines changed

12 files changed

+61
-87
lines changed

‎hie-apply-refact/Haskell/Ide/ApplyRefactPlugin.hs

+13-31
Original file line numberDiff line numberDiff line change
@@ -2,15 +2,16 @@
22
{-# LANGUAGE GADTs #-}
33
module Haskell.Ide.ApplyRefactPlugin where
44

5+
import Control.Arrow
56
import Control.Monad.IO.Class
7+
import Data.Aeson
68
import qualified Data.Text as T
79
import qualified Data.Text.IO as T
810
import Data.Vinyl
911
import Haskell.Ide.Engine.MonadFunctions
1012
import Haskell.Ide.Engine.PluginDescriptor
1113
import Haskell.Ide.Engine.PluginUtils
1214
import Haskell.Ide.Engine.SemanticTypes
13-
import Language.Haskell.HLint
1415
import Language.Haskell.HLint3
1516
import Refact.Apply
1617
import qualified Refact.Types as R
@@ -49,10 +50,10 @@ applyOneCmd = CmdSync $ \_ctxs req -> do
4950
logm $ "applyOneCmd:res=" ++ show res
5051
case res of
5152
Left err -> return $ IdeResponseFail (IdeError PluginError
52-
(T.pack $ "applyOne: " ++ show err) Nothing)
53+
(T.pack $ "applyOne: " ++ show err) Null)
5354
Right fs -> return (IdeResponseOk fs)
5455
Right _ -> return $ IdeResponseError (IdeError InternalError
55-
"ApplyRefactPlugin.applyOneCmd: ghc’s exhaustiveness checker is broken" Nothing)
56+
"ApplyRefactPlugin.applyOneCmd: ghc’s exhaustiveness checker is broken" Null)
5657

5758

5859
-- ---------------------------------------------------------------------
@@ -66,50 +67,31 @@ applyAllCmd = CmdSync $ \_ctxs req -> do
6667
logm $ "applyAllCmd:res=" ++ show res
6768
case res of
6869
Left err -> return $ IdeResponseFail (IdeError PluginError
69-
(T.pack $ "applyOne: " ++ show err) Nothing)
70+
(T.pack $ "applyOne: " ++ show err) Null)
7071
Right fs -> return (IdeResponseOk fs)
7172
Right _ -> return $ IdeResponseError (IdeError InternalError
72-
"ApplyRefactPlugin.applyOneCmd: ghc’s exhaustiveness checker is broken" Nothing)
73+
"ApplyRefactPlugin.applyOneCmd: ghc’s exhaustiveness checker is broken" Null)
7374

7475

7576
-- ---------------------------------------------------------------------
7677

7778
applyHint :: FilePath -> Maybe Pos -> IO (Either String HieDiff)
7879
applyHint file mpos = do
7980
withTempFile $ \f -> do
80-
-- absFile <- makeAbsolute file
81-
-- hlint /tmp/Foo.hs --refactor --refactor-options="-o /tmp/Bar.hs --pos 2,8"
82-
83-
let
84-
optsf = "-o " ++ f
85-
opts = case mpos of
86-
Nothing -> optsf
87-
Just (r,c) -> optsf ++ " --pos " ++ show r ++ "," ++ show c
88-
-- let hlintOpts = [file, "--quiet", "--refactor", "--refactor-options=" ++ opts ]
89-
let hlintOpts = [file, "--quiet" ]
90-
logm $ "applyHint=" ++ show hlintOpts
91-
res <- catchException $ hlint hlintOpts
92-
logm $ "applyHint:res=" ++ show res
93-
-- res <- hlint hlintOpts
81+
(flags,classify,hint) <- autoSettings
82+
res <- parseModuleEx flags file Nothing
9483
case res of
95-
Left x -> return $ Left (show x)
96-
Right x -> do
97-
let commands = makeApplyRefact x
84+
Left err -> return $ Left (unlines [show $ parseErrorLocation err
85+
,parseErrorMessage err
86+
,parseErrorContents err])
87+
Right mod -> do
88+
let commands = map (show &&& ideaRefactoring) $ applyHints classify hint [mod]
9889
logm $ "applyHint:commands=" ++ show commands
9990
appliedFile <- applyRefactorings mpos commands file
10091
diff <- makeDiffResult file (T.pack appliedFile)
10192
logm $ "applyHint:diff=" ++ show diff
10293
return $ Right diff
10394

104-
-- ---------------------------------------------------------------------
105-
106-
makeApplyRefact :: [Suggestion] -> [(String, [Refactoring R.SrcSpan])]
107-
makeApplyRefact suggestions =
108-
map (\(Suggestion i) -> (show i, ideaRefactoring i)) suggestions
109-
110-
-- ---------------------------------------------------------------------
111-
112-
11395
makeDiffResult :: FilePath -> T.Text -> IO HieDiff
11496
makeDiffResult orig new = do
11597
origText <- T.readFile orig

‎hie-base/Haskell/Ide/Engine/PluginTypes.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -213,7 +213,7 @@ data IdeErrorCode
213213
data IdeError = IdeError
214214
{ ideCode :: IdeErrorCode -- ^ The error code
215215
, ideMessage :: T.Text -- ^ A human readable message
216-
, ideInfo :: Maybe Value -- ^ Additional information
216+
, ideInfo :: Value -- ^ Additional information
217217
}
218218
deriving (Show,Read,Eq,Generic)
219219

@@ -291,7 +291,7 @@ instance ValidResponse CommandDescriptor where
291291
instance ValidResponse IdePlugins where
292292
jsWrite (IdePlugins m) = H.fromList ["plugins" .= H.fromList
293293
( map (uncurry (.=))
294-
$ Map.assocs m)]
294+
$ Map.assocs m :: [Pair])]
295295
jsRead v = do
296296
ps <- v .: "plugins"
297297
liftM (IdePlugins . Map.fromList) $ mapM (\(k,vp) -> do
@@ -378,7 +378,7 @@ instance FromJSON IdeError where
378378
parseJSON (Object v) = IdeError
379379
<$> v .: "code"
380380
<*> v .: "msg"
381-
<*> v .:? "info"
381+
<*> v .: "info"
382382
parseJSON _ = empty
383383

384384

‎hie-ghc-mod/Haskell/Ide/GhcModPlugin.hs

+11-10
Original file line numberDiff line numberDiff line change
@@ -7,22 +7,23 @@ module Haskell.Ide.GhcModPlugin where
77
import Haskell.Ide.Engine.PluginUtils
88

99
import Control.Exception
10-
import Data.Either
11-
import Data.Vinyl
1210
import Control.Monad.IO.Class
11+
import Data.Aeson
12+
import Data.Either
1313
import qualified Data.Map as M
1414
import qualified Data.Text as T
1515
import qualified Data.Text.Read as T
16+
import Data.Vinyl
17+
import qualified Exception as G
1618
import Haskell.Ide.Engine.PluginDescriptor
1719
import Haskell.Ide.Engine.PluginUtils
1820
import Haskell.Ide.Engine.SemanticTypes
1921
import qualified Language.Haskell.GhcMod as GM
2022
import qualified Language.Haskell.GhcMod.Monad as GM
2123
import qualified Language.Haskell.GhcMod.Types as GM
2224
import qualified Language.Haskell.GhcMod.Utils as GM
23-
import System.FilePath
2425
import System.Directory
25-
import qualified Exception as G
26+
import System.FilePath
2627

2728
-- ---------------------------------------------------------------------
2829

@@ -83,7 +84,7 @@ checkCmd = CmdSync $ \_ctxs req -> do
8384
Right (ParamFile fileName :& RNil) -> do
8485
fmap T.pack <$> runGhcModCommand fileName (\f->GM.checkSyntax [f])
8586
Right _ -> return $ IdeResponseError (IdeError InternalError
86-
"GhcModPlugin.checkCmd: ghc’s exhaustiveness checker is broken" Nothing)
87+
"GhcModPlugin.checkCmd: ghc’s exhaustiveness checker is broken" Null)
8788

8889
-- ---------------------------------------------------------------------
8990

@@ -105,7 +106,7 @@ findCmd = CmdSync $ \_ctxs req -> do
105106

106107
-- return (IdeResponseOk "Placholder:Need to debug this in ghc-mod, returns 'does not exist (No such file or directory)'")
107108
Right _ -> return $ IdeResponseError (IdeError InternalError
108-
"GhcModPlugin.findCmd: ghc’s exhaustiveness checker is broken" Nothing)
109+
"GhcModPlugin.findCmd: ghc’s exhaustiveness checker is broken" Null)
109110
where
110111
conv :: String -> (T.Text, [GM.ModuleString])
111112
conv = read
@@ -119,7 +120,7 @@ lintCmd = CmdSync $ \_ctxs req -> do
119120
Right (ParamFile fileName :& RNil) -> do
120121
fmap T.pack <$> runGhcModCommand fileName (GM.lint GM.defaultLintOpts)
121122
Right _ -> return $ IdeResponseError (IdeError InternalError
122-
"GhcModPlugin.lintCmd: ghc’s exhaustiveness checker is broken" Nothing)
123+
"GhcModPlugin.lintCmd: ghc’s exhaustiveness checker is broken" Null)
123124

124125
-- ---------------------------------------------------------------------
125126

@@ -130,7 +131,7 @@ infoCmd = CmdSync $ \_ctxs req -> do
130131
Right (ParamFile fileName :& ParamText expr :& RNil) -> do
131132
fmap T.pack <$> runGhcModCommand fileName (flip GM.info (GM.Expression (T.unpack expr)))
132133
Right _ -> return $ IdeResponseError (IdeError InternalError
133-
"GhcModPlugin.infoCmd: ghc’s exhaustiveness checker is broken" Nothing)
134+
"GhcModPlugin.infoCmd: ghc’s exhaustiveness checker is broken" Null)
134135

135136
-- ---------------------------------------------------------------------
136137

@@ -141,7 +142,7 @@ typeCmd = CmdSync $ \_ctxs req ->
141142
Right (ParamFile fileName :& ParamPos (r,c) :& RNil) -> do
142143
fmap (toTypeInfo . T.lines . T.pack) <$> runGhcModCommand fileName (\f->GM.types f r c)
143144
Right _ -> return $ IdeResponseError (IdeError InternalError
144-
"GhcModPlugin.typesCmd: ghc’s exhaustiveness checker is broken" Nothing)
145+
"GhcModPlugin.typesCmd: ghc’s exhaustiveness checker is broken" Null)
145146

146147

147148
-- | Transform output from ghc-mod type into TypeInfo
@@ -178,5 +179,5 @@ runGhcModCommand fp cmd = do
178179
tmp <- liftIO $ GM.newTempDir root
179180
let setRoot e = e{GM.gmCradle = (GM.gmCradle e){GM.cradleRootDir=root,GM.cradleTempDir=tmp}}
180181
(IdeResponseOk <$> GM.gmeLocal setRoot (cmd f)) `G.gcatch` \(e :: GM.GhcModError) ->
181-
return $ IdeResponseFail $ IdeError PluginError (T.pack $ "hie-ghc-mod: " ++ show e) Nothing
182+
return $ IdeResponseFail $ IdeError PluginError (T.pack $ "hie-ghc-mod: " ++ show e) Null
182183
)

‎hie-hare/Haskell/Ide/HaRePlugin.hs

+8-7
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
module Haskell.Ide.HaRePlugin where
44

55
import Control.Monad.IO.Class
6+
import Data.Aeson
67
import qualified Data.Text as T
78
import Data.Vinyl
89
import Haskell.Ide.Engine.PluginDescriptor
@@ -61,7 +62,7 @@ demoteCmd = CmdSync $ \_ctxs req ->
6162
Right (ParamFile fileName :& ParamPos pos :& RNil) ->
6263
runHareCommand fileName "demote" (\s o f -> demote s o f pos)
6364
Right _ -> return $ IdeResponseError (IdeError InternalError
64-
"HaRePlugin.demoteCmd: ghc’s exhaustiveness checker is broken" Nothing)
65+
"HaRePlugin.demoteCmd: ghc’s exhaustiveness checker is broken" Null)
6566

6667
-- demote :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]
6768

@@ -74,7 +75,7 @@ dupdefCmd = CmdSync $ \_ctxs req ->
7475
Right (ParamFile fileName :& ParamPos pos :& ParamText name :& RNil) ->
7576
runHareCommand fileName "duplicateDef" (\s o f -> duplicateDef s o f (T.unpack name) pos)
7677
Right _ -> return $ IdeResponseError (IdeError InternalError
77-
"HaRePlugin.dupdefCmd: ghc’s exhaustiveness checker is broken" Nothing)
78+
"HaRePlugin.dupdefCmd: ghc’s exhaustiveness checker is broken" Null)
7879

7980
-- duplicateDef :: RefactSettings -> GM.Options -> FilePath -> String -> SimpPos -> IO [FilePath]
8081

@@ -87,7 +88,7 @@ iftocaseCmd = CmdSync $ \_ctxs req ->
8788
Right (ParamFile fileName :& ParamPos start :& ParamPos end :& RNil) ->
8889
runHareCommand fileName "ifToCase" (\s o f -> ifToCase s o f start end)
8990
Right _ -> return $ IdeResponseError (IdeError InternalError
90-
"HaRePlugin.ifToCaseCmd: ghc’s exhaustiveness checker is broken" Nothing)
91+
"HaRePlugin.ifToCaseCmd: ghc’s exhaustiveness checker is broken" Null)
9192

9293
-- ifToCase :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> SimpPos -> IO [FilePath]
9394

@@ -100,7 +101,7 @@ liftonelevelCmd = CmdSync $ \_ctxs req ->
100101
Right (ParamFile fileName :& ParamPos pos :& RNil) ->
101102
runHareCommand fileName "liftOneLevel" (\s o f -> liftOneLevel s o f pos)
102103
Right _ -> return $ IdeResponseError (IdeError InternalError
103-
"HaRePlugin.liftOneLevel: ghc’s exhaustiveness checker is broken" Nothing)
104+
"HaRePlugin.liftOneLevel: ghc’s exhaustiveness checker is broken" Null)
104105

105106
-- liftOneLevel :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]
106107

@@ -113,7 +114,7 @@ lifttotoplevelCmd = CmdSync $ \_ctxs req ->
113114
Right (ParamFile fileName :& ParamPos pos :& RNil) ->
114115
runHareCommand fileName "liftToTopLevel" (\s o f -> liftToTopLevel s o f pos)
115116
Right _ -> return $ IdeResponseError (IdeError InternalError
116-
"HaRePlugin.liftToTopLevel: ghc’s exhaustiveness checker is broken" Nothing)
117+
"HaRePlugin.liftToTopLevel: ghc’s exhaustiveness checker is broken" Null)
117118

118119
-- liftToTopLevel :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]
119120

@@ -126,7 +127,7 @@ renameCmd = CmdSync $ \_ctxs req ->
126127
Right (ParamFile fileName :& ParamPos pos :& ParamText name :& RNil) ->
127128
runHareCommand fileName "rename" (\s o f -> rename s o f (T.unpack name) pos)
128129
Right _ -> return $ IdeResponseError (IdeError InternalError
129-
"HaRePlugin.renameCmd: ghc’s exhaustiveness checker is broken" Nothing)
130+
"HaRePlugin.renameCmd: ghc’s exhaustiveness checker is broken" Null)
130131

131132
-- rename :: RefactSettings -> Options -> FilePath -> String -> SimpPos -> IO [FilePath]
132133

@@ -167,7 +168,7 @@ runHareCommand fp name cmd = do
167168
liftIO $ setCurrentDirectory old
168169
case res of
169170
Left err -> return $ IdeResponseFail (IdeError PluginError
170-
(T.pack $ name ++ ": " ++ show err) Nothing)
171+
(T.pack $ name ++ ": " ++ show err) Null)
171172
Right fs -> do
172173
r <- liftIO $ makeRefactorResult fs
173174
return (IdeResponseOk r)

‎hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,7 @@ mapEithers _ _ = Right []
7777
missingParameter :: forall r. (ValidResponse r) => ParamId -> IdeResponse r
7878
missingParameter param = IdeResponseFail (IdeError MissingParameter
7979
("need `" <> param <> "` parameter")
80-
(Just $ toJSON param))
80+
(toJSON param))
8181

8282
-- |Incorrect parameter error
8383
incorrectParameter :: forall r a b. (ValidResponse r,Show a,Show b)
@@ -86,8 +86,8 @@ incorrectParameter name expected value = IdeResponseFail
8686
(IdeError IncorrectParameterType
8787
("got wrong parameter type for `" <> name <> "`, expected: " <>
8888
T.pack (show expected) <>" , got:" <> T.pack (show value))
89-
(Just $ object ["param" .= toJSON name,"expected".= toJSON (show expected),
90-
"value" .= toJSON (show value)]))
89+
(object ["param" .= toJSON name,"expected".= toJSON (show expected),
90+
"value" .= toJSON (show value)]))
9191

9292
-- ---------------------------------------------------------------------
9393

‎src/Haskell/Ide/Engine/BasePlugin.hs

+4-4
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ commandsCmd = CmdSync $ \_ req -> do
6767
Nothing -> return $ IdeResponseFail $ IdeError
6868
{ ideCode = UnknownPlugin
6969
, ideMessage = "Can't find plugin:" <> p
70-
, ideInfo = Just $ toJSON p
70+
, ideInfo = toJSON p
7171
}
7272
Just pl -> return $ IdeResponseOk $ map (cmdName . cmdDesc) (pdCommands pl)
7373
Just x -> return $ incorrectParameter "plugin" ("ParamText"::String) x
@@ -82,19 +82,19 @@ commandDetailCmd = CmdSync $ \_ req -> do
8282
Nothing -> return $ IdeResponseError $ IdeError
8383
{ ideCode = UnknownPlugin
8484
, ideMessage = "Can't find plugin:" <> p
85-
, ideInfo = Just $ toJSON p
85+
, ideInfo = toJSON p
8686
}
8787
Just pl -> case find (\cmd -> command == (cmdName $ cmdDesc cmd) ) (pdCommands pl) of
8888
Nothing -> return $ IdeResponseError $ IdeError
8989
{ ideCode = UnknownCommand
9090
, ideMessage = "Can't find command:" <> command
91-
, ideInfo = Just $ toJSON command
91+
, ideInfo = toJSON command
9292
}
9393
Just detail -> return $ IdeResponseOk (ExtendedCommandDescriptor (cmdDesc detail) p)
9494
Right _ -> return $ IdeResponseError $ IdeError
9595
{ ideCode = InternalError
9696
, ideMessage = "commandDetailCmd: ghc’s exhaustiveness checker is broken"
97-
, ideInfo = Nothing
97+
, ideInfo = Null
9898
}
9999

100100
-- ---------------------------------------------------------------------

‎src/Haskell/Ide/Engine/Dispatcher.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,7 @@ doDispatch plugins creq = do
5454
return $ Just $ IdeResponseError $ IdeError
5555
{ ideCode = UnknownPlugin
5656
, ideMessage = "No plugin found for:" <> cinPlugin creq
57-
, ideInfo = Just $ toJSON $ cinPlugin creq
57+
, ideInfo = toJSON $ cinPlugin creq
5858
}
5959
Just desc -> do
6060
let pn = cinPlugin creq
@@ -66,7 +66,7 @@ doDispatch plugins creq = do
6666
return $ Just $ IdeResponseError $ IdeError
6767
{ ideCode = UnknownCommand
6868
, ideMessage = "No such command:" <> ideCommand req
69-
, ideInfo = Just $ toJSON $ ideCommand req
69+
, ideInfo = toJSON $ ideCommand req
7070
}
7171
Just (Command cdesc cfunc) -> do
7272
case validateContexts cdesc req of
@@ -105,7 +105,7 @@ validateContexts cd req = r
105105
([], []) -> Left $ IdeResponseFail $ IdeError
106106
{ ideCode = InvalidContext
107107
, ideMessage = T.pack ("no valid context found, expecting one of:" ++ show (cmdContexts cd))
108-
, ideInfo = Nothing
108+
, ideInfo = Null
109109
}
110110
(ctxs, _) ->
111111
case checkParams (cmdAdditionalParams cd) (ideParams req) of

‎src/Haskell/Ide/Engine/Transport/JsonStdio.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ import Control.Applicative
99
import Control.Concurrent
1010
import Control.Concurrent.STM.TChan
1111
import Control.Lens (view)
12-
-- import Control.Logging
12+
import Data.Aeson
1313
import Control.Monad.IO.Class
1414
import Control.Monad.STM
1515
import Control.Monad.State.Strict
@@ -51,7 +51,7 @@ parseToJsonPipe cin cout cid =
5151
do let rsp =
5252
CResp "" cid $
5353
IdeResponseError
54-
(IdeError ParseError (T.pack $ show decodeErr) Nothing)
54+
(IdeError ParseError (T.pack $ show decodeErr) Null)
5555
liftIO $ debugm $ "jsonStdioTransport:parse error:" ++ show decodeErr
5656
liftIO $ atomically $ writeTChan cout rsp
5757
Right req ->

‎stack.yaml

+4-14
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,4 @@
1-
#resolver: lts-3.11
2-
# Nightly has ghc-mod/cabal-helper, not in lts yet
3-
resolver: nightly-2015-12-11
1+
resolver: nightly-2016-01-05
42
packages:
53
- .
64
- hie-apply-refact
@@ -11,21 +9,13 @@ packages:
119
- hie-ghc-mod
1210
- hie-hare
1311
- hie-docs-generator
14-
# - ../ghci-ng
1512
- location:
1613
git: https://github.com/kazu-yamamoto/ghc-mod.git
1714
commit: b9bd4ebf77b22d2d9061d647d7799ddcc7c51228
18-
# commit: bff86be69f556f80a8dcd9dd42774ab77cb00eba
1915
extra-dep: true
2016
- location:
21-
git: https://github.com/alanz/hlint.git
22-
commit: e32f4d3cf32d15003e54d4f42afae7bf06b50168
23-
extra-dep: true
24-
- location:
25-
git: https://github.com/alanz/apply-refact.git
26-
commit: ba98a2902e5333519e60d38803f30f82c44eaffc
17+
git: https://github.com/mpickering/apply-refact.git
18+
commit: 402458652844c1a0f42b15123e0ceff761919415
2719
extra-dep: true
2820
extra-deps:
29-
- HaRe-0.8.2.1
30-
- rosezipper-0.2
31-
- syz-0.2.0.0
21+
- hlint-1.9.26

0 commit comments

Comments
 (0)