afa2cb0 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

Remove unnecessary MonadIO and MonadFail uses

afa2cb0Eric Mertens7 years ago

src/Graphics/Vty/Output.hs+6−9

compare with master

unifiedsplit

@@ -38,9 +38,6 @@ import Graphics.Vty.Output.TerminfoBased as TerminfoBased

39import Blaze.ByteString.Builder (writeToByteString)

41−import Control.Monad.Fail (MonadFail)

42−import Control.Monad.Trans

43−

44import Data.List (isPrefixOf)

41import Data.List (isPrefixOf)

45import Data.Monoid ((<>))

42import Data.Monoid ((<>))

@@ -85,23 +82,23 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig

85-- Currently, the only way to set the cursor position to a given

82-- Currently, the only way to set the cursor position to a given

86-- character coordinate is to specify the coordinate in the Picture

83-- character coordinate is to specify the coordinate in the Picture

87-- instance provided to 'outputPicture' or 'refresh'.

84-- instance provided to 'outputPicture' or 'refresh'.

88−setCursorPos :: (MonadIO m, MonadFail m) => Output -> Int -> Int -> m ()

85+setCursorPos :: Output -> Int -> Int -> IO ()

89setCursorPos t x y = do

86setCursorPos t x y = do

90 bounds <- displayBounds t

87 bounds <- displayBounds t

91 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do

88 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do

92 dc <- displayContext t bounds

89 dc <- displayContext t bounds

93− liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

90+ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

95-- | Hides the cursor.

92-- | Hides the cursor.

96−hideCursor :: (MonadIO m, MonadFail m) => Output -> m ()

93+hideCursor :: Output -> IO ()

97hideCursor t = do

94hideCursor t = do

98 bounds <- displayBounds t

95 bounds <- displayBounds t

99 dc <- displayContext t bounds

96 dc <- displayContext t bounds

100− liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

97+ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

101

102-- | Shows the cursor.

99-- | Shows the cursor.

103−showCursor :: (MonadIO m, MonadFail m) => Output -> m ()

100+showCursor :: Output -> IO ()

104showCursor t = do

101showCursor t = do

105 bounds <- displayBounds t

102 bounds <- displayBounds t

106 dc <- displayContext t bounds

103 dc <- displayContext t bounds

107− liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

104+ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

src/Graphics/Vty/Output/Interface.hs+13−13

@@ -62,7 +62,7 @@ data Output = Output

62 terminalID :: String

63 -- | Release the terminal just prior to application exit and reset

64 -- it to its state prior to application startup.

65− , releaseTerminal :: forall m. MonadIO m => m ()

65+ , releaseTerminal :: IO ()

66 -- | Clear the display and initialize the terminal to some initial

67 -- display state.

68 --

@@ -72,12 +72,12 @@ data Output = Output

72 -- - cursor at top left

73 -- - UTF-8 character encoding

74 -- - drawing characteristics are the default

75− , reserveDisplay :: forall m. MonadIO m => m ()

75+ , reserveDisplay :: IO ()

76 -- | Return the display to the state before `reserveDisplay` If no

77 -- previous state then set the display state to the initial state.

78− , releaseDisplay :: forall m. MonadIO m => m ()

78+ , releaseDisplay :: IO ()

79 -- | Returns the current display bounds.

80− , displayBounds :: forall m. (MonadIO m, MonadFail m) => m DisplayRegion

80+ , displayBounds :: IO DisplayRegion

81 -- | Output the bytestring to the terminal device.

82 , outputByteBuffer :: BS.ByteString -> IO ()

83 -- | Specifies the maximum number of colors supported by the

@@ -89,23 +89,23 @@ data Output = Output

89 , supportsMode :: Mode -> Bool

90 -- | Enables or disables a mode (does nothing if the mode is

91 -- unsupported).

92− , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()

92+ , setMode :: Mode -> Bool -> IO ()

93 -- | Returns whether a mode is enabled.

94− , getModeStatus :: forall m. MonadIO m => Mode -> m Bool

