-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{- | Simple command-line tool to connect to the sequencer and send a single
    cmd.  It's a cmdline version of "App.Repl".
-}
module App.Send where
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Data.Time as Time

import qualified System.Console.GetOpt as GetOpt
import qualified System.Environment as Environment
import qualified System.Exit

import qualified Text.Printf as Printf

import qualified Util.Strings as Strings
import qualified App.ReplProtocol as ReplProtocol

import           Global


data Flag = Help | Timing
    deriving (Flag -> Flag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> [Char]
$cshow :: Flag -> [Char]
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show)

options :: [GetOpt.OptDescr Flag]
options :: [OptDescr Flag]
options =
    [ forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
GetOpt.Option [] [[Char]
"help"] (forall a. a -> ArgDescr a
GetOpt.NoArg Flag
Help) [Char]
"display usage"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
GetOpt.Option [] [[Char]
"timing"] (forall a. a -> ArgDescr a
GetOpt.NoArg Flag
Timing)
        [Char]
"show cmd completion time"
    ]

main :: IO ()
main :: IO ()
main = forall a. IO a -> IO a
ReplProtocol.initialize forall a b. (a -> b) -> a -> b
$ do
    [[Char]]
args <- IO [[Char]]
Environment.getArgs
    ([Flag]
flags, [[Char]]
args) <- case forall a.
ArgOrder a -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]])
GetOpt.getOpt forall a. ArgOrder a
GetOpt.Permute [OptDescr Flag]
options [[Char]]
args of
        ([Flag]
flags, [[Char]]
args, []) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Flag]
flags, [[Char]]
args)
        ([Flag]
_, [[Char]]
_, [[Char]]
errs) -> forall {b}. [Char] -> IO b
usage forall a b. (a -> b) -> a -> b
$ [Char]
"flag errors:\n" forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines [[Char]]
errs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flag
Help forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
flags) (forall {b}. [Char] -> IO b
usage [Char]
"usage:")
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
args) (forall {b}. [Char] -> IO b
usage [Char]
"usage:")
    [Text]
args <- [Text] -> IO [Text]
substitute forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.strip forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text.splitOn Text
";" forall a b. (a -> b) -> a -> b
$ forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap [Char] -> Text
txt [[Char]]
args

    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
args forall a b. (a -> b) -> a -> b
$ \Text
cmd -> do
        if Flag
Timing forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
flags then do
            Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"send: " forall a. Semigroup a => a -> a -> a
<> Text
cmd
            (Text
response, Double
time) <- forall a. NFData a => IO a -> IO (a, Double)
timed forall a b. (a -> b) -> a -> b
$ Text -> IO Text
query Text
cmd
            forall r. PrintfType r => [Char] -> r
Printf.printf [Char]
"%s - %.3f\n" (Text -> [Char]
Text.unpack Text
response) Double
time
        else do
            Text
response <- Text -> IO Text
query Text
cmd
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
Text.null Text
response) forall a b. (a -> b) -> a -> b
$
                Text -> IO ()
Text.IO.putStrLn Text
response
    where
    usage :: [Char] -> IO b
usage [Char]
msg = do
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR: " forall a. [a] -> [a] -> [a]
++ ShowS
Strings.strip [Char]
msg
        [Char] -> IO ()
putStrLn [Char]
"usage: send [ flags ] cmd ..."
        let doc :: [Char]
doc = [Char]
"Cmds are split on ;.  If a cmd has a %s in it, then read\
                \ from stdin, and replace the %s with stdin quoted as a string."
        [Char] -> IO ()
putStr (forall a. [Char] -> [OptDescr a] -> [Char]
GetOpt.usageInfo [Char]
doc [OptDescr Flag]
options)
        forall a. IO a
System.Exit.exitFailure

substitute :: [Text] -> IO [Text]
substitute :: [Text] -> IO [Text]
substitute [Text]
args
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text
"%s" `Text.isInfixOf`) [Text]
args = do
        Text
content <- IO Text
Text.IO.getContents
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (HasCallStack => Text -> Text -> Text -> Text
Text.replace Text
"%s" (forall a. Show a => a -> Text
showt Text
content)) [Text]
args
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
args

query :: Text -> IO Text
query :: Text -> IO Text
query = Text -> IO Text
ReplProtocol.query_cmd_simple

timed :: DeepSeq.NFData a => IO a -> IO (a, Double)
timed :: forall a. NFData a => IO a -> IO (a, Double)
timed IO a
action = do
    DiffTime
start <- IO DiffTime
now
    a
result <- IO a
action
    () <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> ()
DeepSeq.rnf a
result
    DiffTime
end <- IO DiffTime
now
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
result, forall a b. (Real a, Fractional b) => a -> b
realToFrac (DiffTime
end forall a. Num a => a -> a -> a
- DiffTime
start))

now :: IO Time.DiffTime
now :: IO DiffTime
now = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> DiffTime
Time.utctDayTime IO UTCTime
Time.getCurrentTime