{-# LANGUAGE TypeFamilies #-}
-- |
-- Module       : System.Process.Microlens.CmdSpec
-- Copyright 	: 2019 Emily Pillmore
-- License	: BSD
--
-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>
-- Stability	: Experimental
-- Portability	: TypeFamilies
--
-- This module provides the associated optics and combinators
-- for working with 'CmdSpec' objects. 'CmdSpec' consists of two
-- cases: a Shell command, which is a command to execute naively in the shell,
-- and a Raw command which is a command path together with its arguments.
--
-- 'CmdSpec' has two cases, and therefore a 'Traversal' into those two cases.
-- There is also a convenient 'Traversal' available for working with the arglist
-- of a Raw command and combinators for working with arguments monoidally.
--
-- We provide classy variants for all useful traversals
--
module System.Process.Microlens.CmdSpec
( -- * Traversals
  _RawCommand
, _ShellCommand
, arguments
  -- * Classy Traversals
, IsShell(..)
, IsRaw(..)
  -- * Combinators
, arguing
) where


import Control.Applicative

import Lens.Micro
import System.Process

-- $setup
-- >>> import Lens.Micro
-- >>> import System.Process
-- >>> :set -XTypeApplications
-- >>> :set -XRank2Types

-- | A 'Traversal'' into the 'ShellCommand' case of a 'CmdSpec'
--
-- Examples:
--
--
-- >>> ShellCommand "ls -l" ^? _ShellCommand
-- Just "ls -l"
--
-- >>> RawCommand "/bin/ls" ["-l"] ^? _ShellCommand
-- Nothing
--
_ShellCommand :: Traversal' CmdSpec String
_ShellCommand :: (String -> f String) -> CmdSpec -> f CmdSpec
_ShellCommand f :: String -> f String
f c :: CmdSpec
c = case CmdSpec
c of
  ShellCommand s :: String
s -> (String -> CmdSpec) -> f String -> f CmdSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> CmdSpec
ShellCommand (String -> f String
f String
s)
  _ -> CmdSpec -> f CmdSpec
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmdSpec
c

-- | A 'Traversal'' into the 'RawCommand' case of a 'CmdSpec'
--
-- Examples:
--
-- >>> RawCommand "/bin/ls" ["-l"] ^? _RawCommand
-- Just ("/bin/ls",["-l"])
--
-- >>> RawCommand "/bin/ls" ["-l"] ^? _ShellCommand
-- Nothing
--
-- >>> RawCommand "/bin/ls" ["-l"] ^. _RawCommand . _1
-- "/bin/ls"
--
-- >>> RawCommand "/bin/ls" ["-l"] ^. _RawCommand . _2
-- ["-l"]
--
_RawCommand :: Traversal' CmdSpec (FilePath, [String])
_RawCommand :: ((String, [String]) -> f (String, [String]))
-> CmdSpec -> f CmdSpec
_RawCommand f :: (String, [String]) -> f (String, [String])
f c :: CmdSpec
c = case CmdSpec
c of
  RawCommand fp :: String
fp s :: [String]
s -> ((String, [String]) -> CmdSpec)
-> f (String, [String]) -> f CmdSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> [String] -> CmdSpec) -> (String, [String]) -> CmdSpec
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [String] -> CmdSpec
RawCommand) (f (String, [String]) -> f CmdSpec)
-> f (String, [String]) -> f CmdSpec
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> f (String, [String])
f (String
fp, [String]
s)
  _ -> CmdSpec -> f CmdSpec
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmdSpec
c

-- $setup
-- >>> import Lens.Micro
-- >>> import System.Process
-- >>> :set -XTypeApplications
-- >>> :set -XRank2Types

-- | 'Traversal'' into the arguments of a command
--
-- Examples:
--
-- >>> RawCommand "/bin/ls" ["-l"] ^. arguments
-- ["-l"]
--
arguments :: Traversal' CmdSpec [String]
arguments :: ([String] -> f [String]) -> CmdSpec -> f CmdSpec
arguments = ((String, [String]) -> f (String, [String]))
-> CmdSpec -> f CmdSpec
Traversal' CmdSpec (String, [String])
_RawCommand (((String, [String]) -> f (String, [String]))
 -> CmdSpec -> f CmdSpec)
-> (([String] -> f [String])
    -> (String, [String]) -> f (String, [String]))
-> ([String] -> f [String])
-> CmdSpec
-> f CmdSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> f [String])
-> (String, [String]) -> f (String, [String])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse

-- | Classy 'Traversal'' into the shell command of a 'CmdSpec'
--
class IsShell a where
  _Shell :: Traversal' a String
  {-# MINIMAL _Shell #-}

instance IsShell CmdSpec where
  _Shell :: (String -> f String) -> CmdSpec -> f CmdSpec
_Shell = (String -> f String) -> CmdSpec -> f CmdSpec
Traversal' CmdSpec String
_ShellCommand

-- | Classy 'Traversal'' into the raw command of a 'CmdSpec'
--
class IsRaw a where
  _Raw :: Traversal' a (FilePath, [String])
  {-# MINIMAL _Raw #-}

instance IsRaw CmdSpec where
  _Raw :: ((String, [String]) -> f (String, [String]))
-> CmdSpec -> f CmdSpec
_Raw = ((String, [String]) -> f (String, [String]))
-> CmdSpec -> f CmdSpec
Traversal' CmdSpec (String, [String])
_RawCommand


-- | Append an argument to the argument list of a 'RawCommand'
--
-- Examples:
--
-- >>> arguing "-h" $ RawCommand "/bin/ls" ["-l"]
-- RawCommand "/bin/ls" ["-l","-h"]
--
-- >>> arguing "-h" (RawCommand "/bin/ls" ["-l"]) ^. arguments
-- ["-l","-h"]
--
arguing :: String -> CmdSpec -> CmdSpec
arguing :: String -> CmdSpec -> CmdSpec
arguing s :: String
s = ([String] -> Identity [String]) -> CmdSpec -> Identity CmdSpec
Traversal' CmdSpec [String]
arguments (([String] -> Identity [String]) -> CmdSpec -> Identity CmdSpec)
-> [String] -> CmdSpec -> CmdSpec
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ [String
s]