{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
module System.Process.Run
(
RunT
, runT
, RunState(..)
, OutputStyle(..)
, RunM
, echoStart
, echoEnd
, output
, silent
, dots
, indent
, vlevel
, quieter
, noisier
, lazy
, strict
, message
, run
, module System.Process.ListLike
) where
#if __GLASGOW_HASKELL__ <= 709
import Data.Monoid (Monoid, mempty)
#endif
import Control.Monad (when)
import Control.Monad.State (evalState, evalStateT, get, modify, MonadState, put, StateT)
import Control.Monad.Trans (MonadIO, lift, liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import Data.Char (ord)
import Data.Default (Default(def))
import Data.ListLike as ListLike
(break, fromList, head, hPutStr, length, ListLike, null, putStr, singleton, tail)
import Data.Monoid ((<>))
import Data.String (IsString, fromString)
import Data.Text (Text)
import Data.Word (Word8)
import qualified Data.Text.Lazy as Lazy (Text)
import System.IO (hPutStr, hPutStrLn, stderr)
import System.Process.ListLike
data RunState text
= RunState
{ forall text. RunState text -> OutputStyle
_output :: OutputStyle
, forall text. RunState text -> text
_outprefix :: text
, forall text. RunState text -> text
_errprefix :: text
, forall text. RunState text -> Bool
_echoStart :: Bool
, forall text. RunState text -> Bool
_echoEnd :: Bool
, forall text. RunState text -> Int
_verbosity :: Int
, forall text. RunState text -> Bool
_lazy :: Bool
, forall text. RunState text -> text
_message :: text
}
type RunT text m = StateT (RunState text) m
class (MonadState (RunState text) m,
ProcessText text char,
ListLikeProcessIO text char,
MonadIO m, IsString text, Eq char, Dot char) =>
RunM text char m
instance Dot Word8 where
dot :: Word8
dot = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'.')
instance (MonadIO m, MonadState (RunState String) m) => RunM String Char m
instance (MonadIO m, MonadState (RunState Text) m) => RunM Text Char m
instance (MonadIO m, MonadState (RunState Lazy.Text) m) => RunM Lazy.Text Char m
instance (MonadIO m, MonadState (RunState ByteString) m) => RunM ByteString Word8 m
instance (MonadIO m, MonadState (RunState Lazy.ByteString) m) => RunM Lazy.ByteString Word8 m
runT :: forall m text char a. (MonadIO m, ProcessText text char) => RunT text m a -> m a
runT :: forall (m :: * -> *) text char a.
(MonadIO m, ProcessText text char) =>
RunT text m a -> m a
runT RunT text m a
action = RunT text m a -> RunState text -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT RunT text m a
action (RunState text
forall a. Default a => a
def :: RunState text)
data OutputStyle
= Dots Int
| All
| Indented
| Silent
instance ProcessText text char => Default (RunState text) where
def :: RunState text
def = RunState { _outprefix :: text
_outprefix = String -> text
forall a. IsString a => String -> a
fromString String
"1> "
, _errprefix :: text
_errprefix = String -> text
forall a. IsString a => String -> a
fromString String
"2> "
, _output :: OutputStyle
_output = OutputStyle
All
, _echoStart :: Bool
_echoStart = Bool
True
, _echoEnd :: Bool
_echoEnd = Bool
True
, _verbosity :: Int
_verbosity = Int
3
, _lazy :: Bool
_lazy = Bool
False
, _message :: text
_message = text
forall a. Monoid a => a
mempty }
noEcho :: (MonadState (RunState t) m) => m ()
noEcho :: forall t (m :: * -> *). MonadState (RunState t) m => m ()
noEcho = (RunState t -> RunState t) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState t
x -> RunState t
x { _echoStart = False, _echoEnd = False })
echoStart :: (MonadState (RunState t) m) => m ()
echoStart :: forall t (m :: * -> *). MonadState (RunState t) m => m ()
echoStart = (RunState t -> RunState t) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState t
x -> RunState t
x { _echoStart = True })
echoEnd :: (MonadState (RunState t) m) => m ()
echoEnd :: forall t (m :: * -> *). MonadState (RunState t) m => m ()
echoEnd = (RunState t -> RunState t) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState t
x -> RunState t
x { _echoEnd = True })
output :: (MonadState (RunState t) m) => m ()
output :: forall t (m :: * -> *). MonadState (RunState t) m => m ()
output = (RunState t -> RunState t) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState t
x -> RunState t
x { _output = All })
silent :: (MonadState (RunState t) m) => m ()
silent :: forall t (m :: * -> *). MonadState (RunState t) m => m ()
silent = (RunState t -> RunState t) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState t
x -> RunState t
x { _output = Silent })
dots :: (MonadState (RunState t) m) => Int -> m ()
dots :: forall t (m :: * -> *). MonadState (RunState t) m => Int -> m ()
dots Int
n = (RunState t -> RunState t) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState t
x -> RunState t
x { _output = Dots n })
indent :: (MonadState (RunState t) m, ListLike t char) => (t -> t) -> (t -> t) -> m ()
indent :: forall t (m :: * -> *) char.
(MonadState (RunState t) m, ListLike t char) =>
(t -> t) -> (t -> t) -> m ()
indent t -> t
so t -> t
se = (RunState t -> RunState t) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RunState t -> RunState t) -> m ())
-> (RunState t -> RunState t) -> m ()
forall a b. (a -> b) -> a -> b
$ \RunState t
x ->
let so' :: t
so' = t -> t
so (RunState t -> t
forall text. RunState text -> text
_outprefix RunState t
x)
se' :: t
se' = t -> t
se (RunState t -> t
forall text. RunState text -> text
_errprefix RunState t
x) in
RunState t
x { _outprefix = so'
, _errprefix = se'
, _output = if ListLike.null so' &&
ListLike.null se' then _output x else Indented }
noIndent :: (MonadState (RunState text) m, ListLike text char) => m ()
noIndent :: forall text (m :: * -> *) char.
(MonadState (RunState text) m, ListLike text char) =>
m ()
noIndent = (text -> text) -> (text -> text) -> m ()
forall t (m :: * -> *) char.
(MonadState (RunState t) m, ListLike t char) =>
(t -> t) -> (t -> t) -> m ()
indent (text -> text -> text
forall a b. a -> b -> a
const text
forall a. Monoid a => a
mempty) (text -> text -> text
forall a b. a -> b -> a
const text
forall a. Monoid a => a
mempty)
vlevel :: forall m text char.
(IsString text, ListLike text char, MonadIO m, MonadState (RunState text) m) =>
Int -> m ()
vlevel :: forall (m :: * -> *) text char.
(IsString text, ListLike text char, MonadIO m,
MonadState (RunState text) m) =>
Int -> m ()
vlevel Int
n = do
(RunState text -> RunState text) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState text
x -> RunState text
x {_verbosity = n})
case Int
n of
Int
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> m ()
forall t (m :: * -> *). MonadState (RunState t) m => m ()
noEcho m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall t (m :: * -> *). MonadState (RunState t) m => m ()
silent m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall text (m :: * -> *) char.
(MonadState (RunState text) m, ListLike text char) =>
m ()
noIndent
Int
1 -> Int -> m ()
forall (m :: * -> *) text char.
(IsString text, ListLike text char, MonadIO m,
MonadState (RunState text) m) =>
Int -> m ()
vlevel Int
0 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall t (m :: * -> *). MonadState (RunState t) m => m ()
echoStart
Int
2 -> Int -> m ()
forall (m :: * -> *) text char.
(IsString text, ListLike text char, MonadIO m,
MonadState (RunState text) m) =>
Int -> m ()
vlevel Int
1 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall t (m :: * -> *). MonadState (RunState t) m => m ()
echoEnd m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m ()
forall t (m :: * -> *). MonadState (RunState t) m => Int -> m ()
dots Int
100
Int
_ ->
Int -> m ()
forall (m :: * -> *) text char.
(IsString text, ListLike text char, MonadIO m,
MonadState (RunState text) m) =>
Int -> m ()
vlevel Int
2 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall t (m :: * -> *). MonadState (RunState t) m => m ()
output m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (text -> text) -> (text -> text) -> m ()
forall t (m :: * -> *) char.
(MonadState (RunState t) m, ListLike t char) =>
(t -> t) -> (t -> t) -> m ()
indent (text -> text -> text
forall a b. a -> b -> a
const (String -> text
forall a. IsString a => String -> a
fromString String
"1> ")) (text -> text -> text
forall a b. a -> b -> a
const (String -> text
forall a. IsString a => String -> a
fromString (String
"2> ")))
quieter :: RunM text char m => m ()
quieter :: forall text char (m :: * -> *). RunM text char m => m ()
quieter = m (RunState text)
forall s (m :: * -> *). MonadState s m => m s
get m (RunState text) -> (RunState text -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RunState text
x -> Int -> m ()
forall (m :: * -> *) text char.
(IsString text, ListLike text char, MonadIO m,
MonadState (RunState text) m) =>
Int -> m ()
vlevel (RunState text -> Int
forall text. RunState text -> Int
_verbosity RunState text
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
noisier :: RunM text char m => m ()
noisier :: forall text char (m :: * -> *). RunM text char m => m ()
noisier = m (RunState text)
forall s (m :: * -> *). MonadState s m => m s
get m (RunState text) -> (RunState text -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RunState text
x -> Int -> m ()
forall (m :: * -> *) text char.
(IsString text, ListLike text char, MonadIO m,
MonadState (RunState text) m) =>
Int -> m ()
vlevel (RunState text -> Int
forall text. RunState text -> Int
_verbosity RunState text
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
strict :: RunM text char m => m ()
strict :: forall text char (m :: * -> *). RunM text char m => m ()
strict = (RunState text -> RunState text) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState text
x -> RunState text
x { _lazy = False })
lazy :: RunM text char m => m ()
lazy :: forall text char (m :: * -> *). RunM text char m => m ()
lazy = (RunState text -> RunState text) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState text
x -> RunState text
x { _lazy = True})
message :: RunM text char m => (text -> text) -> m ()
message :: forall text char (m :: * -> *).
RunM text char m =>
(text -> text) -> m ()
message text -> text
f = (RunState text -> RunState text) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState text
x -> RunState text
x { _message = f (_message x) })
class Dot c where
dot :: c
instance Dot Char where
dot :: Char
dot = Char
'.'
run' :: forall m maker text char.
(RunM text char m,
ProcessMaker maker) =>
maker -> text -> m [Chunk text]
run' :: forall (m :: * -> *) maker text char.
(RunM text char m, ProcessMaker maker) =>
maker -> text -> m [Chunk text]
run' maker
maker text
input = do
RunState text
st0 <- m (RunState text)
forall s (m :: * -> *). MonadState s m => m s
get
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunState text -> Bool
forall text. RunState text -> Bool
_echoStart RunState text
st0) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"-> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ maker -> String
forall a. ProcessMaker a => a -> String
showProcessMakerForUser maker
maker))
[Chunk text]
result <- IO [Chunk text] -> m [Chunk text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Chunk text] -> m [Chunk text])
-> IO [Chunk text] -> m [Chunk text]
forall a b. (a -> b) -> a -> b
$ (if RunState text -> Bool
forall text. RunState text -> Bool
_lazy RunState text
st0 then maker -> text -> IO [Chunk text]
forall maker a b c.
(ProcessMaker maker, ProcessResult a b, ListLikeProcessIO a c) =>
maker -> a -> IO b
readCreateProcessLazy else maker -> text -> IO [Chunk text]
forall maker a b c.
(ProcessMaker maker, ProcessResult a b, ListLikeProcessIO a c) =>
maker -> a -> IO b
readCreateProcess) maker
maker text
input IO [Chunk text]
-> ([Chunk text] -> IO [Chunk text]) -> IO [Chunk text]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RunState text -> [Chunk text] -> IO [Chunk text]
doOutput RunState text
st0
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunState text -> Bool
forall text. RunState text -> Bool
_echoEnd RunState text
st0) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"<- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ maker -> String
forall a. ProcessMaker a => a -> String
showProcessMakerForUser maker
maker))
[Chunk text] -> m [Chunk text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Chunk text]
result
where
doOutput :: RunState text -> [Chunk text] -> IO [Chunk text]
doOutput :: RunState text -> [Chunk text] -> IO [Chunk text]
doOutput (RunState {_output :: forall text. RunState text -> OutputStyle
_output = Dots Int
n}) [Chunk text]
cs = Int -> [Chunk text] -> IO [Chunk text]
forall text char.
(ListLikeProcessIO text char, Dot char) =>
Int -> [Chunk text] -> IO [Chunk text]
putDotsLn Int
n [Chunk text]
cs
doOutput (RunState {_output :: forall text. RunState text -> OutputStyle
_output = OutputStyle
Silent}) [Chunk text]
cs = [Chunk text] -> IO [Chunk text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Chunk text]
cs
doOutput (RunState {_output :: forall text. RunState text -> OutputStyle
_output = OutputStyle
All}) [Chunk text]
cs = [Chunk text] -> IO [Chunk text]
forall a c. ListLikeIO a c => [Chunk a] -> IO [Chunk a]
writeOutput [Chunk text]
cs
doOutput (RunState {_output :: forall text. RunState text -> OutputStyle
_output = OutputStyle
Indented, _outprefix :: forall text. RunState text -> text
_outprefix = text
outp, _errprefix :: forall text. RunState text -> text
_errprefix = text
errp}) [Chunk text]
cs = text -> text -> [Chunk text] -> IO [Chunk text]
forall text char.
(ListLikeProcessIO text char, Eq char, IsString text) =>
text -> text -> [Chunk text] -> IO [Chunk text]
writeOutputIndented text
outp text
errp [Chunk text]
cs
run :: forall m maker text char result.
(RunM text char m,
ProcessMaker maker,
ProcessResult text result) =>
maker -> text -> m result
run :: forall (m :: * -> *) maker text char result.
(RunM text char m, ProcessMaker maker,
ProcessResult text result) =>
maker -> text -> m result
run maker
maker text
input = maker -> text -> m [Chunk text]
forall (m :: * -> *) maker text char.
(RunM text char m, ProcessMaker maker) =>
maker -> text -> m [Chunk text]
run' maker
maker text
input m [Chunk text] -> ([Chunk text] -> m result) -> m result
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= result -> m result
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (result -> m result)
-> ([Chunk text] -> result) -> [Chunk text] -> m result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk text] -> result
forall a b. ProcessResult a b => [Chunk a] -> b
collectOutput
putDotsLn :: (ListLikeProcessIO text char, Dot char) =>
Int -> [Chunk text] -> IO [Chunk text]
putDotsLn :: forall text char.
(ListLikeProcessIO text char, Dot char) =>
Int -> [Chunk text] -> IO [Chunk text]
putDotsLn Int
cpd [Chunk text]
chunks = Int -> [Chunk text] -> IO [Chunk text]
forall text char.
(ListLikeProcessIO text char, Dot char) =>
Int -> [Chunk text] -> IO [Chunk text]
putDots Int
cpd [Chunk text]
chunks IO [Chunk text]
-> ([Chunk text] -> IO [Chunk text]) -> IO [Chunk text]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ [Chunk text]
r -> Handle -> String -> IO ()
System.IO.hPutStr Handle
stderr String
"\n" IO () -> IO [Chunk text] -> IO [Chunk text]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Chunk text] -> IO [Chunk text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Chunk text]
r
putDots :: (ListLikeProcessIO text char, Dot char) => Int -> [Chunk text] -> IO [Chunk text]
putDots :: forall text char.
(ListLikeProcessIO text char, Dot char) =>
Int -> [Chunk text] -> IO [Chunk text]
putDots Int
charsPerDot [Chunk text]
chunks =
StateT Int IO [Chunk text] -> Int -> IO [Chunk text]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ((Chunk text -> StateT Int IO (Chunk text))
-> [Chunk text] -> StateT Int IO [Chunk text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ Chunk text
x -> Int -> Chunk text -> StateT Int IO [Chunk text]
forall text char (m :: * -> *).
(Monad m, ListLike text char, Dot char) =>
Int -> Chunk text -> StateT Int m [Chunk text]
dotifyChunk Int
charsPerDot Chunk text
x StateT Int IO [Chunk text]
-> ([Chunk text] -> StateT Int IO ()) -> StateT Int IO ()
forall a b.
StateT Int IO a -> (a -> StateT Int IO b) -> StateT Int IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Chunk text -> StateT Int IO ())
-> [Chunk text] -> StateT Int IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> StateT Int IO ()
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> StateT Int IO ())
-> (Chunk text -> IO ()) -> Chunk text -> StateT Int IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk text -> IO ()
forall text char.
ListLikeProcessIO text char =>
Chunk text -> IO ()
putChunk) StateT Int IO ()
-> StateT Int IO (Chunk text) -> StateT Int IO (Chunk text)
forall a b. StateT Int IO a -> StateT Int IO b -> StateT Int IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Chunk text -> StateT Int IO (Chunk text)
forall a. a -> StateT Int IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk text
x) [Chunk text]
chunks) Int
0
dotifyChunk :: forall text char m. (Monad m, ListLike text char, Dot char) =>
Int -> Chunk text -> StateT Int m [Chunk text]
dotifyChunk :: forall text char (m :: * -> *).
(Monad m, ListLike text char, Dot char) =>
Int -> Chunk text -> StateT Int m [Chunk text]
dotifyChunk Int
charsPerDot Chunk text
chunk =
case Chunk text
chunk of
Stdout text
x -> Int -> StateT Int m [Chunk text]
doChars (text -> Int
forall full item. ListLike full item => full -> Int
ListLike.length text
x)
Stderr text
x -> Int -> StateT Int m [Chunk text]
doChars (text -> Int
forall full item. ListLike full item => full -> Int
ListLike.length text
x)
Chunk text
_ -> [Chunk text] -> StateT Int m [Chunk text]
forall a. a -> StateT Int m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Chunk text
chunk]
where
doChars :: Int -> StateT Int m [Chunk text]
doChars :: Int -> StateT Int m [Chunk text]
doChars Int
count = do
Int
remaining <- StateT Int m Int
forall s (m :: * -> *). MonadState s m => m s
get
let (Int
count', Int
remaining') = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
charsPerDot)
Int -> StateT Int m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Int
remaining'
if (Int
count' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) then [Chunk text] -> StateT Int m [Chunk text]
forall a. a -> StateT Int m a
forall (m :: * -> *) a. Monad m => a -> m a
return [text -> Chunk text
forall a. a -> Chunk a
Stderr ([Item text] -> text
forall l. IsList l => [Item l] -> l
ListLike.fromList (Int -> char -> [char]
forall a. Int -> a -> [a]
replicate Int
count' char
forall c. Dot c => c
dot))] else [Chunk text] -> StateT Int m [Chunk text]
forall a. a -> StateT Int m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
putChunk :: ListLikeProcessIO text char => Chunk text -> IO ()
putChunk :: forall text char.
ListLikeProcessIO text char =>
Chunk text -> IO ()
putChunk (Stdout text
x) = text -> IO ()
forall full item. ListLikeIO full item => full -> IO ()
ListLike.putStr text
x
putChunk (Stderr text
x) = Handle -> text -> IO ()
forall full item. ListLikeIO full item => Handle -> full -> IO ()
ListLike.hPutStr Handle
stderr text
x
putChunk Chunk text
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeOutputIndented :: (ListLikeProcessIO text char, Eq char, IsString text) =>
text -> text -> [Chunk text] -> IO [Chunk text]
writeOutputIndented :: forall text char.
(ListLikeProcessIO text char, Eq char, IsString text) =>
text -> text -> [Chunk text] -> IO [Chunk text]
writeOutputIndented text
outp text
errp [Chunk text]
chunks =
((Chunk text, [Chunk text]) -> IO (Chunk text))
-> [(Chunk text, [Chunk text])] -> IO [Chunk text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Chunk text
c, [Chunk text]
cs) -> (Chunk text -> IO (Chunk text)) -> [Chunk text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Chunk text -> IO (Chunk text)
forall a c. ListLikeIO a c => Chunk a -> IO (Chunk a)
writeChunk [Chunk text]
cs IO () -> IO (Chunk text) -> IO (Chunk text)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Chunk text -> IO (Chunk text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk text
c) (text -> text -> [Chunk text] -> [(Chunk text, [Chunk text])]
forall text char.
(ListLikeProcessIO text char, Eq char, IsString text) =>
text -> text -> [Chunk text] -> [(Chunk text, [Chunk text])]
indentChunks text
outp text
errp [Chunk text]
chunks)
indentChunks :: forall text char. (ListLikeProcessIO text char, Eq char, IsString text) =>
text -> text -> [Chunk text] -> [(Chunk text, [Chunk text])]
indentChunks :: forall text char.
(ListLikeProcessIO text char, Eq char, IsString text) =>
text -> text -> [Chunk text] -> [(Chunk text, [Chunk text])]
indentChunks text
outp text
errp [Chunk text]
chunks =
State BOL [(Chunk text, [Chunk text])]
-> BOL -> [(Chunk text, [Chunk text])]
forall s a. State s a -> s -> a
evalState ((Chunk text -> StateT BOL Identity (Chunk text, [Chunk text]))
-> [Chunk text] -> State BOL [(Chunk text, [Chunk text])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (char
-> text
-> text
-> Chunk text
-> StateT BOL Identity (Chunk text, [Chunk text])
forall (m :: * -> *) text char.
(Eq char, ListLike text char, MonadState BOL m) =>
char -> text -> text -> Chunk text -> m (Chunk text, [Chunk text])
indentChunk char
nl text
outp text
errp) [Chunk text]
chunks) BOL
BOL
where
nl :: char
nl :: char
nl = text -> char
forall full item. ListLike full item => full -> item
ListLike.head (String -> text
forall a. IsString a => String -> a
fromString String
"\n" :: text)
data BOL = BOL | MOL deriving (BOL -> BOL -> Bool
(BOL -> BOL -> Bool) -> (BOL -> BOL -> Bool) -> Eq BOL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BOL -> BOL -> Bool
== :: BOL -> BOL -> Bool
$c/= :: BOL -> BOL -> Bool
/= :: BOL -> BOL -> Bool
Eq)
indentChunk :: forall m text char.
(Eq char, ListLike text char, MonadState BOL m) =>
char -> text -> text -> Chunk text -> m (Chunk text, [Chunk text])
indentChunk :: forall (m :: * -> *) text char.
(Eq char, ListLike text char, MonadState BOL m) =>
char -> text -> text -> Chunk text -> m (Chunk text, [Chunk text])
indentChunk char
nl text
outp text
errp Chunk text
chunk =
case Chunk text
chunk of
Stdout text
x -> (text -> Chunk text) -> text -> text -> m [Chunk text]
forall {full} {m :: * -> *} {a}.
(Item full ~ char, MonadState BOL m, ListLike full char) =>
(full -> a) -> full -> full -> m [a]
doText text -> Chunk text
forall a. a -> Chunk a
Stdout text
outp text
x m [Chunk text]
-> ([Chunk text] -> m (Chunk text, [Chunk text]))
-> m (Chunk text, [Chunk text])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Chunk text, [Chunk text]) -> m (Chunk text, [Chunk text])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Chunk text, [Chunk text]) -> m (Chunk text, [Chunk text]))
-> ([Chunk text] -> (Chunk text, [Chunk text]))
-> [Chunk text]
-> m (Chunk text, [Chunk text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk text
chunk,)
Stderr text
x -> (text -> Chunk text) -> text -> text -> m [Chunk text]
forall {full} {m :: * -> *} {a}.
(Item full ~ char, MonadState BOL m, ListLike full char) =>
(full -> a) -> full -> full -> m [a]
doText text -> Chunk text
forall a. a -> Chunk a
Stderr text
errp text
x m [Chunk text]
-> ([Chunk text] -> m (Chunk text, [Chunk text]))
-> m (Chunk text, [Chunk text])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Chunk text, [Chunk text]) -> m (Chunk text, [Chunk text])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Chunk text, [Chunk text]) -> m (Chunk text, [Chunk text]))
-> ([Chunk text] -> (Chunk text, [Chunk text]))
-> [Chunk text]
-> m (Chunk text, [Chunk text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk text
chunk,)
Chunk text
_ -> (Chunk text, [Chunk text]) -> m (Chunk text, [Chunk text])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk text
chunk, [Chunk text
chunk])
where
doText :: (full -> a) -> full -> full -> m [a]
doText full -> a
con full
pre full
x = do
let (full
hd, full
tl) = (char -> Bool) -> full -> (full, full)
forall full item.
ListLike full item =>
(item -> Bool) -> full -> (full, full)
ListLike.break (char -> char -> Bool
forall a. Eq a => a -> a -> Bool
== char
nl) full
x
[a]
hd' <- (full -> a) -> full -> full -> m [a]
forall {t} {m :: * -> *} {a}.
(ListLike t (Item t), MonadState BOL m) =>
(t -> a) -> t -> t -> m [a]
doHead full -> a
con full
pre full
hd
[a]
tl' <- (full -> a) -> full -> full -> m [a]
doTail full -> a
con full
pre full
tl
[a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [a]
hd' [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
tl'
doHead :: (t -> a) -> t -> t -> m [a]
doHead t -> a
_ t
_ t
x | t -> Bool
forall full item. ListLike full item => full -> Bool
ListLike.null t
x = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
doHead t -> a
con t
pre t
x = do
BOL
bol <- m BOL
forall s (m :: * -> *). MonadState s m => m s
get
case BOL
bol of
BOL
BOL -> BOL -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put BOL
MOL m () -> m [a] -> m [a]
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [t -> a
con (t
pre t -> t -> t
forall a. Semigroup a => a -> a -> a
<> t
x)]
BOL
MOL -> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [t -> a
con t
x]
doTail :: (full -> a) -> full -> full -> m [a]
doTail full -> a
_ full
_ full
x | full -> Bool
forall full item. ListLike full item => full -> Bool
ListLike.null full
x = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
doTail full -> a
con full
pre full
x = do
BOL
bol <- m BOL
forall s (m :: * -> *). MonadState s m => m s
get
BOL -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put BOL
BOL
[a]
tl <- (full -> a) -> full -> full -> m [a]
doText full -> a
con full
pre (full -> full
forall full item. ListLike full item => full -> full
ListLike.tail full
x)
[a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ (if BOL
bol BOL -> BOL -> Bool
forall a. Eq a => a -> a -> Bool
== BOL
BOL then [full -> a
con full
pre] else []) [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [full -> a
con (char -> full
forall full item. ListLike full item => item -> full
singleton char
nl)] [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
tl