Remove unnecessary MonadIO and MonadFail uses

src/Graphics/Vty/Output.hs

@@ -38,9 +38,6 @@ import Graphics.Vty.Output.TerminfoBased as TerminfoBased
 
 import Blaze.ByteString.Builder (writeToByteString)
 
-import Control.Monad.Fail (MonadFail)
-import Control.Monad.Trans
-
 import Data.List (isPrefixOf)
 import Data.Monoid ((<>))
 
@@ -85,23 +82,23 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig
 -- Currently, the only way to set the cursor position to a given
 -- character coordinate is to specify the coordinate in the Picture
 -- instance provided to 'outputPicture' or 'refresh'.
-setCursorPos :: (MonadIO m, MonadFail m) => Output -> Int -> Int -> m ()
+setCursorPos :: Output -> Int -> Int -> IO ()
 setCursorPos t x y = do
     bounds <- displayBounds t
     when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do
         dc <- displayContext t bounds
-        liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y
+        outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y
 
 -- | Hides the cursor.
-hideCursor :: (MonadIO m, MonadFail m) => Output -> m ()
+hideCursor :: Output -> IO ()
 hideCursor t = do
     bounds <- displayBounds t
     dc <- displayContext t bounds
-    liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc
+    outputByteBuffer t $ writeToByteString $ writeHideCursor dc
 
 -- | Shows the cursor.
-showCursor :: (MonadIO m, MonadFail m) => Output -> m ()
+showCursor :: Output -> IO ()
 showCursor t = do
     bounds <- displayBounds t
     dc <- displayContext t bounds
-    liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc
+    outputByteBuffer t $ writeToByteString $ writeShowCursor dc

src/Graphics/Vty/Output/Interface.hs

@@ -29,9 +29,6 @@ import Graphics.Vty.DisplayAttributes
 import Blaze.ByteString.Builder (Write, writeToByteString)
 import Blaze.ByteString.Builder.ByteString (writeByteString)
 
-import Control.Monad.Fail (MonadFail)
-import Control.Monad.Trans
-
 import qualified Data.ByteString as BS
 import Data.IORef
 import qualified Data.Text.Encoding as T
@@ -62,7 +59,7 @@ data Output = Output
       terminalID :: String
       -- | Release the terminal just prior to application exit and reset
       -- it to its state prior to application startup.
-    , releaseTerminal :: forall m. MonadIO m => m ()
+    , releaseTerminal :: IO ()
       -- | Clear the display and initialize the terminal to some initial
       -- display state.
       --
@@ -72,12 +69,12 @@ data Output = Output
       --  - cursor at top left
       --  - UTF-8 character encoding
       --  - drawing characteristics are the default
-    , reserveDisplay :: forall m. MonadIO m => m ()
+    , reserveDisplay :: IO ()
       -- | Return the display to the state before `reserveDisplay` If no
       -- previous state then set the display state to the initial state.
-    , releaseDisplay :: forall m. MonadIO m => m ()
+    , releaseDisplay :: IO ()
       -- | Returns the current display bounds.
-    , displayBounds :: forall m. (MonadIO m, MonadFail m) => m DisplayRegion
+    , displayBounds :: IO DisplayRegion
       -- | Output the bytestring to the terminal device.
     , outputByteBuffer :: BS.ByteString -> IO ()
       -- | Specifies the maximum number of colors supported by the
@@ -89,23 +86,23 @@ data Output = Output
     , supportsMode :: Mode -> Bool
       -- | Enables or disables a mode (does nothing if the mode is
       -- unsupported).
-    , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()
+    , setMode :: Mode -> Bool -> IO ()
       -- | Returns whether a mode is enabled.
-    , getModeStatus :: forall m. MonadIO m => Mode -> m Bool
+    , getModeStatus :: Mode -> IO Bool
     , assumedStateRef :: IORef AssumedState
       -- | Acquire display access to the given region of the display.
       -- Currently all regions have the upper left corner of (0,0) and
       -- the lower right corner at (max displayWidth providedWidth, max
       -- displayHeight providedHeight)
-    , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext
+    , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext
       -- | Ring the terminal bell if supported.
-    , ringTerminalBell :: forall m. MonadIO m => m ()
+    , ringTerminalBell :: IO ()
       -- | Returns whether the terminal has an audio bell feature.
-    , supportsBell :: forall m. MonadIO m => m Bool
+    , supportsBell :: IO Bool
     }
 
