afa2cb0 · vty · git.iko.soy

git.iko.soy/vty

Remove unnecessary MonadIO and MonadFail uses

commitafa2cb06002cc6ab42b17302b82cdcfc31e46bec authorEric Mertens <emertens@galois.com> dateMon 30 Sep 2019, 16:51 (7 years ago) parent66a2f01

3 files changed+33−41

compare with master

unifiedsplit

src/Graphics/Vty/Output.hs+6−9 src/Graphics/Vty/Output/Interface.hs+13−13 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−13

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

6262 terminalID :: String

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

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

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

65+ , releaseTerminal :: IO ()

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

6767 -- display state.

6868 --

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

7272 -- - cursor at top left

7373 -- - UTF-8 character encoding

7474 -- - drawing characteristics are the default

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

75+ , reserveDisplay :: IO ()

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

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

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

78+ , releaseDisplay :: IO ()

7979 -- | Returns the current display bounds.

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

80+ , displayBounds :: IO DisplayRegion

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

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

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

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

8989 , supportsMode :: Mode -> Bool

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

9191 -- unsupported).

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

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

9393 -- | Returns whether a mode is enabled.

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

94+ , getModeStatus :: Mode -> IO Bool

9595 , assumedStateRef :: IORef AssumedState

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

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

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

9999 -- displayHeight providedHeight)

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

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

101101 -- | Ring the terminal bell if supported.

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

102+ , ringTerminalBell :: IO ()

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

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

104+ , supportsBell :: IO Bool

105105 }

106106

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

108−displayContext t = liftIO . mkDisplayContext t t

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

108+displayContext t = mkDisplayContext t t

109109

110110data AssumedState = AssumedState

111111 { prevFattr :: Maybe FixedAttr

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

164164-- 4. Serialized to the display.

165165--

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

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

168−outputPicture dc pic = liftIO $ do

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

168+outputPicture dc pic = do

169169 urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink

170170 as <- readIORef (assumedStateRef $ contextDevice dc)

171171 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"