{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, Rank2Types, ScopedTypeVariables, ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}

-- | A module for producing forward-defined build systems, in contrast to standard backwards-defined
--   build systems such as shake. Based around ideas from <https://code.google.com/p/fabricate/ fabricate>.
--   As an example:
--
-- @
-- import "Development.Shake"
-- import "Development.Shake.Forward"
-- import "Development.Shake.FilePath"
--
-- main = 'shakeArgsForward' 'shakeOptions' $ do
--     contents <- 'readFileLines' \"result.txt\"
--     'cache' $ 'cmd' \"tar -cf result.tar\" contents
-- @
--
--   Compared to backward-defined build systems (such as normal Shake), forward-defined build
--   systems tend to be simpler for simple systems (less boilerplate, more direct style), but more
--   complex for larger build systems (requires explicit parallelism, explicit sharing of build products,
--   no automatic command line targets). As a general approach for writing forward-defined systems:
--
-- * Figure out the sequence of system commands that will build your project.
--
-- * Write a simple 'Action' that builds your project.
--
-- * Insert 'cache' in front of most system commands.
--
-- * Replace most loops with 'forP', where they can be executed in parallel.
--
-- * Where Haskell performs real computation, if zero-build performance is insufficient, use 'cacheAction'.
--
--   All forward-defined systems use 'AutoDeps', which requires @fsatrace@ to be on the @$PATH@.
--   You can obtain @fsatrace@ from <https://github.com/jacereda/fsatrace>. You must set
--   'shakeLintInside' to specify where 'AutoDeps' will look for dependencies - if you want all dependencies
--   everywhere use @[\"\"]@.
--
--   This module is considered experimental - it has not been battle tested. There are now a few possible
--   alternatives in this space:
--
-- * Pier <http://hackage.haskell.org/package/pier/docs/Pier-Core-Artifact.html> (built on Shake).
--
-- * Rattle <https://github.com/ndmitchell/rattle> (by the same author as Shake).
--
-- * Stroll <https://github.com/snowleopard/stroll>.
module Development.Shake.Forward(
    shakeForward, shakeArgsForward,
    forwardOptions, forwardRule,
    cache, cacheAction, cacheActionWith,
    ) where

import Control.Monad
import Development.Shake
import Development.Shake.Rule
import Development.Shake.Command
import Development.Shake.Classes
import Development.Shake.FilePath
import Data.IORef.Extra
import Data.Either
import Data.Typeable
import Data.List.Extra
import Control.Exception.Extra
import Numeric
import System.IO.Unsafe
import Data.Binary
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as Map


{-# NOINLINE forwards #-}
forwards :: IORef (Map.HashMap Forward (Action Forward))
forwards :: IORef (HashMap Forward (Action Forward))
forwards = IO (IORef (HashMap Forward (Action Forward)))
-> IORef (HashMap Forward (Action Forward))
forall a. IO a -> a
unsafePerformIO (IO (IORef (HashMap Forward (Action Forward)))
 -> IORef (HashMap Forward (Action Forward)))
-> IO (IORef (HashMap Forward (Action Forward)))
-> IORef (HashMap Forward (Action Forward))
forall a b. (a -> b) -> a -> b
$ HashMap Forward (Action Forward)
-> IO (IORef (HashMap Forward (Action Forward)))
forall a. a -> IO (IORef a)
newIORef HashMap Forward (Action Forward)
forall k v. HashMap k v
Map.empty

-- I'd like to use TypeRep, but it doesn't have any instances in older versions
newtype Forward = Forward (String, String, BS.ByteString) -- the type, the Show, the payload
    deriving (Int -> Forward -> Int
Forward -> Int
(Int -> Forward -> Int) -> (Forward -> Int) -> Hashable Forward
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Forward -> Int
$chash :: Forward -> Int
hashWithSalt :: Int -> Forward -> Int
$chashWithSalt :: Int -> Forward -> Int
Hashable,Typeable,Forward -> Forward -> Bool
(Forward -> Forward -> Bool)
-> (Forward -> Forward -> Bool) -> Eq Forward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Forward -> Forward -> Bool
$c/= :: Forward -> Forward -> Bool
== :: Forward -> Forward -> Bool
$c== :: Forward -> Forward -> Bool
Eq,Forward -> ()
(Forward -> ()) -> NFData Forward
forall a. (a -> ()) -> NFData a
rnf :: Forward -> ()
$crnf :: Forward -> ()
NFData,Get Forward
[Forward] -> Put
Forward -> Put
(Forward -> Put)
-> Get Forward -> ([Forward] -> Put) -> Binary Forward
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Forward] -> Put
$cputList :: [Forward] -> Put
get :: Get Forward
$cget :: Get Forward
put :: Forward -> Put
$cput :: Forward -> Put
Binary)

mkForward :: (Typeable a, Show a, Binary a) => a -> Forward
mkForward :: a -> Forward
mkForward a
x = (String, String, ByteString) -> Forward
Forward (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x, a -> String
forall a. Show a => a -> String
show a
x, a -> ByteString
forall a. Binary a => a -> ByteString
encode' a
x)

unForward :: forall a . (Typeable a, Binary a) => Forward -> a
unForward :: Forward -> a
unForward (Forward (String
got,String
_,ByteString
x))
    | String
got String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
want = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Failed to match forward type, wanted " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
want String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
got
    | Bool
otherwise = ByteString -> a
forall a. Binary a => ByteString -> a
decode' ByteString
x
    where want :: String
want = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

encode' :: Binary a => a -> BS.ByteString
encode' :: a -> ByteString
encode' = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (a -> [ByteString]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks (ByteString -> [ByteString])
-> (a -> ByteString) -> a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Binary a => a -> ByteString
encode

decode' :: Binary a => BS.ByteString -> a
decode' :: ByteString -> a
decode' = ByteString -> a
forall a. Binary a => ByteString -> a
decode (ByteString -> a) -> (ByteString -> ByteString) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

type instance RuleResult Forward = Forward

instance Show Forward where
    show :: Forward -> String
show (Forward (String
_,String
x,ByteString
_)) = String
x

-- | Run a forward-defined build system.
shakeForward :: ShakeOptions -> Action () -> IO ()
shakeForward :: ShakeOptions -> Action () -> IO ()
shakeForward ShakeOptions
opts Action ()
act = ShakeOptions -> Rules () -> IO ()
shake (ShakeOptions -> ShakeOptions
forwardOptions ShakeOptions
opts) (Action () -> Rules ()
forwardRule Action ()
act)

-- | Run a forward-defined build system, interpreting command-line arguments.
shakeArgsForward :: ShakeOptions -> Action () -> IO ()
shakeArgsForward :: ShakeOptions -> Action () -> IO ()
shakeArgsForward ShakeOptions
opts Action ()
act = ShakeOptions -> Rules () -> IO ()
shakeArgs (ShakeOptions -> ShakeOptions
forwardOptions ShakeOptions
opts) (Action () -> Rules ()
forwardRule Action ()
act)

-- | Given an 'Action', turn it into a 'Rules' structure which runs in forward mode.
forwardRule :: Action () -> Rules ()
forwardRule :: Action () -> Rules ()
forwardRule Action ()
act = do
    ShakeOptions
opts <- Rules ShakeOptions
getShakeOptionsRules
    Bool -> Rules () -> Rules ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> [String]
shakeLintInside ShakeOptions
opts) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
        String -> Rules ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"When running in forward mode you must set shakeLintInside to specify where to detect dependencies"
    BuiltinLint Forward Forward
