{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

module Control.Process.CmdSpec
  ( CmdSpec (..),
    GetCmdSpec (..),
    HasCmdSpec (..),
    ReviewCmdSpec (..),
    AsCmdSpec (..),
  )
where

import Control.Category (id, (.))
import Control.Lens
  ( Field1 (_1),
    Field2 (_2),
    Getter,
    Lens',
    Prism',
    Review,
    Traversable (traverse),
    Traversal',
    prism',
    to,
    unto,
  )
import Data.Functor (Functor (fmap))
import Data.Maybe (Maybe (Just, Nothing))
import Data.String (String)
import Data.Tuple (uncurry)
import System.FilePath (FilePath)
import System.Process (CmdSpec (..), CreateProcess)
import qualified System.Process as Process (CreateProcess (..))

-- $setup
-- >>> import Prelude
-- >>> import Control.Lens

-- | Type class for values that can be viewed as a @CmdSpec@.
--
-- >>> view getCmdSpec (ShellCommand "ls -la")
-- ShellCommand "ls -la"
class GetCmdSpec a where
  getCmdSpec ::
    Getter a CmdSpec

-- |
--
-- >>> view getCmdSpec (ShellCommand "ls -la")
-- ShellCommand "ls -la"
instance GetCmdSpec CmdSpec where
  getCmdSpec :: Getter CmdSpec CmdSpec
getCmdSpec = (CmdSpec -> f CmdSpec) -> CmdSpec -> f CmdSpec
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  {-# INLINE getCmdSpec #-}

-- |
--
-- >>> import System.Process (proc)
-- >>> view getCmdSpec (proc "echo" ["hello"])
-- RawCommand "echo" ["hello"]
instance GetCmdSpec CreateProcess where
  getCmdSpec :: Getter CreateProcess CmdSpec
getCmdSpec = (CreateProcess -> CmdSpec)
-> (CmdSpec -> f CmdSpec) -> CreateProcess -> f CreateProcess
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to CreateProcess -> CmdSpec
Process.cmdspec
  {-# INLINE getCmdSpec #-}

-- | Type class for values with a lens into a @CmdSpec@.
--
-- >>> view cmdSpec (ShellCommand "ls -la")
-- ShellCommand "ls -la"
class (GetCmdSpec a) => HasCmdSpec a where
  cmdSpec ::
    Lens' a CmdSpec
  {-# INLINE shellCommand #-}
  shellCommand ::
    Traversal' a String
  shellCommand =
    (CmdSpec -> f CmdSpec) -> a -> f a
forall a. HasCmdSpec a => Lens' a CmdSpec
Lens' a CmdSpec
cmdSpec ((CmdSpec -> f CmdSpec) -> a -> f a)
-> ((String -> f String) -> CmdSpec -> f CmdSpec)
-> (String -> f String)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> f String) -> CmdSpec -> f CmdSpec
forall a. AsCmdSpec a => Prism' a String
Prism' CmdSpec String
_ShellCommand
  {-# INLINE rawCommand #-}
  rawCommand ::
    Traversal' a (FilePath, [String])
  rawCommand =
    (CmdSpec -> f CmdSpec) -> a -> f a
forall a. HasCmdSpec a => Lens' a CmdSpec
Lens' a CmdSpec
cmdSpec ((CmdSpec -> f CmdSpec) -> a -> f a)
-> (((String, [String]) -> f (String, [String]))
    -> CmdSpec -> f CmdSpec)
-> ((String, [String]) -> f (String, [String]))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((String, [String]) -> f (String, [String]))
-> CmdSpec -> f CmdSpec
forall a. AsCmdSpec a => Prism' a (String, [String])
Prism' CmdSpec (String, [String])
_RawCommand
  {-# INLINE rawCommandExe #-}
  rawCommandExe ::
    Traversal' a FilePath
  rawCommandExe =
    ((String, [String]) -> f (String, [String])) -> a -> f a
forall a. HasCmdSpec a => Traversal' a (String, [String])
Traversal' a (String, [String])
rawCommand (((String, [String]) -> f (String, [String])) -> a -> f a)
-> ((String -> f String)
    -> (String, [String]) -> f (String, [String]))
-> (String -> f String)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> f String) -> (String, [String]) -> f (String, [String])
forall s t a b. Field1 s t a b => Lens s t a b
Lens (String, [String]) (String, [String]) String String
_1
  {-# INLINE rawCommandArgumentList #-}
  rawCommandArgumentList ::
    Traversal' a [String]
  rawCommandArgumentList =
    ((String, [String]) -> f (String, [String])) -> a -> f a
forall a. HasCmdSpec a => Traversal' a (String, [String])
Traversal' a (String, [String])
rawCommand (((String, [String]) -> f (String, [String])) -> a -> f a)
-> (([String] -> f [String])
    -> (String, [String]) -> f (String, [String]))
-> ([String] -> f [String])
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([String] -> f [String])
-> (String, [String]) -> f (String, [String])
forall s t a b. Field2 s t a b => Lens s t a b
Lens (String, [String]) (String, [String]) [String] [String]
_2
  {-# INLINE rawCommandArguments #-}
  rawCommandArguments ::
    Traversal' a String
  rawCommandArguments =
    ([String] -> f [String]) -> a -> f a
forall a. HasCmdSpec a => Traversal' a [String]
Traversal' a [String]
rawCommandArgumentList (([String] -> f [String]) -> a -> f a)
-> ((String -> f String) -> [String] -> f [String])
-> (String -> f String)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> f String) -> [String] -> f [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse

-- |
--
-- >>> view cmdSpec (ShellCommand "ls")
-- ShellCommand "ls"
-- >>> set cmdSpec (RawCommand "echo" ["hi"]) (ShellCommand "ls")
-- RawCommand "echo" ["hi"]
instance HasCmdSpec CmdSpec where
  cmdSpec :: Lens' CmdSpec CmdSpec
cmdSpec =
    (CmdSpec -> f CmdSpec) -> CmdSpec -> f CmdSpec
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- |
--
-- >>> import System.Process (proc)
-- >>> view cmdSpec (proc "echo" ["hello"])
-- RawCommand "echo" ["hello"]
instance HasCmdSpec CreateProcess where
  cmdSpec :: Lens' CreateProcess CmdSpec
cmdSpec CmdSpec -> f CmdSpec
f CreateProcess
p =
    (CmdSpec -> CreateProcess) -> f CmdSpec -> f CreateProcess
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CmdSpec
x -> CreateProcess
p {Process.cmdspec = x}) (CmdSpec -> f CmdSpec
f (CreateProcess -> CmdSpec
Process.cmdspec CreateProcess
p))

-- | Type class for values that can be constructed from a @CmdSpec@.
--
-- >>> review reviewCmdSpec (ShellCommand "ls") :: CmdSpec
-- ShellCommand "ls"
class ReviewCmdSpec a where
  reviewCmdSpec ::
    Review a CmdSpec

-- |
--
-- >>> review reviewCmdSpec (ShellCommand "ls") :: CmdSpec
-- ShellCommand "ls"
instance ReviewCmdSpec CmdSpec where
  reviewCmdSpec :: Review CmdSpec CmdSpec
reviewCmdSpec = (CmdSpec -> CmdSpec) -> Optic p f CmdSpec CmdSpec CmdSpec CmdSpec
forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto CmdSpec -> CmdSpec
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  {-# INLINE reviewCmdSpec #-}

-- | Type class for values with a prism into a @CmdSpec@.
--
-- >>> preview _CmdSpec (ShellCommand "ls -la")
-- Just (ShellCommand "ls -la")
class (ReviewCmdSpec a) => AsCmdSpec a where
  _CmdSpec ::
    Prism' a CmdSpec
  {-# INLINE _ShellCommand #-}
  _ShellCommand ::
    Prism' a String
  _ShellCommand =
    p CmdSpec (f CmdSpec) -> p a (f a)
forall a. AsCmdSpec a => Prism' a CmdSpec
Prism' a CmdSpec
_CmdSpec (p CmdSpec (f CmdSpec) -> p a (f a))
-> (p String (f String) -> p CmdSpec (f CmdSpec))
-> p String (f String)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p String (f String) -> p CmdSpec (f CmdSpec)
forall a. AsCmdSpec a => Prism' a String
Prism' CmdSpec String
_ShellCommand
  {-# INLINE _RawCommand #-}
  _RawCommand ::
    Prism' a (FilePath, [String])
  _RawCommand =
    p CmdSpec (f CmdSpec) -> p a (f a)
forall a. AsCmdSpec a => Prism' a CmdSpec
Prism' a CmdSpec
_CmdSpec (p CmdSpec (f CmdSpec) -> p a (f a))
-> (p (String, [String]) (f (String, [String]))
    -> p CmdSpec (f CmdSpec))
-> p (String, [String]) (f (String, [String]))
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p (String, [String]) (f (String, [String]))
-> p CmdSpec (f CmdSpec)
forall a. AsCmdSpec a => Prism' a (String, [String])
Prism' CmdSpec (String, [String])
_RawCommand
  {-# INLINE _RawCommandExe #-}
  _RawCommandExe ::
    Traversal' a FilePath
  _RawCommandExe =
    ((String, [String]) -> f (String, [String])) -> a -> f a
forall a. AsCmdSpec a => Prism' a (String, [String])
Prism' a (String, [String])
_RawCommand (((String, [String]) -> f (String, [String])) -> a -> f a)
-> ((String -> f String)
    -> (String, [String]) -> f (String, [String]))
-> (String -> f String)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> f String) -> (String, [String]) -> f (String, [String])
forall s t a b. Field1 s t a b => Lens s t a b
Lens (String, [String]) (String, [String]) String String
_1
  {-# INLINE _RawCommandArgumentList #-}
  _RawCommandArgumentList ::
    Traversal' a [String]
  _RawCommandArgumentList =
    ((String, [String]) -> f (String, [String])) -> a -> f a
forall a. AsCmdSpec a => Prism' a (String, [String])
Prism' a (String, [String])
_RawCommand (((String, [String]) -> f (String, [String])) -> a -> f a)
-> (([String] -> f [String])
    -> (String, [String]) -> f (String, [String]))
-> ([String] -> f [String])
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([String] -> f [String])
-> (String, [String]) -> f (String, [String])
forall s t a b. Field2 s t a b => Lens s t a b
Lens (String, [String]) (String, [String]) [String] [String]
_2
  {-# INLINE _RawCommandArguments #-}
  _RawCommandArguments ::
    Traversal' a String
  _RawCommandArguments =
    ([String] -> f [String]) -> a -> f a
forall a. AsCmdSpec a => Traversal' a [String]
Traversal' a [String]
_RawCommandArgumentList (([String] -> f [String]) -> a -> f a)
-> ((String -> f String) -> [String] -> f [String])
-> (String -> f String)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> f String) -> [String] -> f [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse

-- |
--
-- >>> preview _ShellCommand (ShellCommand "ls -la")
-- Just "ls -la"
-- >>> preview _ShellCommand (RawCommand "ls" ["-la"])
-- Nothing
-- >>> preview _RawCommand (RawCommand "ls" ["-la"])
-- Just ("ls",["-la"])
-- >>> preview _RawCommand (ShellCommand "ls -la")
-- Nothing
-- >>> review _ShellCommand "echo hello" :: CmdSpec
-- ShellCommand "echo hello"
-- >>> review _RawCommand ("/bin/ls", ["-la"]) :: CmdSpec
-- RawCommand "/bin/ls" ["-la"]
instance AsCmdSpec CmdSpec where
  _CmdSpec :: Prism' CmdSpec CmdSpec
_CmdSpec = p CmdSpec (f CmdSpec) -> p CmdSpec (f CmdSpec)
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  _ShellCommand :: Prism' CmdSpec String
_ShellCommand =
    (String -> CmdSpec)
-> (CmdSpec -> Maybe String) -> Prism' CmdSpec String
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      String -> CmdSpec
ShellCommand
      ( \case
          ShellCommand String
a -> String -> Maybe String
forall a. a -> Maybe a
Just String
a
          CmdSpec
_ -> Maybe String
forall a. Maybe a
Nothing
      )
  _RawCommand :: Prism' CmdSpec (String, [String])
_RawCommand =
    ((String, [String]) -> CmdSpec)
-> (CmdSpec -> Maybe (String, [String]))
-> Prism' CmdSpec (String, [String])
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      ((String -> [String] -> CmdSpec) -> (String, [String]) -> CmdSpec
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [String] -> CmdSpec
RawCommand)
      ( \case
          RawCommand String
a [String]
b -> (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
a, [String]
b)
          CmdSpec
_ -> Maybe (String, [String])
forall a. Maybe a
Nothing
      )