module System.Console.Haskeline.Term where

import System.Console.Haskeline.Monads
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Key
import System.Console.Haskeline.Prefs(Prefs)
import System.Console.Haskeline.Completion(Completion)

import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception (Exception, SomeException(..))
import Control.Monad.Catch
    ( MonadMask
    , bracket
    , handle
    , throwM
    , finally
    )
import Data.Word
import Control.Exception (fromException, AsyncException(..))
import Data.Typeable
import System.IO
import Control.Monad(liftM,when,guard)
import System.IO.Error (isEOFError)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC

class (MonadReader Layout m, MonadIO m, MonadMask m) => Term m where
    reposition :: Layout -> LineChars -> m ()
    moveToNextLine :: LineChars -> m ()
    printLines :: [String] -> m ()
    drawLineDiff :: LineChars -> LineChars -> m ()
    clearLayout :: m ()
    ringBell :: Bool -> m ()

drawLine, clearLine :: Term m => LineChars -> m ()
drawLine :: LineChars -> m ()
drawLine = LineChars -> LineChars -> m ()
forall (m :: * -> *). Term m => LineChars -> LineChars -> m ()
Evidence bound by a type signature of the constraint type Term m
drawLineDiff ([],[])

clearLine :: LineChars -> m ()
clearLine = (LineChars -> LineChars -> m ()) -> LineChars -> LineChars -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LineChars -> LineChars -> m ()
forall (m :: * -> *). Term m => LineChars -> LineChars -> m ()
Evidence bound by a type signature of the constraint type Term m
drawLineDiff ([],[])

data RunTerm = RunTerm {
            -- | Write unicode characters to stdout.
            RunTerm -> String -> IO ()
putStrOut :: String -> IO (),
            RunTerm -> Either TermOps FileOps
termOps :: Either TermOps FileOps,
            RunTerm
-> forall a (m :: * -> *). (MonadIO m, MonadMask m) => m a -> m a
Evidence bound by a HsWrapper of the constraint type MonadMask m
Evidence bound by a HsWrapper of the constraint type MonadIO m
wrapInterrupt :: forall a m . (MonadIO m, MonadMask m) => m a -> m a,
            RunTerm -> IO ()
closeTerm :: IO ()
    }

-- | Operations needed for terminal-style interaction.
data TermOps = TermOps
    { TermOps -> IO Layout
getLayout :: IO Layout
    , TermOps
-> forall (m :: * -> *) a.
   CommandMonad m =>
   (m Event -> m a) -> m a
Evidence bound by a HsWrapper of the constraint type CommandMonad m
withGetEvent :: forall m a . CommandMonad m => (m Event -> m a) -> m a
    , TermOps -> forall (m :: * -> *). CommandMonad m => EvalTerm m
Evidence bound by a HsWrapper of the constraint type CommandMonad m
evalTerm :: forall m . CommandMonad m => EvalTerm m
    , TermOps -> [Key] -> IO ()
saveUnusedKeys :: [Key] -> IO ()
    , TermOps -> String -> IO ()
externalPrint :: String -> IO ()
    }

-- This hack is needed to grab latest writes from some other thread.
-- Without it, if you are using another thread to process the logging
-- and write on screen via exposed externalPrint, latest writes from
-- this thread are not able to cross the thread boundary in time.
flushEventQueue :: (String -> IO ()) -> TChan Event -> IO ()
flushEventQueue :: (String -> IO ()) -> TChan Event -> IO ()
flushEventQueue String -> IO ()
print' TChan Event
eventChan = IO ()
yield IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> IO ()
loopUntilFlushed
    where loopUntilFlushed :: IO ()
loopUntilFlushed = do
              Bool
flushed <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TChan Event -> STM Bool
forall a. TChan a -> STM Bool
isEmptyTChan TChan Event
eventChan
              if Bool
flushed then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return () else do
                  Event
event <- STM Event -> IO Event
forall a. STM a -> IO a
atomically (STM Event -> IO Event) -> STM Event -> IO Event
forall a b. (a -> b) -> a -> b
$ TChan Event -> STM Event
forall a. TChan a -> STM a
readTChan TChan Event
eventChan
                  case Event
event of
                      ExternalPrint String
str -> do
                          String -> IO ()
print' (String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> IO ()
loopUntilFlushed
                      -- We don't want to raise exceptions when doing cleanup.
                      Event
_ -> IO ()
loopUntilFlushed

