module Chiasma.Data.WindowParams where

import Path (Abs, Dir, Path)

import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), arg, envVars, flag1, identOption, optionWith)
import Chiasma.Data.Ident (Ident)
import Chiasma.Data.Target (Target)
import Chiasma.Path (pathText')

data WindowParams =
  WindowParams {
    WindowParams -> Bool
after :: Bool,
    WindowParams -> Bool
detach :: Bool,
    WindowParams -> Bool
killExisting :: Bool,
    WindowParams -> Bool
printInfo :: Bool,
    WindowParams -> Maybe (Path Abs Dir)
cwd :: Maybe (Path Abs Dir),
    WindowParams -> Map Text Text
environment :: Map Text Text,
    WindowParams -> Maybe Ident
name :: Maybe Ident,
    WindowParams -> Target
target :: Target,
    WindowParams -> Maybe Text
command :: Maybe Text
  }
  deriving stock (WindowParams -> WindowParams -> Bool
(WindowParams -> WindowParams -> Bool)
-> (WindowParams -> WindowParams -> Bool) -> Eq WindowParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowParams -> WindowParams -> Bool
== :: WindowParams -> WindowParams -> Bool
$c/= :: WindowParams -> WindowParams -> Bool
/= :: WindowParams -> WindowParams -> Bool
Eq, Int -> WindowParams -> ShowS
[WindowParams] -> ShowS
WindowParams -> String
(Int -> WindowParams -> ShowS)
-> (WindowParams -> String)
-> ([WindowParams] -> ShowS)
-> Show WindowParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowParams -> ShowS
showsPrec :: Int -> WindowParams -> ShowS
$cshow :: WindowParams -> String
show :: WindowParams -> String
$cshowList :: [WindowParams] -> ShowS
showList :: [WindowParams] -> ShowS
Show)

instance Default WindowParams where
  def :: WindowParams
def =
    WindowParams {
      $sel:after:WindowParams :: Bool
after = Bool
False,
      $sel:detach:WindowParams :: Bool
detach = Bool
False,
      $sel:killExisting:WindowParams :: Bool
killExisting = Bool
False,
      $sel:printInfo:WindowParams :: Bool
printInfo = Bool
True,
      $sel:cwd:WindowParams :: Maybe (Path Abs Dir)
cwd = Maybe (Path Abs Dir)
forall a. Maybe a
Nothing,
      $sel:environment:WindowParams :: Map Text Text
environment = Map Text Text
forall a. Monoid a => a
mempty,
      $sel:name:WindowParams :: Maybe Ident
name = Maybe Ident
forall a. Maybe a
Nothing,
      $sel:target:WindowParams :: Target
target = Target
forall a. Default a => a
def,
      $sel:command:WindowParams :: Maybe Text
command = Maybe Text
forall a. Maybe a
Nothing
    }

instance CmdArgs WindowParams where
  cmdArgs :: WindowParams -> [Text]
cmdArgs WindowParams {Bool
Maybe Text
Maybe (Path Abs Dir)
Maybe Ident
Map Text Text
Target
$sel:after:WindowParams :: WindowParams -> Bool
$sel:detach:WindowParams :: WindowParams -> Bool
$sel:killExisting:WindowParams :: WindowParams -> Bool
$sel:printInfo:WindowParams :: WindowParams -> Bool
$sel:cwd:WindowParams :: WindowParams -> Maybe (Path Abs Dir)
$sel:environment:WindowParams :: WindowParams -> Map Text Text
$sel:name:WindowParams :: WindowParams -> Maybe Ident
$sel:target:WindowParams :: WindowParams -> Target
$sel:command:WindowParams :: WindowParams -> Maybe Text
after :: Bool
detach :: Bool
killExisting :: Bool
printInfo :: Bool
cwd :: Maybe (Path Abs Dir)
environment :: Map Text Text
name :: Maybe Ident
target :: Target
command :: Maybe Text
..} =
    Text -> Bool -> [Text]
flag1 Text
"-a" Bool
after
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-d" Bool
detach
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-k" Bool
killExisting
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-P" Bool
printInfo
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> (Path Abs Dir -> Text) -> Maybe (Path Abs Dir) -> [Text]
forall a. Text -> (a -> Text) -> Maybe a -> [Text]
optionWith Text
"-c" Path Abs Dir -> Text
forall b t. Path b t -> Text
pathText' Maybe (Path Abs Dir)
cwd
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Map Text Text -> [Text]
envVars Map Text Text
environment
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Maybe Ident -> [Text]
identOption Text
"-n" Maybe Ident
name
    [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