94+ , getModeStatus :: Mode -> IO Bool

95 , assumedStateRef :: IORef AssumedState

96 -- | Acquire display access to the given region of the display.

97 -- Currently all regions have the upper left corner of (0,0) and

98 -- the lower right corner at (max displayWidth providedWidth, max

99 -- displayHeight providedHeight)

100− , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext

100+ , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext

101 -- | Ring the terminal bell if supported.

102− , ringTerminalBell :: forall m. MonadIO m => m ()

102+ , ringTerminalBell :: IO ()

103 -- | Returns whether the terminal has an audio bell feature.

104− , supportsBell :: forall m. MonadIO m => m Bool

104+ , supportsBell :: IO Bool

105 }

106

107−displayContext :: MonadIO m => Output -> DisplayRegion -> m DisplayContext

107+displayContext :: Output -> DisplayRegion -> IO DisplayContext

108−displayContext t = liftIO . mkDisplayContext t t

108+displayContext t = mkDisplayContext t t

109

110data AssumedState = AssumedState

111 { prevFattr :: Maybe FixedAttr

@@ -164,8 +164,8 @@ writeUtf8Text = writeByteString

164-- 4. Serialized to the display.

165--

166-- 5. The cursor is then shown and positioned or kept hidden.

167−outputPicture :: MonadIO m => DisplayContext -> Picture -> m ()

167+outputPicture :: DisplayContext -> Picture -> IO ()

168−outputPicture dc pic = liftIO $ do

168+outputPicture dc pic = do

169 urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink

170 as <- readIORef (assumedStateRef $ contextDevice dc)

171 let manipCursor = supportsCursorVisibility (contextDevice dc)

src/Graphics/Vty/Output/TerminfoBased.hs+14−19

@@ -25,9 +25,6 @@ import Graphics.Vty.Output.Interface

26import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable)

28−import Control.Monad.Fail (MonadFail)

29−import Control.Monad.Trans

30−

31import Data.Bits ((.&.))

28import Data.Bits ((.&.))

32import Data.Foldable (foldMap)

29import Data.Foldable (foldMap)

33import Data.IORef

30import Data.IORef

@@ -101,8 +98,8 @@ sendCapToTerminal t cap capParams = do

101--

98--

102-- * Providing independent string capabilities for all display

99-- * Providing independent string capabilities for all display

103-- attributes.

100-- attributes.

104−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

101+reserveTerminal :: String -> Fd -> IO Output

105−reserveTerminal termName outFd = liftIO $ do

102+reserveTerminal termName outFd = do

106 ti <- Terminfo.setupTerm termName

103 ti <- Terminfo.setupTerm termName

107 -- assumes set foreground always implies set background exists.

104 -- assumes set foreground always implies set background exists.

108 -- if set foreground is not set then all color changing style

105 -- if set foreground is not set then all color changing style

@@ -131,13 +128,13 @@ reserveTerminal termName outFd = liftIO $ do

131 curStatus <- terminfoModeStatus m

128 curStatus <- terminfoModeStatus m

132 when (newStatus /= curStatus) $

129 when (newStatus /= curStatus) $

133 case m of

130 case m of

134− Hyperlink -> liftIO $ do

131+ Hyperlink -> do

135 writeIORef hyperlinkModeStatus newStatus

132 writeIORef hyperlinkModeStatus newStatus

136 writeIORef newAssumedStateRef initialAssumedState

133 writeIORef newAssumedStateRef initialAssumedState

137 _ -> return ()

134 _ -> return ()

138 terminfoModeStatus m =

135 terminfoModeStatus m =

139 case m of

136 case m of

140− Hyperlink -> liftIO $ readIORef hyperlinkModeStatus

137+ Hyperlink -> readIORef hyperlinkModeStatus

141 _ -> return False

138 _ -> return False

142 terminfoModeSupported Hyperlink = True

139 terminfoModeSupported Hyperlink = True

143 terminfoModeSupported _ = False

140 terminfoModeSupported _ = False