-- | Operations needed for file-style interaction.
--
-- Backends can assume that getLocaleLine, getLocaleChar and maybeReadNewline
-- are "wrapped" by wrapFileInput.
data FileOps = FileOps {
            FileOps
-> forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
Evidence bound by a HsWrapper of the constraint type MonadMask m
Evidence bound by a HsWrapper of the constraint type MonadIO m
withoutInputEcho :: forall m a . (MonadIO m, MonadMask m) => m a -> m a,
            -- ^ Perform an action without echoing input.
            FileOps -> forall a. IO a -> IO a
wrapFileInput :: forall a . IO a -> IO a,
            FileOps -> MaybeT IO String
getLocaleLine :: MaybeT IO String,
            FileOps -> MaybeT IO Char
getLocaleChar :: MaybeT IO Char,
            FileOps -> IO ()
maybeReadNewline :: IO ()
        }

-- | Are we using terminal-style interaction?
isTerminalStyle :: RunTerm -> Bool
isTerminalStyle :: RunTerm -> Bool
isTerminalStyle RunTerm
r = case RunTerm -> Either TermOps FileOps
termOps RunTerm
r of
                    Left TermOps{} -> Bool
True
                    Either TermOps FileOps
_ -> Bool
False

-- Specific, hidden terminal action type
-- Generic terminal actions which are independent of the Term being used.
data EvalTerm m
    = forall n . (Term n, CommandMonad n)
            => EvalTerm (forall a . n a -> m a) (forall a . m a -> n a)

mapEvalTerm :: (forall a . n a -> m a) -> (forall a . m a -> n a)
        -> EvalTerm n -> EvalTerm m
mapEvalTerm :: (forall a. n a -> m a)
-> (forall a. m a -> n a) -> EvalTerm n -> EvalTerm m
mapEvalTerm forall a. n a -> m a
eval forall a. m a -> n a
liftE (EvalTerm forall a. n a -> n a
eval' forall a. n a -> n a
liftE')
    = (forall a. n a -> m a) -> (forall a. m a -> n a) -> EvalTerm m
forall (m :: * -> *) (n :: * -> *).
(Term n, CommandMonad n) =>
(forall a. n a -> m a) -> (forall a. m a -> n a) -> EvalTerm m
Evidence bound by a pattern of the constraint type CommandMonad n
Evidence bound by a pattern of the constraint type Term n
EvalTerm (n a -> m a
forall a. n a -> m a
eval (n a -> m a) -> (n a -> n a) -> n a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n a -> n a
forall a. n a -> n a
eval') (n a -> n a
forall a. n a -> n a
liftE' (n a -> n a) -> (m a -> n a) -> m a -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n a
forall a. m a -> n a
liftE)

data Interrupt = Interrupt
                deriving (Int -> Interrupt -> String -> String
[Interrupt] -> String -> String
Interrupt -> String
(Int -> Interrupt -> String -> String)
-> (Interrupt -> String)
-> ([Interrupt] -> String -> String)
-> Show Interrupt
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Interrupt] -> String -> String
$cshowList :: [Interrupt] -> String -> String
show :: Interrupt -> String
$cshow :: Interrupt -> String
showsPrec :: Int -> Interrupt -> String -> String
$cshowsPrec :: Int -> Interrupt -> String -> String
Show,Typeable,Interrupt -> Interrupt -> Bool
(Interrupt -> Interrupt -> Bool)
-> (Interrupt -> Interrupt -> Bool) -> Eq Interrupt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interrupt -> Interrupt -> Bool
$c/= :: Interrupt -> Interrupt -> Bool
== :: Interrupt -> Interrupt -> Bool
$c== :: Interrupt -> Interrupt -> Bool
Eq)

instance Exception Interrupt where



class (MonadReader Prefs m , MonadReader Layout m, MonadIO m, MonadMask m)
        => CommandMonad m where
    runCompletion :: (String,String) -> m (String,[Completion])

instance {-# OVERLAPPABLE #-} (MonadTrans t, CommandMonad m, MonadReader Prefs (t m),
        MonadIO (t m), MonadMask (t m),
        MonadReader Layout (t m))
            => CommandMonad (t m) where
    runCompletion :: (String, String) -> t m (String, [Completion])
