module Chiasma.Data.PipePaneParams where

import Prelude hiding (input, output)

import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), arg, flag1)
import Chiasma.Data.Target (Target (Current))

data PipePaneParams =
  PipePaneParams {
    PipePaneParams -> Bool
input :: Bool,
    PipePaneParams -> Bool
output :: Bool,
    PipePaneParams -> Bool
onlyNew :: Bool,
    PipePaneParams -> Target
target :: Target,
    PipePaneParams -> Maybe Text
command :: Maybe Text
  }
  deriving stock (PipePaneParams -> PipePaneParams -> Bool
(PipePaneParams -> PipePaneParams -> Bool)
-> (PipePaneParams -> PipePaneParams -> Bool) -> Eq PipePaneParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipePaneParams -> PipePaneParams -> Bool
$c/= :: PipePaneParams -> PipePaneParams -> Bool
== :: PipePaneParams -> PipePaneParams -> Bool
$c== :: PipePaneParams -> PipePaneParams -> Bool
Eq, Int -> PipePaneParams -> ShowS
[PipePaneParams] -> ShowS
PipePaneParams -> String
(Int -> PipePaneParams -> ShowS)
-> (PipePaneParams -> String)
-> ([PipePaneParams] -> ShowS)
-> Show PipePaneParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PipePaneParams] -> ShowS
$cshowList :: [PipePaneParams] -> ShowS
show :: PipePaneParams -> String
$cshow :: PipePaneParams -> String
showsPrec :: Int -> PipePaneParams -> ShowS
$cshowsPrec :: Int -> PipePaneParams -> ShowS
Show)

instance Default PipePaneParams where
  def :: PipePaneParams
def =
    PipePaneParams :: Bool -> Bool -> Bool -> Target -> Maybe Text -> PipePaneParams
PipePaneParams {
      $sel:input:PipePaneParams :: Bool
input = Bool
False,
      $sel:output:PipePaneParams :: Bool
output = Bool
False,
      $sel:onlyNew:PipePaneParams :: Bool
onlyNew = Bool
False,
      $sel:target:PipePaneParams :: Target
target = Target
Current,
      $sel:command:PipePaneParams :: Maybe Text
command = Maybe Text
forall a. Maybe a
Nothing
    }

instance CmdArgs PipePaneParams where
  cmdArgs :: PipePaneParams -> [Text]
cmdArgs PipePaneParams {Bool
Maybe Text
Target
command :: Maybe Text
target :: Target
onlyNew :: Bool
output :: Bool
input :: Bool
$sel:command:PipePaneParams :: PipePaneParams -> Maybe Text
$sel:target:PipePaneParams :: PipePaneParams -> Target
$sel:onlyNew:PipePaneParams :: PipePaneParams -> Bool
$sel:output:PipePaneParams :: PipePaneParams -> Bool
$sel:input:PipePaneParams :: PipePaneParams -> Bool
..} =
    Text -> Bool -> [Text]
flag1 Text
"-I" Bool
input
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-O" Bool
output
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-o" Bool
onlyNew
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Target -> [Text]
forall a. CmdArgs a => a -> [Text]
cmdArgs Target
target
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Maybe Text -> [Text]
arg Maybe Text
command