module Chiasma.Data.CapturePaneParams where

import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), flag1, optionArgs, optionArgsWith)
import qualified Chiasma.Data.Target as Target
import Chiasma.Data.Target (Target)
import Prelude hiding (output)

data CaptureOutput =
  Stdout
  |
  Buffer Text
  deriving stock (CaptureOutput -> CaptureOutput -> Bool
(CaptureOutput -> CaptureOutput -> Bool)
-> (CaptureOutput -> CaptureOutput -> Bool) -> Eq CaptureOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaptureOutput -> CaptureOutput -> Bool
$c/= :: CaptureOutput -> CaptureOutput -> Bool
== :: CaptureOutput -> CaptureOutput -> Bool
$c== :: CaptureOutput -> CaptureOutput -> Bool
Eq, Int -> CaptureOutput -> ShowS
[CaptureOutput] -> ShowS
CaptureOutput -> String
(Int -> CaptureOutput -> ShowS)
-> (CaptureOutput -> String)
-> ([CaptureOutput] -> ShowS)
-> Show CaptureOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaptureOutput] -> ShowS
$cshowList :: [CaptureOutput] -> ShowS
show :: CaptureOutput -> String
$cshow :: CaptureOutput -> String
showsPrec :: Int -> CaptureOutput -> ShowS
$cshowsPrec :: Int -> CaptureOutput -> ShowS
Show)

instance CmdArgs CaptureOutput where
  cmdArgs :: CaptureOutput -> [Text]
cmdArgs = \case
    CaptureOutput
Stdout -> [Item [Text]
"-p"]
    Buffer Text
name -> [Item [Text]
"-b", Text
Item [Text]
name]

data CaptureLine =
  Edge
  |
  CaptureLine Int
  deriving stock (CaptureLine -> CaptureLine -> Bool
(CaptureLine -> CaptureLine -> Bool)
-> (CaptureLine -> CaptureLine -> Bool) -> Eq CaptureLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaptureLine -> CaptureLine -> Bool
$c/= :: CaptureLine -> CaptureLine -> Bool
== :: CaptureLine -> CaptureLine -> Bool
$c== :: CaptureLine -> CaptureLine -> Bool
Eq, Int -> CaptureLine -> ShowS
[CaptureLine] -> ShowS
CaptureLine -> String
(Int -> CaptureLine -> ShowS)
-> (CaptureLine -> String)
-> ([CaptureLine] -> ShowS)
-> Show CaptureLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaptureLine] -> ShowS
$cshowList :: [CaptureLine] -> ShowS
show :: CaptureLine -> String
$cshow :: CaptureLine -> String
showsPrec :: Int -> CaptureLine -> ShowS
$cshowsPrec :: Int -> CaptureLine -> ShowS
Show)

instance CmdArgs CaptureLine where
  cmdArgs :: CaptureLine -> [Text]
cmdArgs = \case
    CaptureLine
Edge -> [Item [Text]
"-"]
    CaptureLine Int
n -> [Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
n]

data CapturePaneParams =
  CapturePaneParams {
    CapturePaneParams -> Maybe CaptureOutput
output :: Maybe CaptureOutput,
    CapturePaneParams -> Bool
alternate :: Bool,
    CapturePaneParams -> Bool
quiet :: Bool,
    CapturePaneParams -> Bool
escapeSequences :: Bool,
    CapturePaneParams -> Bool
octal :: Bool,
    CapturePaneParams -> Bool
joinWrapped :: Bool,
    CapturePaneParams -> Bool
incomplete :: Bool,
    CapturePaneParams -> Maybe CaptureLine
startLine :: Maybe CaptureLine,
    CapturePaneParams -> Maybe CaptureLine
endLine :: Maybe CaptureLine,
    CapturePaneParams -> Target
target :: Target,
    CapturePaneParams -> Bool
stripBlank :: Bool,
    CapturePaneParams -> Bool
stripTrailingWs :: Bool
  }
  deriving stock (CapturePaneParams -> CapturePaneParams -> Bool
(CapturePaneParams -> CapturePaneParams -> Bool)
-> (CapturePaneParams -> CapturePaneParams -> Bool)
-> Eq CapturePaneParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapturePaneParams -> CapturePaneParams -> Bool
$c/= :: CapturePaneParams -> CapturePaneParams -> Bool
== :: CapturePaneParams -> CapturePaneParams -> Bool
$c== :: CapturePaneParams -> CapturePaneParams -> Bool
Eq, Int -> CapturePaneParams -> ShowS
[CapturePaneParams] -> ShowS
CapturePaneParams -> String
(Int -> CapturePaneParams -> ShowS)
-> (CapturePaneParams -> String)
-> ([CapturePaneParams] -> ShowS)
-> Show CapturePaneParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapturePaneParams] -> ShowS
$cshowList :: [CapturePaneParams] -> ShowS
show :: CapturePaneParams -> String
$cshow :: CapturePaneParams -> String
showsPrec :: Int -> CapturePaneParams -> ShowS
$cshowsPrec :: Int -> CapturePaneParams -> ShowS
Show)