-> BuiltinIdentity Forward Forward
-> BuiltinRun Forward Forward
-> Rules ()
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value,
 NFData value, Show value, HasCallStack) =>
BuiltinLint key value
-> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRule BuiltinLint Forward Forward
forall key value. BuiltinLint key value
noLint BuiltinIdentity Forward Forward
forall key value. BuiltinIdentity key value
noIdentity (BuiltinRun Forward Forward -> Rules ())
-> BuiltinRun Forward Forward -> Rules ()
forall a b. (a -> b) -> a -> b
$ \Forward
k Maybe ByteString
old RunMode
mode ->
        case Maybe ByteString
old of
            Just ByteString
old | RunMode
mode RunMode -> RunMode -> Bool
forall a. Eq a => a -> a -> Bool
== RunMode
RunDependenciesSame -> RunResult Forward -> Action (RunResult Forward)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult Forward -> Action (RunResult Forward))
-> RunResult Forward -> Action (RunResult Forward)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> Forward -> RunResult Forward
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing ByteString
old (ByteString -> Forward
forall a. Binary a => ByteString -> a
decode' ByteString
old)
            Maybe ByteString
_ -> do
                Maybe (Action Forward)
res <- IO (Maybe (Action Forward)) -> Action (Maybe (Action Forward))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Action Forward)) -> Action (Maybe (Action Forward)))
-> IO (Maybe (Action Forward)) -> Action (Maybe (Action Forward))
forall a b. (a -> b) -> a -> b
$ IORef (HashMap Forward (Action Forward))
-> (HashMap Forward (Action Forward)
    -> (HashMap Forward (Action Forward), Maybe (Action Forward)))
-> IO (Maybe (Action Forward))
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (HashMap Forward (Action Forward))
forwards ((HashMap Forward (Action Forward)
  -> (HashMap Forward (Action Forward), Maybe (Action Forward)))
 -> IO (Maybe (Action Forward)))
