diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,16 @@ # Revision history for microlens-process +## 0.2.0.0 + +Final design - this will not change unless `System.Process` significantly changes. + +- `System.Process.Microlens.CommandSpec` is renamed to `System.Process.Microlens.CmdSpec` to be more flush with the data names +- documentation improvements all around +- Type signatures of combinators `inheriting`, `piping`, `handling` and `nostreaming` have had their unnecessary constraints dropped +- `microlens-process` is now in lockstep featurewise +- Traversals + Lenses have been added where in `lens-process` they would have been Prisms and Isos respectively. While it is slightly + too powerful a constraint, the functionality is sound. + ## 0.1.0.2 GHC versions < 710 fail because applicative is not in base. Explicit import diff --git a/microlens-process.cabal b/microlens-process.cabal --- a/microlens-process.cabal +++ b/microlens-process.cabal @@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/ name: microlens-process -version: 0.1.0.3 +version: 0.2.0.0 synopsis: Micro-optics for the process library description: 'microlens-process' is a set of multi-purpose optics and convenience @@ -38,7 +38,10 @@ library exposed-modules: System.Process.Microlens , System.Process.Microlens.CreateProcess - , System.Process.Microlens.CommandSpec + , System.Process.Microlens.CmdSpec + , System.Process.Microlens.Optics + , System.Process.Microlens.ProcessHandler + , System.Process.Microlens.StdStream build-depends: base >= 4.0 && < 5 , filepath >= 1.0 && < 1.5 @@ -54,8 +57,8 @@ type: exitcode-stdio-1.0 build-depends: base >= 4.0 && < 5 - , doctest >= 0.16 && < 0.17 - , microlens >= 0.4.11 && < 0.4.12 + , doctest >= 0.16 && < 1.1 + , microlens >= 0.2.0.0 && < 0.4.12.0 , microlens-process , process >= 1.3 && < 1.7 diff --git a/src/System/Process/Microlens.hs b/src/System/Process/Microlens.hs --- a/src/System/Process/Microlens.hs +++ b/src/System/Process/Microlens.hs @@ -1,15 +1,15 @@ {-# LANGUAGE Rank2Types #-} -- | +-- Module : System.Process.Microlens -- Copyright : 2019 Emily Pillmore -- License : BSD -{-# LANGUAGE CPP #-} -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : TypeFamilies, RankNTypes -- -- This module provides all of the optical exports, as well ask any associated --- combinators. For just the optics, see 'System.Process.Lens.Optics', or +-- combinators. For just the optics, see 'System.Process.Microlens.Optics', or -- if you are in need of something lighter weight, just for working with a -- 'CreateProcess' in terms of getters and setters, see -- @@ -17,37 +17,13 @@ -- in the #haskell-lens channel. -- module System.Process.Microlens -( -- * Lenses - cmdspec_ -, cwd_ -, env_ -, stdin_ -, stdout_ -, stderr_ -, closefds -, creategroup -, delegatectlc -#if MIN_VERSION_process(1, 3, 0) -, detachconsole -, createnewconsole -, newsession -#endif -#if MIN_VERSION_process(1, 4, 0) -, childgroup -, childuser -#endif -#if MIN_VERSION_process(1, 5, 0) -, useprocessjobs -#endif - -- * Traversals -, arguments - -- * Classy Lenses -, HasStdin(..) -, HasStdout(..) -, HasStderr(..) - -- * Combinators -, arguing +( module System.Process.Microlens.CmdSpec +, module System.Process.Microlens.CreateProcess +, module System.Process.Microlens.ProcessHandler +, module System.Process.Microlens.StdStream ) where -import System.Process.Microlens.CommandSpec +import System.Process.Microlens.CmdSpec import System.Process.Microlens.CreateProcess +import System.Process.Microlens.ProcessHandler +import System.Process.Microlens.StdStream diff --git a/src/System/Process/Microlens/CmdSpec.hs b/src/System/Process/Microlens/CmdSpec.hs new file mode 100644 --- /dev/null +++ b/src/System/Process/Microlens/CmdSpec.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module : System.Process.Microlens.CmdSpec +-- Copyright : 2019 Emily Pillmore +-- License : BSD +-- +-- Maintainer : Emily Pillmore +-- 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 f c = case c of + ShellCommand s -> fmap ShellCommand (f s) + _ -> pure 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 f c = case c of + RawCommand fp s -> fmap (uncurry RawCommand) $ f (fp, s) + _ -> pure 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 = _RawCommand . 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 = _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 = _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 s = arguments <>~ [s] diff --git a/src/System/Process/Microlens/CommandSpec.hs b/src/System/Process/Microlens/CommandSpec.hs deleted file mode 100644 --- a/src/System/Process/Microlens/CommandSpec.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} --- | --- Module : System.Process.Lens.CommandSpec --- Copyright : 2019 Emily Pillmore --- License : BSD --- --- Maintainer : Emily Pillmore --- Stability : Experimental --- Portability : TypeFamilies --- --- This module provides the associated optics and combinators --- for working with 'CommandSpec' objects. 'CommandSpec' 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. --- --- 'CommandSpec' has two cases, and therefore a prism into those two cases. --- There is also a convenient 'Traversal' available for working with the arglist --- of a Raw command, as well as associated 'Review's for each prism, and combinators --- for working with arguments monoidally. --- --- We provide classy variants for all useful prisms --- -module System.Process.Microlens.CommandSpec -( -- * Traversals - arguments - -- * Combinators -, arguing -) where - - -import Control.Applicative - -import Lens.Micro -import System.Process - - --- $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 f c = case c of - RawCommand fp args -> fmap (RawCommand fp) $ f args - t -> pure t --- | 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 s = arguments <>~ [s] diff --git a/src/System/Process/Microlens/CreateProcess.hs b/src/System/Process/Microlens/CreateProcess.hs --- a/src/System/Process/Microlens/CreateProcess.hs +++ b/src/System/Process/Microlens/CreateProcess.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} -- | --- Module : Sysetem.Process.Lens.CreateProcess +-- Module : System.Process.Microlens.CreateProcess -- Copyright : 2019 Emily Pillmore -- License : BSD -- diff --git a/src/System/Process/Microlens/Optics.hs b/src/System/Process/Microlens/Optics.hs new file mode 100644 --- /dev/null +++ b/src/System/Process/Microlens/Optics.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE CPP #-} +-- | +-- Module : System.Process.Microlens.Optics +-- Copyright : 2019 Emily Pillmore +-- License : BSD +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : TypeFamilies, Rank2Types +-- +-- Just the (classy) optics +-- +module System.Process.Microlens.Optics +( -- * Traversals + _ShellCommand +, _RawCommand +, _Inherit +, _UseHandle +, _CreatePipe +, _NoStream +, arguments + -- * Lenses +, _Handler +, cmdspec_ +, cwd_ +, env_ +, stdin_ +, stdout_ +, stderr_ +, closefds +, creategroup +, delegatectlc +, newsession +#if MIN_VERSION_process(1, 3, 0) +, detachconsole +, createnewconsole +#endif +#if MIN_VERSION_process(1, 4, 0) +, childgroup +, childuser +#endif +#if MIN_VERSION_process(1, 5, 0) +, useprocessjobs +#endif +, hstdin +, hstdout +, hstderr +, hhandle + -- * Classy Prisms +, IsRaw(..) +, IsShell(..) +, IsInherit(..) +, IsUseHandle(..) +, IsCreatePipe(..) +, IsNoStream(..) + -- * Classy Lenses +, HasStdin(..) +, HasStdout(..) +, HasStderr(..) +) where + +import System.Process.Microlens.CmdSpec +import System.Process.Microlens.CreateProcess +import System.Process.Microlens.ProcessHandler +import System.Process.Microlens.StdStream diff --git a/src/System/Process/Microlens/ProcessHandler.hs b/src/System/Process/Microlens/ProcessHandler.hs new file mode 100644 --- /dev/null +++ b/src/System/Process/Microlens/ProcessHandler.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE CPP #-} +-- | +-- Module : System.Process.Microlens.ProcessHandler +-- Copyright : 2019 Emily Pillmore +-- License : BSD +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : TypeFamilies, Rank2Types +-- +-- Convenient data type with associated optics + isos for working +-- with the output of a 'createProcess' call. +-- +module System.Process.Microlens.ProcessHandler +( -- * Types + ProcessHandler(..) + -- * Lenses +, hstdin +, hstdout +, hstderr +, hhandle +, _Handler + -- * Defaults +, defaultCreateProcess +) where + + +import Lens.Micro + +import System.IO +import System.Process + + +-- | A convenient handler for the output of a 'createProcess' call. +-- +data ProcessHandler = + ProcessHandler + { _hstdin :: Maybe Handle + -- ^ a handle to stdin if it was requested + , _hstdout :: Maybe Handle + -- ^ a handle to stdout if it was requested + , _hstderr :: Maybe Handle + -- ^ a handle to stderr if it was requested + , _hhandle :: ProcessHandle + -- ^ a process handle, containing a pid lock, information regarding + -- ctcl-c delegation, and closed/open handle status info. + } + +-- | A lens into the stdin handle if requested +-- +hstdin :: Lens' ProcessHandler (Maybe Handle) +hstdin = lens _hstdin (\t b -> t { _hstdin = b }) + +-- | A lens into the stdout handle if requested +-- +hstdout :: Lens' ProcessHandler (Maybe Handle) +hstdout = lens _hstdout (\t b -> t { _hstdout = b }) + +-- | A lens into the stderr handle if requested +-- +hstderr :: Lens' ProcessHandler (Maybe Handle) +hstderr = lens _hstderr (\t b -> t { _hstderr = b }) + +-- | A lens into the process handle +-- +hhandle :: Lens' ProcessHandler ProcessHandle +hhandle = lens _hhandle (\t b -> t { _hhandle = b }) + +-- | An isomorphism between a 'ProcessHandler' and its tuple representation +-- +_Handler :: Lens' ProcessHandler (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) +_Handler = lens + (\(ProcessHandler a b c d) -> (a,b,c,d)) + (\_ (a,b,c,d) -> ProcessHandler a b c d) + +-- | A default for a 'CreateProcess' +-- +defaultCreateProcess :: CreateProcess +defaultCreateProcess = + CreateProcess + { cmdspec = ShellCommand "" + , cwd = Nothing + , env = Nothing + , std_in = Inherit + , std_out = Inherit + , std_err = Inherit + , close_fds = False + , create_group = False + , delegate_ctlc = False + , new_session = False +#if MIN_VERSION_process(1, 3, 0) + , detach_console = False + , create_new_console = False +#endif +#if MIN_VERSION_process(1, 4, 0) + , child_group = Nothing + , child_user = Nothing +#endif +#if MIN_VERSION_process(1, 5, 0) + , use_process_jobs = False +#endif + } diff --git a/src/System/Process/Microlens/StdStream.hs b/src/System/Process/Microlens/StdStream.hs new file mode 100644 --- /dev/null +++ b/src/System/Process/Microlens/StdStream.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE Rank2Types #-} +-- | +-- Module : System.Process.Microlens.StdStream +-- Copyright : 2019 Emily Pillmore +-- License : BSD +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : TypeFamilies, Rank2Types +-- +-- This module provides the associated optics and combinators +-- for working with 'StdStream' objects. 'StdStream' consists of four +-- cases, for which we provide traversals for each case +-- +module System.Process.Microlens.StdStream +( -- * Traversals + _Inherit +, _UseHandle +, _CreatePipe +, _NoStream + -- * Classy Traversals +, IsCreatePipe(..) +, IsInherit(..) +, IsUseHandle(..) +, IsNoStream(..) + -- * Combinators +, inheriting +, piping +, handling +, nostreaming +) where + + +import Control.Applicative + +import Lens.Micro + +import System.IO (Handle) +import System.Process + + +-- $setup +-- >>> import Lens.Micro +-- >>> import qualified System.IO as System (stdin, stdout) +-- >>> import System.Process +-- >>> :set -XTypeApplications +-- >>> :set -XRank2Types + +-- ---------------------------------------------------------- -- +-- Traversals + +-- | A 'Traversal'' into the 'Inherit' structure of a 'StdStream' +-- +_Inherit :: Traversal' StdStream StdStream +_Inherit f s = case s of + Inherit -> f s + _ -> pure s + +-- | A 'Traversal'' into the 'UseHandle' structure's Handle for a 'StdStream' +-- +_UseHandle :: Traversal' StdStream Handle +_UseHandle f s = case s of + UseHandle h -> fmap UseHandle (f h) + _ -> pure s + +-- | A 'Traversal'' into the 'CreatePipe' structure of a 'StdStream' +-- +_CreatePipe :: Traversal' StdStream StdStream +_CreatePipe f s = case s of + CreatePipe -> f s + _ -> pure s + +-- | A 'Traversal'' into the 'NoStream' structure of a 'StdStream' +-- +_NoStream :: Traversal' StdStream StdStream +_NoStream f s = case s of + NoStream -> f s + _ -> pure s + +-- ---------------------------------------------------------- -- +-- Classes + +-- | Class constraint proving a type has a prism into an 'Inherit' +-- structure. Any 'StdStream' will have a prism into `Inherit' - +-- it is just an overwrite to 'Inherit' +-- +class IsInherit a where + _Inherits :: Traversal' a StdStream + {-# MINIMAL _Inherits #-} + +instance IsInherit StdStream where + _Inherits = _Inherit + +-- | Class constraint proving a type has a prism into a 'Handle' via +-- a 'UseHandle' structure. +-- +class IsUseHandle a where + _UsesHandle :: Traversal' a Handle + {-# MINIMAL _UsesHandle #-} + +instance IsUseHandle StdStream where + _UsesHandle = _UseHandle + +-- | Class constraint proving a type has a prism into a 'Handle' via +-- a 'UseHandle' structure. Any 'StdStream' will have a prism into +-- 'CreatePipe' - it is just an overwrite to 'CreatePipe' +-- +class IsCreatePipe a where + _CreatesPipe :: Traversal' a StdStream + {-# MINIMAL _CreatesPipe #-} + +instance IsCreatePipe StdStream where + _CreatesPipe = _CreatePipe + +-- | Class constraint proving a type has a prism into a 'Handle' via +-- a 'UseHandle' structure. Any 'StdStream' will have a prism into +-- 'NoStream' - it is just an overwrite to 'NoStream'. +-- +class IsNoStream a where + _NoStreams :: Traversal' a StdStream + {-# MINIMAL _NoStreams #-} + +instance IsNoStream StdStream where + _NoStreams = _NoStream + +-- ---------------------------------------------------------- -- +-- Combinators + +-- | Given a lens into a 'StdStream', overwrite to 'Inherit' so that +-- the stream inherits from its parent process +-- +-- Examples: +-- +-- >>> inheriting ($) CreatePipe +-- Inherit +-- +inheriting :: Lens' a StdStream -> a -> a +inheriting l = set l Inherit + +-- | Given a lens into a 'StdStream', overwrite to 'CreatePipe'. +-- +-- Examples: +-- +-- >>> piping ($) NoStream +-- CreatePipe +-- +piping :: Lens' a StdStream -> a -> a +piping l = set l CreatePipe + +-- | Given a lens into a 'StdStream' and a handle, set the handle using +-- 'UseHandle'. Note that this is the only really interesting case for anything +-- with a lens into a handle inculding 'StdStream'. +-- +-- Examples: +-- +-- +-- >>> handling ($) System.stdin $ UseHandle System.stdout +-- UseHandle {handle: } +-- +-- >>> handling ($) System.stdout Inherit +-- UseHandle {handle: } +-- +handling :: Lens' a StdStream -> Handle -> a -> a +handling l h = set l (UseHandle h) + +-- | Given a lens into a 'StdStream', set to 'NoStream' +-- +-- Examples: +-- +-- >>> nostreaming ($) Inherit +-- NoStream +-- +nostreaming :: Lens' a StdStream -> a -> a +nostreaming l = set l NoStream