module Chiasma.Data.SendKeysParams where

import qualified Data.Text as Text
import Exon (exon)
import Prelude hiding (repeat)

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

escape :: Text -> Text
escape :: Text -> Text
escape Text
fragment =
  [exon|"#{escapeQuotes}"|]
  where
    escapeQuotes :: Text
escapeQuotes =
      Text -> Text -> Text -> Text
Text.replace [exon|"|] [exon|\"|] Text
fragment

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

instance IsString Key where
  fromString :: String -> Key
fromString =
    Text -> Key
Lit (Text -> Key) -> (String -> Text) -> String -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText

instance CmdArgs Key where
  cmdArgs :: Key -> [Text]
cmdArgs = \case
    Key Text
k -> [Text
Item [Text]
k]
    Lit Text
s -> [Text -> Text
escape Text
s]

data SendKeysParams =
  SendKeysParams {
    SendKeysParams -> Bool
enter :: Bool,
    SendKeysParams -> Bool
literal :: Bool,
    SendKeysParams -> Bool
hex :: Bool,
    SendKeysParams -> Bool
reset :: Bool,
    SendKeysParams -> Bool
mouse :: Bool,
    SendKeysParams -> Bool
copyMode :: Bool,
    SendKeysParams -> Maybe Int
repeat :: Maybe Int,
    SendKeysParams -> [Key]
keys :: [Key],
    SendKeysParams -> Target
target :: Target
  }
  deriving stock (SendKeysParams -> SendKeysParams -> Bool
(SendKeysParams -> SendKeysParams -> Bool)
-> (SendKeysParams -> SendKeysParams -> Bool) -> Eq SendKeysParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendKeysParams -> SendKeysParams -> Bool
$c/= :: SendKeysParams -> SendKeysParams -> Bool
== :: SendKeysParams -> SendKeysParams -> Bool
$c== :: SendKeysParams -> SendKeysParams -> Bool
Eq, Int -> SendKeysParams -> ShowS
[SendKeysParams] -> ShowS
SendKeysParams -> String
(Int -> SendKeysParams -> ShowS)
-> (SendKeysParams -> String)
-> ([SendKeysParams] -> ShowS)
-> Show SendKeysParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendKeysParams] -> ShowS
$cshowList :: [SendKeysParams] -> ShowS
show :: SendKeysParams -> String
$cshow :: SendKeysParams -> String
showsPrec :: Int -> SendKeysParams -> ShowS
$cshowsPrec :: Int -> SendKeysParams -> ShowS
Show)

instance Default SendKeysParams where
  def :: SendKeysParams
def =
    SendKeysParams :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Int
-> [Key]
-> Target
-> SendKeysParams
SendKeysParams {
      $sel:enter:SendKeysParams :: Bool
enter = Bool
True,
      $sel:literal:SendKeysParams :: Bool
literal = Bool
False,
      $sel:hex:SendKeysParams :: Bool
hex = Bool
False,
      $sel:reset:SendKeysParams :: Bool
reset = Bool
False,
      $sel:mouse:SendKeysParams :: Bool
mouse = Bool
False,
      $sel:copyMode:SendKeysParams :: Bool
copyMode = Bool
False,
      $sel:repeat:SendKeysParams :: Maybe Int
repeat = Maybe Int
forall a. Maybe a
Nothing,
      $sel:keys:SendKeysParams :: [Key]
keys = [Key]
forall a. Monoid a => a
mempty,
      $sel:target:SendKeysParams :: Target
target = Target
forall a. Default a => a
def
    }

instance CmdArgs SendKeysParams where
  cmdArgs :: SendKeysParams -> [Text]
cmdArgs SendKeysParams {Bool
[Key]
Maybe Int
Target
target :: Target
keys :: [Key]
repeat :: Maybe Int
copyMode :: Bool
mouse :: Bool
reset :: Bool
hex :: Bool
literal :: Bool
enter :: Bool
$sel:target:SendKeysParams :: SendKeysParams -> Target
$sel:keys:SendKeysParams :: SendKeysParams -> [Key]
$sel:repeat:SendKeysParams :: SendKeysParams -> Maybe Int
$sel:copyMode:SendKeysParams :: SendKeysParams -> Bool
$sel:mouse:SendKeysParams :: SendKeysParams -> Bool
$sel:reset:SendKeysParams :: SendKeysParams -> Bool
$sel:hex:SendKeysParams :: SendKeysParams -> Bool
$sel:literal:SendKeysParams :: SendKeysParams -> Bool
$sel:enter:SendKeysParams :: SendKeysParams -> Bool
..} =
    Text -> Bool -> [Text]
flag1 Text
"-l" Bool
literal
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-H" Bool
hex
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-R" Bool
reset
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-M" Bool
mouse
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"-X" Bool
copyMode
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> (Int -> Text) -> Maybe Int -> [Text]
forall a. Text -> (a -> Text) -> Maybe a -> [Text]
optionWith Text
"-N" Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Maybe Int
repeat
    [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
<>
    (Key -> [Text]
forall a. CmdArgs a => a -> [Text]
cmdArgs (Key -> [Text]) -> [Key] -> [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Key]
keys)
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    Text -> Bool -> [Text]
flag1 Text
"enter" (Bool
enter Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
copyMode)