-> (HashMap Forward (Action Forward)
    -> (HashMap Forward (Action Forward), Maybe (Action Forward)))
-> IO (Maybe (Action Forward))
forall a b. (a -> b) -> a -> b
$ \HashMap Forward (Action Forward)
mp -> (Forward
-> HashMap Forward (Action Forward)
-> HashMap Forward (Action Forward)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
Map.delete Forward
k HashMap Forward (Action Forward)
mp, Forward
-> HashMap Forward (Action Forward) -> Maybe (Action Forward)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Forward
k HashMap Forward (Action Forward)
mp)
                case Maybe (Action Forward)
res of
                    Maybe (Action Forward)
Nothing -> IO (RunResult Forward) -> Action (RunResult Forward)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (RunResult Forward) -> Action (RunResult Forward))
-> IO (RunResult Forward) -> Action (RunResult Forward)
forall a b. (a -> b) -> a -> b
$ String -> IO (RunResult Forward)
forall a. HasCallStack => String -> IO a
errorIO (String -> IO (RunResult Forward))
-> String -> IO (RunResult Forward)
forall a b. (a -> b) -> a -> b
$ String
"Failed to find action name, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Forward -> String
forall a. Show a => a -> String
show Forward
k
                    Just Action Forward
act -> do
                        Forward
new <- Action Forward
act
                        RunResult Forward -> Action (RunResult Forward)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult Forward -> Action (RunResult Forward))
-> RunResult Forward -> Action (RunResult Forward)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> Forward -> RunResult Forward
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeSame (Forward -> ByteString
forall a. Binary a => a -> ByteString
encode' Forward
new) Forward
new
    Action () -> Rules ()
forall a. HasCallStack => Action a -> Rules ()
action Action ()
act

-- | Given a 'ShakeOptions', set the options necessary to execute in forward mode.
forwardOptions :: ShakeOptions -> ShakeOptions
forwardOptions :: ShakeOptions -> ShakeOptions
forwardOptions ShakeOptions
opts = ShakeOptions
opts{shakeCommandOptions :: [CmdOption]
shakeCommandOptions=[CmdOption
AutoDeps]}


-- | Cache an action, given a key and an 'Action'. Each call in your program should specify a different
--   key, but the key should remain consistent between runs. Ideally, the 'Action' will gather all its dependencies
--   with tracked operations, e.g. 'readFile\''. However, if information is accessed from the environment
--   (e.g. the action is a closure), you should call 'cacheActionWith' being explicit about what is captured.
cacheAction :: (Typeable a, Binary a, Show a, Typeable b, Binary b, Show b) => a -> Action b -> Action b
cacheAction :: a -> Action b -> Action b
cacheAction (a -> Forward
forall a. (Typeable a, Show a, Binary a) => a -> Forward
mkForward -> Forward
key) (Action b
action :: Action b) = do
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ IORef (HashMap Forward (Action Forward))
-> (HashMap Forward (Action Forward)
    -> HashMap Forward (Action Forward))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef (HashMap Forward (Action Forward))
forwards ((HashMap Forward (Action Forward)
  -> HashMap Forward (Action Forward))
 -> IO ())
-> (HashMap Forward (Action Forward)
    -> HashMap Forward (Action Forward))
-> IO ()
forall a b. (a -> b) -> a -> b
$ Forward
-> Action Forward
-> HashMap Forward (Action Forward)
-> HashMap Forward (Action Forward)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert Forward
key (b -> Forward
forall a. (Typeable a, Show a, Binary a) => a -> Forward
mkForward (b -> Forward) -> Action b -> Action Forward
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action b
action)
    Forward
res <- Forward -> Action Forward
forall key value.
(HasCallStack, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 Forward
key
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ IORef (HashMap Forward (Action Forward))
-> (HashMap Forward (Action Forward)
    -> HashMap Forward (Action Forward))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef (HashMap Forward (Action Forward))
forwards ((HashMap Forward (Action Forward)
  -> HashMap Forward (Action Forward))
 -> IO ())
-> (HashMap Forward (Action Forward)
    -> HashMap Forward (Action Forward))
-> IO ()
forall a b. (a -> b) -> a -> b
$ Forward
-> HashMap Forward (Action Forward)
-> HashMap Forward (Action Forward)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
Map.delete Forward
key
    b -> Action b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Action b) -> b -> Action b
forall a b. (a -> b) -> a -> b
$ Forward -> b
forall a. (Typeable a, Binary a) => Forward -> a
unForward Forward
res

