{-# LANGUAGE UndecidableInstances #-}

-- | Provides the 'Command' wrapper for commands.
module Shrun.Data.Command
  ( CommandP (..),
    CommandP1,
    CommandP2,
    commandToProcess,
  )
where

import Data.Hashable (Hashable)
import Data.String (IsString (fromString))
import Data.Text qualified as T
import Effects.Process.Typed (ProcessConfig)
import Effects.Process.Typed qualified as P
import Shrun.Prelude

-- $setup
-- >>> :set -XOverloadedLists

data CommandPhase
  = CommandPhase1
  | CommandPhase2

-- | Wrapper for shell commands.
type CommandP :: CommandPhase -> Type
data CommandP p = MkCommandP
  { -- | The key name for the command, for display purposes.
    forall (p :: CommandPhase). CommandP p -> Maybe Text
key :: Maybe Text,
    -- | The shell command to run.
    forall (p :: CommandPhase). CommandP p -> Text
command :: Text
  }
  deriving stock (CommandP p -> CommandP p -> Bool
(CommandP p -> CommandP p -> Bool)
-> (CommandP p -> CommandP p -> Bool) -> Eq (CommandP p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: CommandPhase). CommandP p -> CommandP p -> Bool
$c== :: forall (p :: CommandPhase). CommandP p -> CommandP p -> Bool
== :: CommandP p -> CommandP p -> Bool
$c/= :: forall (p :: CommandPhase). CommandP p -> CommandP p -> Bool
/= :: CommandP p -> CommandP p -> Bool
Eq, (forall x. CommandP p -> Rep (CommandP p) x)
-> (forall x. Rep (CommandP p) x -> CommandP p)
-> Generic (CommandP p)
forall x. Rep (CommandP p) x -> CommandP p
forall x. CommandP p -> Rep (CommandP p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (p :: CommandPhase) x. Rep (CommandP p) x -> CommandP p
forall (p :: CommandPhase) x. CommandP p -> Rep (CommandP p) x
$cfrom :: forall (p :: CommandPhase) x. CommandP p -> Rep (CommandP p) x
from :: forall x. CommandP p -> Rep (CommandP p) x
$cto :: forall (p :: CommandPhase) x. Rep (CommandP p) x -> CommandP p
to :: forall x. Rep (CommandP p) x -> CommandP p
Generic, Int -> CommandP p -> ShowS
[CommandP p] -> ShowS
CommandP p -> String
(Int -> CommandP p -> ShowS)
-> (CommandP p -> String)
-> ([CommandP p] -> ShowS)
-> Show (CommandP p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: CommandPhase). Int -> CommandP p -> ShowS
forall (p :: CommandPhase). [CommandP p] -> ShowS
forall (p :: CommandPhase). CommandP p -> String
$cshowsPrec :: forall (p :: CommandPhase). Int -> CommandP p -> ShowS
showsPrec :: Int -> CommandP p -> ShowS
$cshow :: forall (p :: CommandPhase). CommandP p -> String
show :: CommandP p -> String
$cshowList :: forall (p :: CommandPhase). [CommandP p] -> ShowS
showList :: [CommandP p] -> ShowS
Show)
  deriving anyclass (Eq (CommandP p)
Eq (CommandP p) =>
(Int -> CommandP p -> Int)
-> (CommandP p -> Int) -> Hashable (CommandP p)
Int -> CommandP p -> Int
CommandP p -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (p :: CommandPhase). Eq (CommandP p)
forall (p :: CommandPhase). Int -> CommandP p -> Int
forall (p :: CommandPhase). CommandP p -> Int
$chashWithSalt :: forall (p :: CommandPhase). Int -> CommandP p -> Int
hashWithSalt :: Int -> CommandP p -> Int
$chash :: forall (p :: CommandPhase). CommandP p -> Int
hash :: CommandP p -> Int
Hashable)

instance
  ( k ~ A_Lens,
    a ~ Maybe Text,
    b ~ Maybe Text
  ) =>
  LabelOptic "key" k (CommandP p) (CommandP p) a b
  where
  labelOptic :: Optic k NoIx (CommandP p) (CommandP p) a b
labelOptic =
    LensVL (CommandP p) (CommandP p) a b
-> Lens (CommandP p) (CommandP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (CommandP p) (CommandP p) a b
 -> Lens (CommandP p) (CommandP p) a b)
-> LensVL (CommandP p) (CommandP p) a b
-> Lens (CommandP p) (CommandP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkCommandP Maybe Text
_key Text
_command) ->
          (Maybe Text -> CommandP p) -> f (Maybe Text) -> f (CommandP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (Maybe Text -> Text -> CommandP p
forall (p :: CommandPhase). Maybe Text -> Text -> CommandP p
`MkCommandP` Text
_command)
            (a -> f b
f a
Maybe Text
_key)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ Text,
    b ~ Text
  ) =>
  LabelOptic "command" k (CommandP p) (CommandP p) a b
  where
  labelOptic :: Optic k NoIx (CommandP p) (CommandP p) a b
labelOptic =
    LensVL (CommandP p) (CommandP p) a b
-> Lens (CommandP p) (CommandP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (CommandP p) (CommandP p) a b
 -> Lens (CommandP p) (CommandP p) a b)
-> LensVL (CommandP p) (CommandP p) a b
-> Lens (CommandP p) (CommandP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkCommandP Maybe Text
_key Text
_command) ->
          (Text -> CommandP p) -> f Text -> f (CommandP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (Maybe Text -> Text -> CommandP p
forall (p :: CommandPhase). Maybe Text -> Text -> CommandP p
MkCommandP Maybe Text
_key)
            (a -> f b
f a
Text
_command)
  {-# INLINE labelOptic #-}

instance IsString (CommandP CommandPhase1) where
  fromString :: String -> CommandP1
fromString = Maybe Text -> Text -> CommandP1
forall (p :: CommandPhase). Maybe Text -> Text -> CommandP p
MkCommandP Maybe Text
forall a. Maybe a
Nothing (Text -> CommandP1) -> (String -> Text) -> String -> CommandP1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Phase1 commands.
type CommandP1 = CommandP CommandPhase1

-- | Phase2 commands.
type CommandP2 = CommandP CommandPhase2

advancePhase :: CommandP1 -> Maybe Text -> CommandP2
advancePhase :: CommandP1 -> Maybe Text -> CommandP2
advancePhase CommandP1
cmd Maybe Text
minit = Optic A_Lens NoIx CommandP1 CommandP2 Text Text
-> (Text -> Text) -> CommandP1 -> CommandP2
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over' Optic A_Lens NoIx CommandP1 CommandP2 Text Text
#command Text -> Text
f CommandP1
cmd
  where
    f :: Text -> Text
f = case Maybe Text
minit of
      Maybe Text
Nothing -> Text -> Text
forall a. a -> a
id
      Just Text
init -> \Text
c -> Text
init Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" && " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c

-- | Transforms a command into its text to be executed by the shell.
commandToShell :: CommandP2 -> String
commandToShell :: CommandP2 -> String
commandToShell = Text -> String
T.unpack (Text -> String) -> (CommandP2 -> Text) -> CommandP2 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx CommandP2 Text -> CommandP2 -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx CommandP2 Text
#command

-- Transforms a command into a 'ProcessConfig'.
--
commandToProcess :: CommandP1 -> Maybe Text -> ProcessConfig () () ()
commandToProcess :: CommandP1 -> Maybe Text -> ProcessConfig () () ()
commandToProcess CommandP1
command =
  String -> ProcessConfig () () ()
P.shell
    (String -> ProcessConfig () () ())
-> (Maybe Text -> String) -> Maybe Text -> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandP2 -> String
commandToShell
    (CommandP2 -> String)
-> (Maybe Text -> CommandP2) -> Maybe Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandP1 -> Maybe Text -> CommandP2
advancePhase CommandP1
command