{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Redact.Monad.Handle
(
MonadHandle(..)
, handleToTerminal
, handleToTerminal'
, fileToTerminal
, fileToTerminal'
) where
import qualified System.Console.ANSI as Term
import Control.Monad (join)
import Data.Bifunctor (first)
import Data.Bool (bool)
import Data.Typeable (Typeable)
import qualified System.IO as IO
import System.IO (Handle, IOMode(ReadMode))
import System.IO.Error (tryIOError)
import Data.Text (Text)
import qualified Data.Text.IO as TIO
import Redact.Monad.Terminal (MonadTerminal, initialize, putLine)
import Redact.Types (Error(IOError, RedactError), Line)
class Monad m => MonadHandle m where
hGetLine :: Handle -> m Text
hIsEOF :: Handle -> m Bool
withFile
:: Typeable r
=> FilePath
-> IOMode
-> (Handle -> m r)
-> m (Either IOError r)
instance MonadHandle IO where
hGetLine :: Handle -> IO Text
hGetLine = Handle -> IO Text
TIO.hGetLine
{-# INLINE hGetLine #-}
hIsEOF :: Handle -> IO Bool
hIsEOF = Handle -> IO Bool
IO.hIsEOF
{-# INLINE hIsEOF #-}
withFile :: forall r.
Typeable r =>
FilePath -> IOMode -> (Handle -> IO r) -> IO (Either IOError r)
withFile FilePath
path IOMode
mode = forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile FilePath
path IOMode
mode
{-# INLINE withFile #-}
handleToTerminal
:: forall m s. (MonadHandle m, MonadTerminal m)
=> (s -> Text -> Either String (Line, s))
-> (s -> Maybe String)
-> s
-> [Term.SGR]
-> Handle
-> m (Either Error ())
handleToTerminal :: forall (m :: * -> *) s.
(MonadHandle m, MonadTerminal m) =>
(s -> Text -> Either FilePath (Line, s))
-> (s -> Maybe FilePath)
-> s
-> [SGR]
-> Handle
-> m (Either Error ())
handleToTerminal s -> Text -> Either FilePath (Line, s)
step s -> Maybe FilePath
end s
initialState [SGR]
sgrs Handle
handle =
Either FilePath (Maybe Line, s) -> m (Either Error ())
begin forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Either FilePath (Maybe Line, s))
maybeGetLine s
initialState
where
maybeGetLine :: s -> m (Either String (Maybe Line, s))
maybeGetLine :: s -> m (Either FilePath (Maybe Line, s))
maybeGetLine s
state
= forall a. a -> a -> Bool -> a
bool
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Text -> Either FilePath (Line, s)
step s
state forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadHandle m => Handle -> m Text
hGetLine Handle
handle)
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a. Maybe a
Nothing, s
state))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadHandle m => Handle -> m Bool
hIsEOF Handle
handle
begin :: Either String (Maybe Line, s) -> m (Either Error ())
begin :: Either FilePath (Maybe Line, s) -> m (Either Error ())
begin = \case
Right (Just Line
line, s
state) -> do
forall (m :: * -> *). MonadTerminal m => [SGR] -> Line -> m ()
initialize [SGR]
sgrs Line
line
Line -> Either FilePath (Maybe Line, s) -> m (Either Error ())
loop Line
line forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Either FilePath (Maybe Line, s))
maybeGetLine s
state
Right (Maybe Line
Nothing, s
_state) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
Left FilePath
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath -> Error
RedactError FilePath
err
loop :: Line -> Either String (Maybe Line, s) -> m (Either Error ())
loop :: Line -> Either FilePath (Maybe Line, s) -> m (Either Error ())
loop Line
line = \case
Right (Just Line
nextLine, s
state) -> do
forall (m :: * -> *).
MonadTerminal m =>
[SGR] -> Line -> Maybe Line -> m ()
putLine [SGR]
sgrs Line
line forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Line
nextLine
Line -> Either FilePath (Maybe Line, s) -> m (Either Error ())
loop Line
nextLine forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Either FilePath (Maybe Line, s))
maybeGetLine s
state
Right (Maybe Line
Nothing, s
state) -> do
forall (m :: * -> *).
MonadTerminal m =>
[SGR] -> Line -> Maybe Line -> m ()
putLine [SGR]
sgrs Line
line forall a. Maybe a
Nothing
case s -> Maybe FilePath
end s
state of
Maybe FilePath
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
Just FilePath
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath -> Error
RedactError FilePath
err
Left FilePath
err -> do
forall (m :: * -> *).
MonadTerminal m =>
[SGR] -> Line -> Maybe Line -> m ()
putLine [SGR]
sgrs Line
line forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath -> Error
RedactError FilePath
err
handleToTerminal'
:: forall m s. (MonadHandle m, MonadTerminal m)
=> (s -> Text -> (Line, s))
-> s
-> [Term.SGR]
-> Handle
-> m ()
handleToTerminal' :: forall (m :: * -> *) s.
(MonadHandle m, MonadTerminal m) =>
(s -> Text -> (Line, s)) -> s -> [SGR] -> Handle -> m ()
handleToTerminal' s -> Text -> (Line, s)
step s
initialState [SGR]
sgrs Handle
handle =
(Maybe Line, s) -> m ()
begin forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Maybe Line, s)
maybeGetLine s
initialState
where
maybeGetLine :: s -> m (Maybe Line, s)
maybeGetLine :: s -> m (Maybe Line, s)
maybeGetLine s
state
= forall a. a -> a -> Bool -> a
bool
(forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Text -> (Line, s)
step s
state forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadHandle m => Handle -> m Text
hGetLine Handle
handle)
(forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, s
state))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadHandle m => Handle -> m Bool
hIsEOF Handle
handle
begin :: (Maybe Line, s) -> m ()
begin :: (Maybe Line, s) -> m ()
begin = \case
(Just Line
line, s
state) -> do
forall (m :: * -> *). MonadTerminal m => [SGR] -> Line -> m ()
initialize [SGR]
sgrs Line
line
Line -> (Maybe Line, s) -> m ()
loop Line
line forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Maybe Line, s)
maybeGetLine s
state
(Maybe Line
Nothing, s
_state) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
loop :: Line -> (Maybe Line, s) -> m ()
loop :: Line -> (Maybe Line, s) -> m ()
loop Line
line (Maybe Line
mNextLine, s
state) = do
forall (m :: * -> *).
MonadTerminal m =>
[SGR] -> Line -> Maybe Line -> m ()
putLine [SGR]
sgrs Line
line Maybe Line
mNextLine
case Maybe Line
mNextLine of
Just Line
nextLine -> Line -> (Maybe Line, s) -> m ()
loop Line
nextLine forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Maybe Line, s)
maybeGetLine s
state
Maybe Line
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
fileToTerminal
:: (MonadHandle m, MonadTerminal m)
=> (s -> Text -> Either String (Line, s))
-> (s -> Maybe String)
-> s
-> [Term.SGR]
-> FilePath
-> m (Either Error ())
fileToTerminal :: forall (m :: * -> *) s.
(MonadHandle m, MonadTerminal m) =>
(s -> Text -> Either FilePath (Line, s))
-> (s -> Maybe FilePath)
-> s
-> [SGR]
-> FilePath
-> m (Either Error ())
fileToTerminal s -> Text -> Either FilePath (Line, s)
step s -> Maybe FilePath
end s
initialState [SGR]
sgrs FilePath
path
= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first IOError -> Error
IOError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
(MonadHandle m, Typeable r) =>
FilePath -> IOMode -> (Handle -> m r) -> m (Either IOError r)
withFile FilePath
path IOMode
ReadMode
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
(MonadHandle m, MonadTerminal m) =>
(s -> Text -> Either FilePath (Line, s))
-> (s -> Maybe FilePath)
-> s
-> [SGR]
-> Handle
-> m (Either Error ())
handleToTerminal s -> Text -> Either FilePath (Line, s)
step s -> Maybe FilePath
end s
initialState [SGR]
sgrs
fileToTerminal'
:: (MonadHandle m, MonadTerminal m)
=> (s -> Text -> (Line, s))
-> s
-> [Term.SGR]
-> FilePath
-> m (Either Error ())
fileToTerminal' :: forall (m :: * -> *) s.
(MonadHandle m, MonadTerminal m) =>
(s -> Text -> (Line, s))
-> s -> [SGR] -> FilePath -> m (Either Error ())
fileToTerminal' s -> Text -> (Line, s)
step s
initialState [SGR]
sgrs FilePath
path
= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first IOError -> Error
IOError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
(MonadHandle m, Typeable r) =>
FilePath -> IOMode -> (Handle -> m r) -> m (Either IOError r)
withFile FilePath
path IOMode
ReadMode
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
(MonadHandle m, MonadTerminal m) =>
(s -> Text -> (Line, s)) -> s -> [SGR] -> Handle -> m ()
handleToTerminal' s -> Text -> (Line, s)
step s
initialState [SGR]
sgrs