runCompletion = m (String, [Completion]) -> t m (String, [Completion])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadIO m => Monad m
Evidence bound by a superclass of: CommandMonad of the constraint type forall (m :: * -> *). CommandMonad m => MonadIO m
Evidence bound by a type signature of the constraint type CommandMonad m
Evidence bound by a type signature of the constraint type MonadTrans t
lift (m (String, [Completion]) -> t m (String, [Completion]))
-> ((String, String) -> m (String, [Completion]))
-> (String, String)
-> t m (String, [Completion])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> m (String, [Completion])
forall (m :: * -> *).
CommandMonad m =>
(String, String) -> m (String, [Completion])
Evidence bound by a type signature of the constraint type CommandMonad m
runCompletion

-- Utility function for drawLineDiff instances.
matchInit :: Eq a => [a] -> [a] -> ([a],[a])
matchInit :: [a] -> [a] -> ([a], [a])
matchInit (a
x:[a]
xs) (a
y:[a]
ys)  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
Evidence bound by a type signature of the constraint type Eq a
== a
y = [a] -> [a] -> ([a], [a])
forall a. Eq a => [a] -> [a] -> ([a], [a])
Evidence bound by a type signature of the constraint type Eq a
matchInit [a]
xs [a]
ys
matchInit [a]
xs [a]
ys = ([a]
xs,[a]
ys)

data Event
  = WindowResize
  | KeyInput [Key]
  | ErrorEvent SomeException
  | ExternalPrint String
  deriving Int -> Event -> String -> String
[Event] -> String -> String
Event -> String
(Int -> Event -> String -> String)
-> (Event -> String) -> ([Event] -> String -> String) -> Show Event
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Event] -> String -> String
$cshowList :: [Event] -> String -> String
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> String -> String
$cshowsPrec :: Int -> Event -> String -> String
External instance of the constraint type Show Char
External instance of the constraint type Show Key
External instance of the constraint type Show Char
External instance of the constraint type Show SomeException
External instance of the constraint type Show Key
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
Show

keyEventLoop :: IO [Event] -> TChan Event -> IO Event
keyEventLoop :: IO [Event] -> TChan Event -> IO Event
keyEventLoop IO [Event]
readEvents TChan Event
eventChan = do
    -- first, see if any events are already queued up (from a key/ctrl-c
    -- event or from a previous call to getEvent where we read in multiple
    -- keys)
    Bool
isEmpty <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TChan Event -> STM Bool
forall a. TChan a -> STM Bool
isEmptyTChan TChan Event
eventChan
    if Bool -> Bool
not Bool
isEmpty
        then STM Event -> IO Event
forall a. STM a -> IO a
atomically (STM Event -> IO Event) -> STM Event -> IO Event
forall a b. (a -> b) -> a -> b
$ TChan Event -> STM Event
forall a. TChan a -> STM a
readTChan TChan Event
eventChan
        else do
            ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
handleErrorEvent IO ()
readerLoop
            STM Event -> IO Event
forall a. STM a -> IO a
atomically (TChan Event -> STM Event
forall a. TChan a -> STM a
readTChan TChan Event
eventChan) IO Event -> IO () -> IO Event
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
External instance of the constraint type MonadMask IO
`finally` ThreadId -> IO ()
killThread ThreadId
tid
  where
    readerLoop :: IO ()
readerLoop = do
        [Event]
es <- IO [Event]
readEvents
        if [Event] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [Event]
es
            then IO ()
readerLoop
            else STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Event -> STM ()) -> [Event] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
External instance of the constraint type Monad STM
External instance of the constraint type Foldable []
mapM_ (TChan Event -> Event -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan Event
eventChan) [Event]
es
    handleErrorEvent :: IO () -> IO ()
handleErrorEvent = (SomeException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
External instance of the constraint type Exception SomeException
External instance of the constraint type MonadCatch IO
handle ((SomeException -> IO ()) -> IO () -> IO ())
-> (SomeException -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> case SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
External instance of the constraint type Exception AsyncException
fromException SomeException
e of
                                Just AsyncException
ThreadKilled -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()
                                Maybe AsyncException
_ -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan Event -> Event -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan Event
eventChan (SomeException -> Event
ErrorEvent SomeException
e)

saveKeys :: TChan Event -> [Key] -> IO ()
saveKeys :: TChan Event -> [Key] -> IO ()
saveKeys TChan Event
ch = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> ([Key] -> STM ()) -> [Key] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TChan Event -> Event -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan Event
ch (Event -> STM ()) -> ([Key] -> Event) -> [Key] -> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key] -> Event
KeyInput

data Layout = Layout {Layout -> Int
width, Layout -> Int
height :: Int}
                    deriving (Int -> Layout -> String -> String
[Layout] -> String -> String
Layout -> String
(Int -> Layout -> String -> String)
-> (Layout -> String)
-> ([Layout] -> String -> String)
-> Show Layout
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Layout] -> String -> String
$cshowList :: [Layout] -> String -> String
show :: Layout -> String
$cshow :: Layout -> String
showsPrec :: Int -> Layout -> String -> String
$cshowsPrec :: Int -> Layout -> String -> String
External instance of the constraint type Show Int
External instance of the constraint type Show Int
External instance of the constraint type Ord Int
Show,Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c== :: Layout -> Layout -> Bool
External instance of the constraint type Eq Int
External instance of the constraint type Eq Int
Eq)