@@ -159,22 +156,22 @@ reserveTerminal termName outFd = liftIO $ do

159 <*> probeCap ti "bel"

156 <*> probeCap ti "bel"

160 let t = Output

157 let t = Output

161 { terminalID = termName

158 { terminalID = termName

162− , releaseTerminal = liftIO $ do

159+ , releaseTerminal = do

163 sendCap setDefaultAttr []

160 sendCap setDefaultAttr []

164 maybeSendCap cnorm []

161 maybeSendCap cnorm []

165 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

162 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

166− , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []

163+ , ringTerminalBell = maybeSendCap ringBellAudio []

167− , reserveDisplay = liftIO $ do

164+ , reserveDisplay = do

168 -- If there is no support for smcup: Clear the screen

165 -- If there is no support for smcup: Clear the screen

169 -- and then move the mouse to the home position to

166 -- and then move the mouse to the home position to

170 -- approximate the behavior.

167 -- approximate the behavior.

171 maybeSendCap smcup []

168 maybeSendCap smcup []

172 sendCap clearScreen []

169 sendCap clearScreen []

173− , releaseDisplay = liftIO $ do

170+ , releaseDisplay = do

174 maybeSendCap rmcup []

171 maybeSendCap rmcup []

175 maybeSendCap cnorm []

172 maybeSendCap cnorm []

176 , displayBounds = do

173 , displayBounds = do

177− rawSize <- liftIO $ getWindowSize outFd

174+ rawSize <- getWindowSize outFd

178 case rawSize of

175 case rawSize of

179 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize

176 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize

180 | otherwise -> return (w,h)

177 | otherwise -> return (w,h)

@@ -198,33 +195,31 @@ reserveTerminal termName outFd = liftIO $ do

198 , assumedStateRef = newAssumedStateRef

195 , assumedStateRef = newAssumedStateRef

199 -- I think fix would help assure tActual is the only

196 -- I think fix would help assure tActual is the only

200 -- reference. I was having issues tho.

197 -- reference. I was having issues tho.

201− , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps

198+ , mkDisplayContext = \tActual -> terminfoDisplayContext tActual terminfoCaps

202 }

199 }

203 sendCap s = sendCapToTerminal t (s terminfoCaps)

200 sendCap s = sendCapToTerminal t (s terminfoCaps)

204 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)

201 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)

205 return t

202 return t

206

203

207−requireCap :: (Applicative m, MonadIO m, MonadFail m) => Terminfo.Terminal -> String -> m CapExpression

204+requireCap :: Terminfo.Terminal -> String -> IO CapExpression

208requireCap ti capName

205requireCap ti capName

209 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

206 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

210 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""

207 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""

211 Just capStr -> parseCap capStr

208 Just capStr -> parseCap capStr

212

209

213−probeCap :: (Applicative m, MonadIO m, MonadFail m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)

210+probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)

214probeCap ti capName

211probeCap ti capName

215 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

212 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

216 Nothing -> return Nothing

213 Nothing -> return Nothing

217 Just capStr -> Just <$> parseCap capStr

214 Just capStr -> Just <$> parseCap capStr

218

215

219−parseCap :: (Applicative m, MonadIO m, MonadFail m) => String -> m CapExpression

216+parseCap :: String -> IO CapExpression

220parseCap capStr = do

217parseCap capStr = do

221 case parseCapExpression capStr of

218 case parseCapExpression capStr of

222 Left e -> fail $ show e

219 Left e -> fail $ show e

223 Right cap -> return cap

220 Right cap -> return cap

224

221

225−currentDisplayAttrCaps :: ( Applicative m, MonadIO m, MonadFail m )

226− => Terminfo.Terminal

222+currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps

227− -> m DisplayAttrCaps

228currentDisplayAttrCaps ti

223currentDisplayAttrCaps ti

229 = pure DisplayAttrCaps

224 = pure DisplayAttrCaps

230 <*> probeCap ti "sgr"

225 <*> probeCap ti "sgr"