instance Default CapturePaneParams where
  def :: CapturePaneParams
def =
    CapturePaneParams :: Maybe CaptureOutput
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe CaptureLine
-> Maybe CaptureLine
-> Target
-> Bool
-> Bool
-> CapturePaneParams
CapturePaneParams {
      $sel:output:CapturePaneParams :: Maybe CaptureOutput
output = Maybe CaptureOutput
forall a. Maybe a
Nothing,
      $sel:alternate:CapturePaneParams :: Bool
alternate = Bool
False,
      $sel:quiet:CapturePaneParams :: Bool
quiet = Bool
False,
      $sel:escapeSequences:CapturePaneParams :: Bool
escapeSequences = Bool
False,
      $sel:octal:CapturePaneParams :: Bool
octal = Bool
False,
      $sel:joinWrapped:CapturePaneParams :: Bool
joinWrapped = Bool
True,
      $sel:incomplete:CapturePaneParams :: Bool
incomplete = Bool
False,
      $sel:startLine:CapturePaneParams :: Maybe CaptureLine
startLine = Maybe CaptureLine
forall a. Maybe a
Nothing,
      $sel:endLine:CapturePaneParams :: Maybe CaptureLine
endLine = Maybe CaptureLine
forall a. Maybe a
Nothing,
      $sel:target:CapturePaneParams :: Target
target = Target
Target.Current,
      $sel:stripBlank:CapturePaneParams :: Bool
stripBlank = Bool
True,
      $sel:stripTrailingWs:CapturePaneParams :: Bool
stripTrailingWs = Bool
True
    }

instance CmdArgs CapturePaneParams where
  cmdArgs :: CapturePaneParams -> [Text]
cmdArgs CapturePaneParams {Bool
Maybe CaptureLine
Maybe CaptureOutput
Target
stripTrailingWs :: Bool
stripBlank :: Bool
target :: Target
endLine :: Maybe CaptureLine
startLine :: Maybe CaptureLine
incomplete :: Bool
joinWrapped :: Bool
octal :: Bool
escapeSequences :: Bool
quiet :: Bool
alternate :: Bool
output :: Maybe CaptureOutput
$sel:stripTrailingWs:CapturePaneParams :: CapturePaneParams -> Bool
$sel:stripBlank:CapturePaneParams :: CapturePaneParams -> Bool
$sel:target:CapturePaneParams :: CapturePaneParams -> Target
$sel:endLine:CapturePaneParams :: CapturePaneParams -> Maybe CaptureLine
$sel:startLine:CapturePaneParams :: CapturePaneParams -> Maybe CaptureLine
$sel:incomplete:CapturePaneParams :: CapturePaneParams -> Bool
$sel:joinWrapped:CapturePaneParams :: CapturePaneParams -> Bool
$sel:octal:CapturePaneParams :: CapturePaneParams -> Bool
$sel:escapeSequences:CapturePaneParams :: CapturePaneParams -> Bool
$sel:quiet:CapturePaneParams :: CapturePaneParams -> Bool
$sel:alternate:CapturePaneParams :: CapturePaneParams -> Bool
$sel:output:CapturePaneParams :: CapturePaneParams -> Maybe CaptureOutput
..} =
    Text -> Bool -> [Text]
flag1 Text
"-a" Bool
alternate
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-q" Bool
quiet
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-e" Bool
escapeSequences
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-C" Bool
octal
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-J" Bool
joinWrapped
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-P" Bool
incomplete
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Maybe CaptureOutput -> [Text]
forall a. CmdArgs a => Maybe a -> [Text]
optionArgs Maybe CaptureOutput
output
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Maybe CaptureLine -> [Text]
forall a. CmdArgs a => Text -> Maybe a -> [Text]
optionArgsWith Text
"-S" Maybe CaptureLine
startLine
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Maybe CaptureLine -> [Text]
forall a. CmdArgs a => Text -> Maybe a -> [Text]
optionArgsWith Text
"-E" Maybe CaptureLine
endLine
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Target -> [Text]
forall a. CmdArgs a => a -> [Text]
cmdArgs Target
target