-----------------------------------
-- Utility functions for the various backends.

-- | Utility function since we're not using the new IO library yet.
hWithBinaryMode :: (MonadIO m, MonadMask m) => Handle -> m a -> m a
hWithBinaryMode :: Handle -> m a -> m a
hWithBinaryMode Handle
h = m (Maybe TextEncoding)
-> (Maybe TextEncoding -> m ())
-> (Maybe TextEncoding -> m a)
-> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
Evidence bound by a type signature of the constraint type MonadMask m
bracket (IO (Maybe TextEncoding) -> m (Maybe TextEncoding)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Evidence bound by a type signature of the constraint type MonadIO m
liftIO (IO (Maybe TextEncoding) -> m (Maybe TextEncoding))
-> IO (Maybe TextEncoding) -> m (Maybe TextEncoding)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
h)
                        (m () -> (TextEncoding -> m ()) -> Maybe TextEncoding -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadIO m => Monad m
Evidence bound by a type signature of the constraint type MonadIO m
return ()) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Evidence bound by a type signature of the constraint type MonadIO m
liftIO (IO () -> m ()) -> (TextEncoding -> IO ()) -> TextEncoding -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h))
                        ((Maybe TextEncoding -> m a) -> m a)
-> (m a -> Maybe TextEncoding -> m a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Maybe TextEncoding -> m a
forall a b. a -> b -> a
const (m a -> Maybe TextEncoding -> m a)
-> (m a -> m a) -> m a -> Maybe TextEncoding -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Evidence bound by a type signature of the constraint type MonadIO m
liftIO (Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
True) m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadIO m => Monad m
Evidence bound by a type signature of the constraint type MonadIO m
>>)

-- | Utility function for changing a property of a terminal for the duration of
-- a computation.
bracketSet :: (MonadMask m, MonadIO m) => IO a -> (a -> IO ()) -> a -> m b -> m b
bracketSet :: IO a -> (a -> IO ()) -> a -> m b -> m b
bracketSet IO a
getState a -> IO ()
set a
newState m b
f = m a -> (a -> m ()) -> (a -> m b) -> m b
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
Evidence bound by a type signature of the constraint type MonadMask m
bracket (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Evidence bound by a type signature of the constraint type MonadIO m
liftIO IO a
getState)
                            (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Evidence bound by a type signature of the constraint type MonadIO m
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
set)
                            (\a
_ -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Evidence bound by a type signature of the constraint type MonadIO m
liftIO (a -> IO ()
set a
newState) m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadThrow m => Monad m
External instance of the constraint type forall (m :: * -> *). MonadCatch m => MonadThrow m
External instance of the constraint type forall (m :: * -> *). MonadMask m => MonadCatch m
Evidence bound by a type signature of the constraint type MonadMask m
>> m b
f)

