6aa1d05 · vty · git.iko.soy

git.iko.soy/vty

Merge pull request #177 from glguy/just-io-patch

Remove unnecessary MonadIO and MonadFail uses

commit6aa1d0539bf6ae8c944fc8ce0cdbb97ddfac570a authorJonathan Daugherty <cygnus@foobox.com> dateTue 1 Oct 2019, 09:33 (7 years ago) parent66a2f01 4fcd927

3 files changed+33−44

compare with master

unifiedsplit

src/Graphics/Vty/Output.hs+6−9 src/Graphics/Vty/Output/Interface.hs+13−16 src/Graphics/Vty/Output/TerminfoBased.hs+14−19

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

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

3838

3939import Blaze.ByteString.Builder (writeToByteString)

4040

41−import Control.Monad.Fail (MonadFail)

42−import Control.Monad.Trans

43−

4441import Data.List (isPrefixOf)

4542import Data.Monoid ((<>))

4643

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

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

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

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

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

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

8986setCursorPos t x y = do

9087 bounds <- displayBounds t

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

9289 dc <- displayContext t bounds

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

90+ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

9491

9592-- | Hides the cursor.

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

93+hideCursor :: Output -> IO ()

9794hideCursor t = do

9895 bounds <- displayBounds t

9996 dc <- displayContext t bounds

100− liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

97+ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

10198

10299-- | Shows the cursor.

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

100+showCursor :: Output -> IO ()

104101showCursor t = do

105102 bounds <- displayBounds t

106103 dc <- displayContext t bounds

107− liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

104+ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

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

@@ -29,9 +29,6 @@ import Graphics.Vty.DisplayAttributes

2929import Blaze.ByteString.Builder (Write, writeToByteString)

3030import Blaze.ByteString.Builder.ByteString (writeByteString)

3131

32−import Control.Monad.Fail (MonadFail)

33−import Control.Monad.Trans

34−

3532import qualified Data.ByteString as BS

3633import Data.IORef

3734import qualified Data.Text.Encoding as T

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

6259 terminalID :: String

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

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

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

62+ , releaseTerminal :: IO ()

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

6764 -- display state.

6865 --

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

7269 -- - cursor at top left

7370 -- - UTF-8 character encoding

7471 -- - drawing characteristics are the default

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

72+ , reserveDisplay :: IO ()

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

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

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

75+ , releaseDisplay :: IO ()

7976 -- | Returns the current display bounds.

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

77+ , displayBounds :: IO DisplayRegion

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

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

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

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

8986 , supportsMode :: Mode -> Bool

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

9188 -- unsupported).

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

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

9390 -- | Returns whether a mode is enabled.

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

91+ , getModeStatus :: Mode -> IO Bool

9592 , assumedStateRef :: IORef AssumedState

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

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

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

9996 -- displayHeight providedHeight)

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

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

10198 -- | Ring the terminal bell if supported.

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

99+ , ringTerminalBell :: IO ()

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

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

101+ , supportsBell :: IO Bool

105102 }

106103

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

108−displayContext t = liftIO . mkDisplayContext t t

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

105+displayContext t = mkDisplayContext t t

109106

110107data AssumedState = AssumedState

111108 { prevFattr :: Maybe FixedAttr

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

164161-- 4. Serialized to the display.

165162--

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

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

168−outputPicture dc pic = liftIO $ do

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

165+outputPicture dc pic = do

169166 urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink

170167 as <- readIORef (assumedStateRef $ contextDevice dc)

171168 let manipCursor = supportsCursorVisibility (contextDevice dc)

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

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

2525

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

2727

28−import Control.Monad.Fail (MonadFail)

29−import Control.Monad.Trans

30−

3128import Data.Bits ((.&.))

3229import Data.Foldable (foldMap)

3330import Data.IORef

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

10198--

10299-- * Providing independent string capabilities for all display

103100-- attributes.

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

105−reserveTerminal termName outFd = liftIO $ do

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

102+reserveTerminal termName outFd = do

106103 ti <- Terminfo.setupTerm termName

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

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

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

131128 curStatus <- terminfoModeStatus m

132129 when (newStatus /= curStatus) $

133130 case m of

134− Hyperlink -> liftIO $ do

131+ Hyperlink -> do

135132 writeIORef hyperlinkModeStatus newStatus

136133 writeIORef newAssumedStateRef initialAssumedState

137134 _ -> return ()

138135 terminfoModeStatus m =

139136 case m of

140− Hyperlink -> liftIO $ readIORef hyperlinkModeStatus

137+ Hyperlink -> readIORef hyperlinkModeStatus

141138 _ -> return False

142139 terminfoModeSupported Hyperlink = True

143140 terminfoModeSupported _ = False

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

159156 <*> probeCap ti "bel"

160157 let t = Output

161158 { terminalID = termName

162− , releaseTerminal = liftIO $ do

159+ , releaseTerminal = do

163160 sendCap setDefaultAttr []

164161 maybeSendCap cnorm []

165162 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

166− , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []

167− , reserveDisplay = liftIO $ do

163+ , ringTerminalBell = maybeSendCap ringBellAudio []

164+ , reserveDisplay = do

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

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

170167 -- approximate the behavior.

171168 maybeSendCap smcup []

172169 sendCap clearScreen []

173− , releaseDisplay = liftIO $ do

170+ , releaseDisplay = do

174171 maybeSendCap rmcup []

175172 maybeSendCap cnorm []

176173 , displayBounds = do

177− rawSize <- liftIO $ getWindowSize outFd

174+ rawSize <- getWindowSize outFd

178175 case rawSize of

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

180177 | otherwise -> return (w,h)

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

198195 , assumedStateRef = newAssumedStateRef

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

200197 -- reference. I was having issues tho.

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

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

202199 }

203200 sendCap s = sendCapToTerminal t (s terminfoCaps)

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

205202 return t

206203

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

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

208205requireCap ti capName

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

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

211208 Just capStr -> parseCap capStr

212209

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

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

214211probeCap ti capName

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

216213 Nothing -> return Nothing

217214 Just capStr -> Just <$> parseCap capStr

218215

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

216+parseCap :: String -> IO CapExpression

220217parseCap capStr = do

221218 case parseCapExpression capStr of

222219 Left e -> fail $ show e

223220 Right cap -> return cap

224221

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

226− => Terminfo.Terminal

227− -> m DisplayAttrCaps

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

228223currentDisplayAttrCaps ti

229224 = pure DisplayAttrCaps

230225 <*> probeCap ti "sgr"