{-# LANGUAGE OverloadedStrings
           , TupleSections
           , StandaloneDeriving #-}

module System.Posix.ARX.CLI where

import Control.Applicative hiding (many)
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString as Bytes
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Lazy as LazyB
import Data.Either
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Semigroup
import Data.Word
import System.Environment
import System.Exit (exitFailure)
import System.IO

import qualified Blaze.ByteString.Builder as Blaze
import Text.Parsec hiding (satisfy, (<|>))

import System.Posix.ARX.CLI.CLTokens (Class(..))
import qualified System.Posix.ARX.CLI.CLTokens as CLTokens
import System.Posix.ARX.CLI.Options
import System.Posix.ARX


{-| Run CLI tool, processing arguments and options.
 -}
main                        ::  IO ()
main :: IO ()
main                         =  do
  [ByteString]
args                      <-  (String -> ByteString
Char8.pack (String -> ByteString) -> [String] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([String] -> [ByteString]) -> IO [String] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getArgs
  case Parsec
  [ByteString]
  ()
  (Either
     ([Word], [IOStream], [IOStream])
     ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
      [(Bool, Bool)], [Bool], [ByteSource]))
-> String
-> [ByteString]
-> Either
     ParseError
     (Either
        ([Word], [IOStream], [IOStream])
        ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
         [(Bool, Bool)], [Bool], [ByteSource]))
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec
  [ByteString]
  ()
  (Either
     ([Word], [IOStream], [IOStream])
     ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
      [(Bool, Bool)], [Bool], [ByteSource]))
arx String
"<args>" [ByteString]
args of
    Left ParseError
_                  ->  ByteString -> IO ()
forall {b}. ByteString -> IO b
die ByteString
"Argument error."
    Right (Left ([Word], [IOStream], [IOStream])
shdatArgs)  ->  do
      let (Word
size, IOStream
out, [IOStream]
ins)   =  ([Word], [IOStream], [IOStream]) -> (Word, IOStream, [IOStream])
shdatResolve ([Word], [IOStream], [IOStream])
shdatArgs
      case [IOStream] -> Maybe ByteString
shdatCheckStreams [IOStream]
ins of Maybe ByteString
Nothing  -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                    Just ByteString
msg -> do ByteString -> IO ()
forall {b}. ByteString -> IO b
die ByteString
msg
      let apply :: IOStream -> IO Builder
apply IOStream
i            =  SHDAT -> ByteString -> Builder
forall program input.
ARX program input =>
program -> input -> Builder
interpret (Word -> SHDAT
SHDAT Word
size) (ByteString -> Builder) -> IO ByteString -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOStream -> IO ByteString
inIOStream IOStream
i
      (IOStream -> IO ()) -> [IOStream] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((IOStream -> Builder -> IO ()
send IOStream
out (Builder -> IO ()) -> IO Builder -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO Builder -> IO ())
-> (IOStream -> IO Builder) -> IOStream -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOStream -> IO Builder
apply) [IOStream]
ins
    Right (Right ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
 [(Bool, Bool)], [Bool], [ByteSource])
tmpxArgs)  ->  do
      let (Word
sz, IOStream
out, [IOStream]
tars, [(Var, Val)]
env, ByteString
tmpdir,
           (Bool
rm0, Bool
rm1), Bool
shared, ByteSource
cmd) = ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
 [(Bool, Bool)], [Bool], [ByteSource])
-> (Word, IOStream, [IOStream], [(Var, Val)], ByteString,
    (Bool, Bool), Bool, ByteSource)
tmpxResolve ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
 [(Bool, Bool)], [Bool], [ByteSource])
tmpxArgs
      case [IOStream] -> ByteSource -> Maybe ByteString
tmpxCheckStreams [IOStream]
tars ByteSource
cmd of Maybe ByteString
Nothing  -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                        Just ByteString
msg -> do ByteString -> IO ()
forall {b}. ByteString -> IO b
die ByteString
msg
      ByteString
cmd'                  <-  ByteSource -> IO ByteString
openByteSource ByteSource
cmd
      let tmpx :: TMPX
tmpx               =  SHDAT
-> ByteString
-> [(Var, Val)]
-> ByteString
-> Bool
-> Bool
-> Bool
-> TMPX
TMPX (Word -> SHDAT
SHDAT Word
sz) ByteString
cmd' [(Var, Val)]
env ByteString
tmpdir Bool
rm0 Bool
rm1 Bool
shared
      ([ByteString]
badAr, [(Tar, ByteString)]
goodAr)       <-  [Either ByteString (Tar, ByteString)]
-> ([ByteString], [(Tar, ByteString)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ByteString (Tar, ByteString)]
 -> ([ByteString], [(Tar, ByteString)]))