-displayContext :: MonadIO m => Output -> DisplayRegion -> m DisplayContext
-displayContext t = liftIO . mkDisplayContext t t
+displayContext :: Output -> DisplayRegion -> IO DisplayContext
+displayContext t = mkDisplayContext t t
 
 data AssumedState = AssumedState
     { prevFattr :: Maybe FixedAttr
@@ -164,8 +161,8 @@ writeUtf8Text = writeByteString
 --      4. Serialized to the display.
 --
 --      5. The cursor is then shown and positioned or kept hidden.
-outputPicture :: MonadIO m => DisplayContext -> Picture -> m ()
-outputPicture dc pic = liftIO $ do
+outputPicture :: DisplayContext -> Picture -> IO ()
+outputPicture dc pic = do
     urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink
     as <- readIORef (assumedStateRef $ contextDevice dc)
     let manipCursor = supportsCursorVisibility (contextDevice dc)

src/Graphics/Vty/Output/TerminfoBased.hs

@@ -25,9 +25,6 @@ import Graphics.Vty.Output.Interface
 
 import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable)
 
-import Control.Monad.Fail (MonadFail)
-import Control.Monad.Trans
-
 import Data.Bits ((.&.))
 import Data.Foldable (foldMap)
 import Data.IORef
@@ -101,8 +98,8 @@ sendCapToTerminal t cap capParams = do
 --
 --  * Providing independent string capabilities for all display
 --    attributes.
-reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output
-reserveTerminal termName outFd = liftIO $ do
+reserveTerminal :: String -> Fd -> IO Output
+reserveTerminal termName outFd = do
     ti <- Terminfo.setupTerm termName
     -- assumes set foreground always implies set background exists.
     -- if set foreground is not set then all color changing style
@@ -131,13 +128,13 @@ reserveTerminal termName outFd = liftIO $ do
           curStatus <- terminfoModeStatus m
           when (newStatus /= curStatus) $
               case m of
-                  Hyperlink -> liftIO $ do
+                  Hyperlink -> do
                       writeIORef hyperlinkModeStatus newStatus
                       writeIORef newAssumedStateRef initialAssumedState
                   _ -> return ()
         terminfoModeStatus m =
             case m of
-                Hyperlink -> liftIO $ readIORef hyperlinkModeStatus
+                Hyperlink -> readIORef hyperlinkModeStatus
                 _ -> return False
         terminfoModeSupported Hyperlink = True
         terminfoModeSupported _ = False
@@ -159,22 +156,22 @@ reserveTerminal termName outFd = liftIO $ do
         <*> probeCap ti "bel"
     let t = Output
             { terminalID = termName
-            , releaseTerminal = liftIO $ do
+            , releaseTerminal = do
                 sendCap setDefaultAttr []
                 maybeSendCap cnorm []
             , supportsBell = return $ isJust $ ringBellAudio terminfoCaps
-            , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []
-            , reserveDisplay = liftIO $ do
+            , ringTerminalBell = maybeSendCap ringBellAudio []
+            , reserveDisplay = do
                 -- If there is no support for smcup: Clear the screen
                 -- and then move the mouse to the home position to
                 -- approximate the behavior.
                 maybeSendCap smcup []
                 sendCap clearScreen []
-            , releaseDisplay = liftIO $ do
+            , releaseDisplay = do
                 maybeSendCap rmcup []
                 maybeSendCap cnorm []
             , displayBounds = do
-                rawSize <- liftIO $ getWindowSize outFd
+                rawSize <- getWindowSize outFd
                 case rawSize of
                     (w, h)  | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize
                             | otherwise      -> return (w,h)
@@ -198,33 +195,31 @@ reserveTerminal termName outFd = liftIO $ do
             , assumedStateRef = newAssumedStateRef
             -- I think fix would help assure tActual is the only
             -- reference. I was having issues tho.
-            , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps
+            , mkDisplayContext = \tActual -> terminfoDisplayContext tActual terminfoCaps
             }
         sendCap s = sendCapToTerminal t (s terminfoCaps)
         maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)
     return t
 
-requireCap :: (Applicative m, MonadIO m, MonadFail m) => Terminfo.Terminal -> String -> m CapExpression
+requireCap :: Terminfo.Terminal -> String -> IO CapExpression
 requireCap ti capName
     = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
         Nothing     -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""
         Just capStr -> parseCap capStr
 
-probeCap :: (Applicative m, MonadIO m, MonadFail m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)
+probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)
 probeCap ti capName
     = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
         Nothing     -> return Nothing
         Just capStr -> Just <$> parseCap capStr
 
-parseCap :: (Applicative m, MonadIO m, MonadFail m) => String -> m CapExpression
+parseCap :: String -> IO CapExpression
 parseCap capStr = do
     case parseCapExpression capStr of
         Left e -> fail $ show e
         Right cap -> return cap
 
-currentDisplayAttrCaps :: ( Applicative m, MonadIO m, MonadFail m )
-                       => Terminfo.Terminal
-                       -> m DisplayAttrCaps
+currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps
 currentDisplayAttrCaps ti
     =   pure DisplayAttrCaps
     <*> probeCap ti "sgr"