newtype With a = With a
    deriving (Typeable, Get (With a)
[With a] -> Put
With a -> Put
(With a -> Put)
-> Get (With a) -> ([With a] -> Put) -> Binary (With a)
forall a. Binary a => Get (With a)
forall a. Binary a => [With a] -> Put
forall a. Binary a => With a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [With a] -> Put
$cputList :: forall a. Binary a => [With a] -> Put
get :: Get (With a)
$cget :: forall a. Binary a => Get (With a)
put :: With a -> Put
$cput :: forall a. Binary a => With a -> Put
Binary, Int -> With a -> String -> String
[With a] -> String -> String
With a -> String
(Int -> With a -> String -> String)
-> (With a -> String)
-> ([With a] -> String -> String)
-> Show (With a)
forall a. Show a => Int -> With a -> String -> String
forall a. Show a => [With a] -> String -> String
forall a. Show a => With a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [With a] -> String -> String
$cshowList :: forall a. Show a => [With a] -> String -> String
show :: With a -> String
$cshow :: forall a. Show a => With a -> String
showsPrec :: Int -> With a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> With a -> String -> String
Show)

-- | Like 'cacheAction', but also specify which information is captured by the closure of the 'Action'. If that
--   information changes, the 'Action' will be rerun.
cacheActionWith :: (Typeable a, Binary a, Show a, Typeable b, Binary b, Show b, Typeable c, Binary c, Show c) => a -> b ->  Action c -> Action c
cacheActionWith :: a -> b -> Action c -> Action c
cacheActionWith a
key b
argument Action c
action = do
    With b -> Action b -> Action b
forall a b.
(Typeable a, Binary a, Show a, Typeable b, Binary b, Show b) =>
a -> Action b -> Action b
cacheAction (b -> With b
forall a. a -> With a
With b
argument) (Action b -> Action b) -> Action b -> Action b
forall a b. (a -> b) -> a -> b
$ do
        Action ()
alwaysRerun
        b -> Action b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
argument
    a -> Action c -> Action c
forall a b.
(Typeable a, Binary a, Show a, Typeable b, Binary b, Show b) =>
a -> Action b -> Action b
cacheAction a
key (Action c -> Action c) -> Action c -> Action c
forall a b. (a -> b) -> a -> b
$ do
        Forward -> Action Forward
forall key value.
(HasCallStack, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (Forward -> Action Forward) -> Forward -> Action Forward
forall a b. (a -> b) -> a -> b
$ With b -> Forward
forall a. (Typeable a, Show a, Binary a) => a -> Forward
mkForward (With b -> Forward) -> With b -> Forward
forall a b. (a -> b) -> a -> b
$ b -> With b
forall a. a -> With a
With b
argument
        Action c
action

-- | Apply caching to an external command using the same arguments as 'cmd'.
--
-- > cache $ cmd "gcc -c" ["foo.c"] "-o" ["foo.o"]
--
--   This command will be cached, with the inputs/outputs traced. If any of the
--   files used by this command (e.g. @foo.c@ or header files it imports) then
--   the command will rerun.
cache :: (forall r . CmdArguments r => r) -> Action ()
cache :: (forall r. CmdArguments r => r) -> Action ()
cache forall r. CmdArguments r => r
cmd = do
    let CmdArgument [Either CmdOption String]
args = CmdArgument
forall r. CmdArguments r => r
cmd
    let isDull :: String -> Bool
isDull [Char
'-',Char
_] = Bool
True; isDull String
_ = Bool
False
    let name :: String
name = String -> [String] -> String
forall a. a -> [a] -> a
headDef String
"unknown" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isDull) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
drop1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [Either CmdOption String] -> [String]
forall a b. [Either a b] -> [b]
rights [Either CmdOption String]
args
    Command -> Action () -> Action ()
forall a b.
(Typeable a, Binary a, Show a, Typeable b, Binary b, Show b) =>
a -> Action b -> Action b
cacheAction (String -> Command
Command (String -> Command) -> String -> Command
forall a b. (a -> b) -> a -> b
$ String -> String
toStandard String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" #" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
upper (Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Hashable a => a -> Int
hash (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ [Either CmdOption String] -> String
forall a. Show a => a -> String
show [Either CmdOption String]
args) String
"")) Action ()
forall r. CmdArguments r => r
cmd

newtype Command = Command String
    deriving (Typeable, Get Command
[Command] -> Put
Command -> Put
(Command -> Put)
-> Get Command -> ([Command] -> Put) -> Binary Command
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Command] -> Put
$cputList :: [Command] -> Put
get :: Get Command
$cget :: Get Command
put :: Command -> Put
$cput :: Command -> Put
Binary)

instance Show Command where
    show :: Command -> String
show (Command String
x) = String
"command " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x