-> IO [Either ByteString (Tar, ByteString)]
-> IO ([ByteString], [(Tar, ByteString)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IOStream -> IO (Either ByteString (Tar, ByteString)))
-> [IOStream] -> IO [Either ByteString (Tar, ByteString)]
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 IOStream -> IO (Either ByteString (Tar, ByteString))
openArchive [IOStream]
tars
      ([ByteString]
badAr [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` do (((ByteString -> IO ()
forall {b}. ByteString -> IO b
die (ByteString -> IO ())
-> (ByteString -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((ByteString -> ByteString) -> ByteString -> IO ())
-> ([ByteString] -> ByteString -> ByteString)
-> [ByteString]
-> ByteString
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([ByteString] -> ByteString -> ByteString)
 -> [ByteString] -> ByteString -> IO ())
-> (ByteString -> [ByteString] -> ByteString -> ByteString)
-> ByteString
-> [ByteString]
-> ByteString
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString -> ByteString
blockMessage)
                                ByteString
"The file magic of some archives:"
                                [ByteString]
badAr
                                ByteString
"could not be interpreted."
      IOStream -> Builder -> IO ()
send IOStream
out (TMPX -> [(Tar, ByteString)] -> Builder
forall program input.
ARX program input =>
program -> input -> Builder
interpret TMPX
tmpx [(Tar, ByteString)]
goodAr)
 where
  arx :: Parsec
  [ByteString]
  ()
  (Either
     ([Word], [IOStream], [IOStream])
     ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
      [(Bool, Bool)], [Bool], [ByteSource]))
arx                        =  ([Word], [IOStream], [IOStream])
-> Either
     ([Word], [IOStream], [IOStream])
     ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
      [(Bool, Bool)], [Bool], [ByteSource])
forall a b. a -> Either a b
Left (([Word], [IOStream], [IOStream])
 -> Either
      ([Word], [IOStream], [IOStream])
      ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
       [(Bool, Bool)], [Bool], [ByteSource]))
-> ParsecT
     [ByteString] () Identity ([Word], [IOStream], [IOStream])
-> Parsec
     [ByteString]
     ()
     (Either
        ([Word], [IOStream], [IOStream])
        ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
         [(Bool, Bool)], [Bool], [ByteSource]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [ByteString] () Identity ([Word], [IOStream], [IOStream])
shdat Parsec
  [ByteString]
  ()
  (Either
     ([Word], [IOStream], [IOStream])
     ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
      [(Bool, Bool)], [Bool], [ByteSource]))
-> Parsec
     [ByteString]
     ()
     (Either
        ([Word], [IOStream], [IOStream])
        ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
         [(Bool, Bool)], [Bool], [ByteSource]))
-> Parsec
     [ByteString]
     ()
     (Either
        ([Word], [IOStream], [IOStream])
        ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
         [(Bool, Bool)], [Bool], [ByteSource]))
forall a.
ParsecT [ByteString] () Identity a
-> ParsecT [ByteString] () Identity a
-> ParsecT [ByteString] () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
 [(Bool, Bool)], [Bool], [ByteSource])
-> Either
     ([Word], [IOStream], [IOStream])
     ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
      [(Bool, Bool)], [Bool], [ByteSource])
forall a b. b -> Either a b
Right (([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
  [(Bool, Bool)], [Bool], [ByteSource])
 -> Either
      ([Word], [IOStream], [IOStream])
      ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
       [(Bool, Bool)], [Bool], [ByteSource]))
-> ParsecT
     [ByteString]
     ()
     Identity
     ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
      [(Bool, Bool)], [Bool], [ByteSource])
-> Parsec
     [ByteString]
     ()
     (Either
        ([Word], [IOStream], [IOStream])
        ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
         [(Bool, Bool)], [Bool], [ByteSource]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  [ByteString]
  ()
  Identity
  ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
   [(Bool, Bool)], [Bool], [ByteSource])
tmpx
  name :: IOStream -> ByteString
name IOStream
STDIO                 =  ByteString
"-"
  name (Path ByteString
b)              =  ByteString
b
  send :: IOStream -> Builder -> IO ()
send IOStream
o Builder
b                   =  (IOStream -> ByteString -> IO ()
outIOStream IOStream
o (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Blaze.toLazyByteString) Builder
b
  openArchive :: IOStream -> IO (Either ByteString (Tar, ByteString))
openArchive IOStream
io             =  do Maybe (Tar, ByteString)
r <- IOStream -> IO (Maybe (Tar, ByteString))
arIOStream IOStream
io
                                   Either ByteString (Tar, ByteString)
-> IO (Either ByteString (Tar, ByteString))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (Tar, ByteString)
 -> IO (Either ByteString (Tar, ByteString)))
-> Either ByteString (Tar, ByteString)
-> IO (Either ByteString (Tar, ByteString))
forall a b. (a -> b) -> a -> b
$ case Maybe (Tar, ByteString)
r of Maybe (Tar, ByteString)
Nothing -> ByteString -> Either ByteString (Tar, ByteString)
forall a b. a -> Either a b
Left (IOStream -> ByteString
name IOStream
io)
                                                      Just (Tar, ByteString)
x  -> (Tar, ByteString) -> Either ByteString (Tar, ByteString)
forall a b. b -> Either a b
Right (Tar, ByteString)
x

{-| Apply defaulting and overrides appropriate to 'SHDAT' programs.
 -}
shdatResolve                ::  ([Word], [IOStream], [IOStream])
                            ->  (Word, IOStream, [IOStream])
shdatResolve :: ([Word], [IOStream], [IOStream]) -> (Word, IOStream, [IOStream])
shdatResolve ([Word]
sizes, [IOStream]
outs, [IOStream]
ins) = (Word
size, IOStream
out, [IOStream]
ins')
 where
  size :: Word
size                       =  [Word] -> Word
forall a. HasCallStack => [a] -> a
last (Word
defaultBlockWord -> [Word] -> [Word]
forall a. a -> [a] -> [a]
:[Word]
sizes)
  out :: IOStream
out                        =  [IOStream] -> IOStream
forall a. HasCallStack => [a] -> a
last (IOStream
STDIOIOStream -> [IOStream] -> [IOStream]
forall a. a -> [a] -> [a]
:[IOStream]
outs)
  ins' :: [IOStream]
ins' | [IOStream]
ins [IOStream] -> [IOStream] -> Bool
forall a. Eq a => a -> a -> Bool
== []           =  [IOStream
STDIO]
       | Bool
otherwise           =  [IOStream]
ins

shdatCheckStreams           ::  [IOStream] -> Maybe ByteString
shdatCheckStreams :: [IOStream] -> Maybe ByteString
shdatCheckStreams [IOStream]
ins        =  [ZOM] -> Maybe ByteString
forall {t :: * -> *}. Foldable t => t ZOM -> Maybe ByteString
streamsMessage [ZOM
ins']
 where
  ins' :: ZOM
ins'                       =  case [ IOStream
x | IOStream
x <- [IOStream]
ins, IOStream
x IOStream -> IOStream -> Bool
forall a. Eq a => a -> a -> Bool
== IOStream
STDIO ] of
      []                    ->  ZOM
Zero
      [IOStream
_]                   ->  ByteString -> ZOM
One ByteString
"as a file input"
      IOStream
_:IOStream
_:[IOStream]
_                 ->  [ByteString] -> ZOM
Many [ByteString
"more than once as a file input"]


{-| Apply defaulting and overrides appropriate to 'TMPX' programs.
 -}
tmpxResolve                 ::  ( [Word], [IOStream], [IOStream],
                                  [(Var, Val)], [ByteString], [(Bool, Bool)],
                                  [Bool], [ByteSource]              )
                            ->  ( Word, IOStream, [IOStream],
                                  [(Var, Val)], ByteString, (Bool, Bool), Bool,
                                  ByteSource                        )
tmpxResolve :: ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString],
 [(Bool, Bool)], [Bool], [ByteSource])
-> (Word, IOStream, [IOStream], [(Var, Val)], ByteString,
    (Bool, Bool), Bool, ByteSource)
tmpxResolve ([Word]
sizes, [IOStream]
outs, [IOStream]
tars, [(Var, Val)]
env, [ByteString]
dirs, [(Bool, Bool)]
rms, [Bool]
shareds, [ByteSource]
cmds) =
  (Word
size, IOStream
out, [IOStream]
tars, [(Var, Val)]
env, ByteString
tmpdir, (Bool, Bool)
rm, Bool
shared, ByteSource
cmd)
 where
  size :: Word
size                       =  [Word] -> Word
forall a. HasCallStack => [a] -> a
last (Word
defaultBlockWord -> [Word] -> [Word]
forall a. a -> [a] -> [a]
:[Word]
sizes)
  out :: IOStream
out                        =  [IOStream] -> IOStream
forall a. HasCallStack => [a] -> a
last (IOStream
STDIOIOStream -> [IOStream] -> [IOStream]
forall a. a -> [a] -> [a]
:[IOStream]
outs)
  tmpdir :: ByteString
tmpdir                     =  [ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
last (ByteString
"/tmp"ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
dirs)
  rm :: (Bool, Bool)
rm                         =  [(Bool, Bool)] -> (Bool, Bool)
forall a. HasCallStack => [a] -> a
last ((Bool
True,Bool
True)(Bool, Bool) -> [(Bool, Bool)] -> [(Bool, Bool)]
forall a. a -> [a] -> [a]
:[(Bool, Bool)]
rms)
  shared :: Bool
shared                     =  [Bool] -> Bool
forall a. HasCallStack => [a] -> a
last (Bool
FalseBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
shareds)
  cmd :: ByteSource
cmd                        =  [ByteSource] -> ByteSource
forall a. HasCallStack => [a] -> a
last (ByteSource
defaultTaskByteSource -> [ByteSource] -> [ByteSource]
forall a. a -> [a] -> [a]
:[ByteSource]
cmds)

tmpxCheckStreams            ::  [IOStream] -> ByteSource -> Maybe ByteString
tmpxCheckStreams :: [IOStream] -> ByteSource -> Maybe ByteString
tmpxCheckStreams [IOStream]
tars ByteSource
cmd    =  [ZOM] -> Maybe ByteString
forall {t :: * -> *}. Foldable t => t ZOM -> Maybe ByteString
streamsMessage [ZOM
tars', ZOM
cmd']
 where
  tars' :: ZOM
tars'                      =  case [ IOStream
x | IOStream
x <- [IOStream]
tars, IOStream
x IOStream -> IOStream -> Bool
forall a. Eq a => a -> a -> Bool
== IOStream
STDIO ] of
      []                    ->  ZOM
Zero
      [IOStream
_]                   ->  ByteString -> ZOM
One ByteString
"as an archive input"
      IOStream
_:IOStream
_:[IOStream]
_                 ->  [ByteString] -> ZOM
Many [ByteString
"more than once as an archive input"]
  cmd' :: ZOM
cmd'
    | ByteSource
cmd ByteSource -> ByteSource -> Bool
forall a. Eq a => a -> a -> Bool
== IOStream -> ByteSource
IOStream IOStream
STDIO  =  ByteString -> ZOM
One ByteString
"as a command input"
    | Bool
otherwise              =  ZOM
Zero

tmpxOpen :: Word -> [(Var, Val)] -> (Bool, Bool, Bool)
         -> ByteString -> ByteSource -> IO TMPX
tmpxOpen :: Word
-> [(Var, Val)]
-> (Bool, Bool, Bool)
-> ByteString
-> ByteSource
-> IO TMPX
tmpxOpen Word
size [(Var, Val)]
env (Bool
rm0, Bool
rm1, Bool
rm2) ByteString
tmpdir ByteSource
cmd = do
  ByteString
text                      <-  case ByteSource
cmd of
    ByteString ByteString
b            ->  ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
LazyB.fromChunks [ByteString
b])
    IOStream IOStream
STDIO          ->  IO ByteString
LazyB.getContents
    IOStream (Path ByteString
b)       ->  String -> IO ByteString
LazyB.readFile (ByteString -> String
Char8.unpack ByteString
b)
  TMPX -> IO TMPX
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SHDAT
-> ByteString
-> [(Var, Val)]
-> ByteString
-> Bool
-> Bool
-> Bool
-> TMPX
TMPX (Word -> SHDAT
SHDAT Word
size) ByteString
text [(Var, Val)]
env ByteString
tmpdir Bool
rm0 Bool
rm1 Bool
rm2)


openByteSource              ::  ByteSource -> IO LazyB.ByteString
openByteSource :: ByteSource -> IO ByteString
openByteSource ByteSource
source        =  case ByteSource
source of
    ByteString ByteString
b            ->  ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
LazyB.fromChunks [ByteString
b])
    IOStream IOStream
STDIO          ->  IO ByteString
LazyB.getContents
    IOStream (Path ByteString
b)       ->  String -> IO ByteString
LazyB.readFile (ByteString -> String
Char8.unpack ByteString
b)

inIOStream :: IOStream -> IO ByteString
inIOStream IOStream
STDIO             =  IO ByteString
LazyB.getContents
inIOStream (Path ByteString
b)          =  String -> IO ByteString
LazyB.readFile (ByteString -> String
Char8.unpack ByteString
b)

outIOStream :: IOStream -> ByteString -> IO ()
outIOStream IOStream
STDIO            =  ByteString -> IO ()
LazyB.putStr
outIOStream (Path ByteString
b)         =  String -> ByteString -> IO ()
LazyB.writeFile (ByteString -> String
Char8.unpack ByteString
b)

arIOStream                  ::  IOStream -> IO (Maybe (Tar, LazyB.ByteString))
arIOStream :: IOStream -> IO (Maybe (Tar, ByteString))
arIOStream IOStream
io                =  do ByteString
opened <- IOStream -> IO ByteString
inIOStream IOStream
io
                                   Maybe (Tar, ByteString) -> IO (Maybe (Tar, ByteString))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((,ByteString
opened) (Tar -> (Tar, ByteString)) -> Maybe Tar -> Maybe (Tar, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Tar
magic ByteString
opened)


{-| By default, we encode binary data to HERE docs 4MiB at a time. (The
    encoded result may be up to 10% larger, though 1% is more likely.)
 -}
defaultBlock                ::  Word
defaultBlock :: Word
defaultBlock                 =  Word
0x400000

{-| The default task is a no-op call to @\/bin\/true@.
 -}
defaultTask                 ::  ByteSource
defaultTask :: ByteSource
defaultTask                  =  ByteString -> ByteSource
ByteString ByteString
"/bin/true"


data ZOM                     =  Zero | One !ByteString | Many ![ByteString]
instance Semigroup ZOM where
  ZOM
Zero    <> :: ZOM -> ZOM -> ZOM
<> ZOM
x        =  ZOM
x
  ZOM
x       <> ZOM
Zero     =  ZOM
x
  One ByteString
m   <> One ByteString
m'   =  [ByteString] -> ZOM
Many [ByteString
m, ByteString
m']
  One ByteString
m   <> Many [ByteString]
ms  =  [ByteString] -> ZOM
Many ([ByteString] -> [ByteString] -> [ByteString]
forall a. Monoid a => a -> a -> a
mappend [ByteString
m] [ByteString]
ms)
  Many [ByteString]
ms <> One ByteString
m    =  [ByteString] -> ZOM
Many ([ByteString] -> [ByteString] -> [ByteString]
forall a. Monoid a => a -> a -> a
mappend [ByteString]
ms  [ByteString
m])
  Many [ByteString]
ms <> Many [ByteString]
ms' =  [ByteString] -> ZOM
Many ([ByteString] -> [ByteString] -> [ByteString]
forall a. Monoid a => a -> a -> a
mappend [ByteString]
ms  [ByteString]
ms')
instance Monoid ZOM where
  mempty :: ZOM
mempty                     =  ZOM
Zero

streamsMessage :: t ZOM -> Maybe ByteString
streamsMessage t ZOM
filtered      =  case (ZOM -> ZOM -> ZOM) -> ZOM -> t ZOM -> ZOM
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ZOM -> ZOM -> ZOM
forall a. Monoid a => a -> a -> a
mappend ZOM
Zero t ZOM
filtered of
  Many [ByteString]
messages             ->  ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ([ByteString] -> ByteString
template [ByteString]
messages)
  ZOM
_                         ->  Maybe ByteString
forall a. Maybe a
Nothing
 where
  template :: [ByteString] -> ByteString
template [ByteString]
clauses           =  ByteString -> [ByteString] -> ByteString -> ByteString
blockMessage
                                  ByteString
"STDIN is specified multiple times:"
                                  [ByteString]
clauses
                                  ByteString
"but restreaming STDIN is not supported."

blockMessage :: ByteString -> [ByteString] -> ByteString -> ByteString
blockMessage ByteString
a [ByteString]
bs ByteString
c          =  [ByteString] -> ByteString
Char8.unlines
  [ByteString
a, ByteString -> [ByteString] -> ByteString
Bytes.intercalate ByteString
",\n" (ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
"  " (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
bs), ByteString
c]

err :: ByteString -> IO ()
err ByteString
""                       =  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
err ByteString
b | ByteString -> Char
Char8.last ByteString
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' =  Handle -> ByteString -> IO ()
Char8.hPutStr Handle
stderr ByteString
b
      | Bool
otherwise            =  Handle -> ByteString -> IO ()
Char8.hPutStr Handle
stderr (ByteString
b ByteString -> Char -> ByteString
`Char8.snoc` Char
'\n')

die :: ByteString -> IO b
die ByteString
msg                      =  ByteString -> IO ()
err ByteString
msg IO () -> IO b -> IO b
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
forall a. IO a
exitFailure