-- | Returns one 8-bit word.  Needs to be wrapped by hWithBinaryMode.
hGetByte :: Handle -> MaybeT IO Word8
hGetByte :: Handle -> MaybeT IO Word8
hGetByte = (Handle -> IO Word8) -> Handle -> MaybeT IO Word8
forall a. (Handle -> IO a) -> Handle -> MaybeT IO a
guardedEOF ((Handle -> IO Word8) -> Handle -> MaybeT IO Word8)
-> (Handle -> IO Word8) -> Handle -> MaybeT IO Word8
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> IO Char -> IO Word8
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
External instance of the constraint type Monad IO
liftM (Int -> Word8
forall a. Enum a => Int -> a
External instance of the constraint type Enum Word8
toEnum (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
External instance of the constraint type Enum Char
fromEnum) (IO Char -> IO Word8) -> (Handle -> IO Char) -> Handle -> IO Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Char
hGetChar

guardedEOF :: (Handle -> IO a) -> Handle -> MaybeT IO a
guardedEOF :: (Handle -> IO a) -> Handle -> MaybeT IO a
guardedEOF Handle -> IO a
f Handle
h = do
    Bool
eof <- IO Bool -> MaybeT IO Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type Monad IO
External instance of the constraint type MonadTrans MaybeT
lift (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
hIsEOF Handle
h
    Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
External instance of the constraint type forall (m :: * -> *).
(Functor m, Monad m) =>
Alternative (MaybeT m)
External instance of the constraint type Functor IO
External instance of the constraint type Monad IO
guard (Bool -> Bool
not Bool
eof)
    IO a -> MaybeT IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type Monad IO
External instance of the constraint type MonadTrans MaybeT
lift (IO a -> MaybeT IO a) -> IO a -> MaybeT IO a
forall a b. (a -> b) -> a -> b
$ Handle -> IO a
f Handle
h

-- If another character is immediately available, and it is a newline, consume it.
--
-- Two portability fixes:
--
-- 1) By itself, this (by using hReady) might crash on invalid characters.
-- The handle should be set to binary mode or a TextEncoder that
-- transliterates or ignores invalid input.
--
-- 1) Note that in ghc-6.8.3 and earlier, hReady returns False at an EOF,
-- whereas in ghc-6.10.1 and later it throws an exception.  (GHC trac #1063).
-- This code handles both of those cases.
hMaybeReadNewline :: Handle -> IO ()
hMaybeReadNewline :: Handle -> IO ()
hMaybeReadNewline Handle
h = () -> IO () -> IO ()
forall (m :: * -> *) a. MonadMask m => a -> m a -> m a
External instance of the constraint type MonadMask IO
returnOnEOF () (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
ready <- Handle -> IO Bool
hReady Handle
h
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
when Bool
ready (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Char
c <- Handle -> IO Char
hLookAhead Handle
h
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
when (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'\n') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Char
getChar IO Char -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()

returnOnEOF :: MonadMask m => a -> m a -> m a
returnOnEOF :: a -> m a -> m a
returnOnEOF a
x = (IOError -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
External instance of the constraint type Exception IOError
External instance of the constraint type forall (m :: * -> *). MonadMask m => MonadCatch m
Evidence bound by a type signature of the constraint type MonadMask m
handle ((IOError -> m a) -> m a -> m a) -> (IOError -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ \IOError
e -> if IOError -> Bool
isEOFError IOError
e
                                then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadThrow m => Monad m
External instance of the constraint type forall (m :: * -> *). MonadCatch m => MonadThrow m
External instance of the constraint type forall (m :: * -> *). MonadMask m => MonadCatch m
Evidence bound by a type signature of the constraint type MonadMask m
return a
x
                                else IOError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
External instance of the constraint type Exception IOError
External instance of the constraint type forall (m :: * -> *). MonadCatch m => MonadThrow m
External instance of the constraint type forall (m :: * -> *). MonadMask m => MonadCatch m
Evidence bound by a type signature of the constraint type MonadMask m
throwM IOError
e

-- | Utility function to correctly get a line of input as an undecoded ByteString.
hGetLocaleLine :: Handle -> MaybeT IO ByteString
hGetLocaleLine :: Handle -> MaybeT IO ByteString
hGetLocaleLine = (Handle -> IO ByteString) -> Handle -> MaybeT IO ByteString
forall a. (Handle -> IO a) -> Handle -> MaybeT IO a
guardedEOF ((Handle -> IO ByteString) -> Handle -> MaybeT IO ByteString)
-> (Handle -> IO ByteString) -> Handle -> MaybeT IO ByteString
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
    -- It's more efficient to use B.getLine, but that function throws an
    -- error if the Handle (e.g., stdin) is set to NoBuffering.
    BufferMode
buff <- IO BufferMode -> IO BufferMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
External instance of the constraint type MonadIO IO
liftIO (IO BufferMode -> IO BufferMode) -> IO BufferMode -> IO BufferMode
forall a b. (a -> b) -> a -> b
$ Handle -> IO BufferMode
hGetBuffering Handle
h
    IO ByteString -> IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
External instance of the constraint type MonadIO IO
liftIO (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ if BufferMode
buff BufferMode -> BufferMode -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq BufferMode
== BufferMode
NoBuffering
        then (String -> ByteString) -> IO String -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap String -> ByteString
BC.pack (IO String -> IO ByteString) -> IO String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> IO String
System.IO.hGetLine Handle
h
        else Handle -> IO ByteString
BC.hGetLine Handle
h