diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,9 @@ +shell-monad (0.5.0) unstable; urgency=medium + + * newVarContaining is generalized to work for all showable data types. + + -- Joey Hess Sat, 27 Dec 2014 17:10:23 -0400 + shell-monad (0.4.0) unstable; urgency=medium * Var now has a phantom type. This allows the haskell type checker diff --git a/Control/Monad/Shell.hs b/Control/Monad/Shell.hs --- a/Control/Monad/Shell.hs +++ b/Control/Monad/Shell.hs @@ -4,8 +4,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleContexts #-} module Control.Monad.Shell ( -- * Core @@ -13,8 +13,9 @@ script, linearScript, Var, + Val(..), Quoted, - quote, + Quotable(..), glob, -- * Running commands run, @@ -22,7 +23,6 @@ Param, CmdParams, Output(..), - Val(..), -- * Shell variables NamedLike(..), NameHinted, @@ -79,6 +79,8 @@ import System.Posix.Types (Fd) import System.Posix.IO (stdInput, stdOutput, stdError) +import Control.Monad.Shell.Quote + -- | A shell variable, with an associated phantom type. newtype Var a = Var UntypedVar @@ -102,22 +104,6 @@ , expandVar = \_ (VarName n) -> Q ("$" <> n) } --- | A value that is safely quoted. -newtype Quoted a = Q { getQ :: a } - deriving (Eq, Ord, Show, Monoid) - --- | Quotes the Text to allow it to be safely exposed to the shell. --- --- The method used is to replace ' with '"'"' and wrap the value inside --- single quotes. This works for POSIX shells, as well as other shells --- like csh. -quote :: L.Text -> Quoted L.Text -quote t - | L.all (\c -> isAlphaNum c || c == '_') t = Q t - | otherwise = Q $ q <> L.intercalate "'\"'\"'" (L.splitOn q t) <> q - where - q = "'" - -- | Treats the Text as a glob, which expands to one parameter per -- matching file. -- @@ -341,13 +327,13 @@ -- | Any value that can be shown can be passed to 'cmd'; just wrap it -- inside a Val. instance (Show v) => Param (Val v) where - toTextParam (Val v) = const $ L.pack (show v) + toTextParam (Val v) = const $ L.pack (show v) --- | Var arguments cause the (quoted) value of a shell variable to be --- passed to the command. instance Param UntypedVar where toTextParam v = \env -> "\"" <> getQ (expandVar v env (varName v)) <> "\"" +-- | Var arguments cause the (quoted) value of a shell variable to be +-- passed to the command. instance Param (Var a) where toTextParam (Var v) = toTextParam v @@ -393,9 +379,6 @@ -- > cmd "echo" "root's pwent" (Output (cmd "cat" "/etc/passwd" -|- cmd "grep" "root")) newtype Output = Output (Script ()) --- | An arbitrary value. -newtype Val v = Val v - -- | Allows modifying the value of a variable before it is passed to a -- command. The function is passed a Quoted Text which will expand to the -- value of the variable, and can modify it, by using eg 'mappend'. @@ -439,15 +422,22 @@ -- The namehint can influence this name, but is modified to ensure -- uniqueness. newVar :: (NameHinted namehint) => forall a. namehint -> Script (Var a) -newVar = newVarContaining "" +newVar = newVarContaining' "" --- | Creates a new shell variable, with an initial value. -newVarContaining :: (NameHinted namehint) => forall a. L.Text -> namehint -> Script (Var a) -newVarContaining value = hinted $ \namehint -> do +newVarContaining' :: (NameHinted namehint) => L.Text -> namehint -> Script (Var t) +newVarContaining' value = hinted $ \namehint -> do v@(Var (V { varName = VarName name })) <- newVarUnsafe namehint - Script $ \env -> ([Cmd (name <> "=" <> getQ (quote value))], env, v) + Script $ \env -> ([Cmd (name <> "=" <> value)], env, v) +-- | Createa a new shell variable, with an initial value which can +-- be anything that can be shown. +-- +-- > s <- newVarContaining "foo bar baz" (NamedLike "s") +-- > i <- newVarContaining (1 :: Int) (NamedLine "i") +newVarContaining :: (NameHinted namehint, Quotable (Val t)) => t -> namehint -> Script (Var t) +newVarContaining = newVarContaining' . getQ . quote . Val + -- | Sets the Var to the value of the param. setVar :: Param param => forall a. Var a -> param -> Script () setVar (Var (V { varName = VarName name })) p = Script $ \env -> @@ -545,7 +535,7 @@ -- -- Note that 'lengthVar positionalParameters' expands to the number -- of positional parameters. -lengthVar :: forall a. Var a -> Script (Var Int) +lengthVar :: forall a. Var a -> Script (Var Integer) -- Implementation note: ${#${foo:-bar}} is not legal shell code. -- So, to allow taking the length of Vars that expand to such things, -- a temporary Var is created, assigned to the expansion of the input Var. diff --git a/Control/Monad/Shell/Quote.hs b/Control/Monad/Shell/Quote.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Shell/Quote.hs @@ -0,0 +1,55 @@ +-- | Shell quoting + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverlappingInstances #-} + +module Control.Monad.Shell.Quote ( + Quoted(..), + Quotable(..), + Val(..), +) where + +import qualified Data.Text.Lazy as L +import Data.Monoid +import Data.Char + +-- | A value that is safely quoted so that it can be exposed to the shell. +-- +-- While the constructor is exposed, you should avoid directly constucting +-- Quoted values. Instead, use 'quote'. +newtype Quoted a = Q { getQ :: a } + deriving (Eq, Ord, Show, Monoid) + +-- | Quotes a value to allow it to be safely exposed to the shell. +-- +-- The method used is to replace ' with '"'"' and wrap the value inside +-- single quotes. This works for POSIX shells, as well as other shells +-- like csh. +class Quotable t where + quote :: t -> Quoted L.Text + +instance Quotable L.Text where + quote t + | L.all (\c -> isAlphaNum c || c == '_') t = Q t + | otherwise = Q $ q <> L.intercalate "'\"'\"'" (L.splitOn q t) <> q + where + q = "'" + +instance Quotable String where + quote = quote . L.pack + +-- | Any Showable value can be quoted, just use 'quote (Val v)' +instance (Show v) => Quotable (Val v) where + quote (Val v) = quote $ show v + +-- To avoid double-quoting Text and String, override the above instance. +-- This needs OverlappingInstances +instance Quotable (Val L.Text) where + quote (Val s) = quote s +instance Quotable (Val String) where + quote (Val s) = quote s + +-- | An arbitrary value. +newtype Val v = Val v diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,1 +1,6 @@ * nicer interface for the `test` command (aka `[`) +* setVar allows `Var a` to be set to any value, the value + is not constrained to be of type `a`. This seems necessary + to allow, eg, `setVar v (Output (cmd "read"))`. On other + hand, it's subptimal when using setVar with a Arith; in this + case `a` should be some Integral. diff --git a/examples/fib.hs b/examples/fib.hs --- a/examples/fib.hs +++ b/examples/fib.hs @@ -3,7 +3,6 @@ import Control.Monad.Shell import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.IO as T -import Data.Monoid default (T.Text) main :: IO () @@ -19,4 +18,4 @@ setVar prev (AVar acc `AMinus` AVar prev) return acc where - new1 = newVarContaining "1" () :: Script (Var Integer) + new1 = newVarContaining 1 () diff --git a/shell-monad.cabal b/shell-monad.cabal --- a/shell-monad.cabal +++ b/shell-monad.cabal @@ -1,5 +1,5 @@ Name: shell-monad -Version: 0.4.0 +Version: 0.5.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess @@ -21,7 +21,9 @@ Library GHC-Options: -Wall - Exposed-Modules: Control.Monad.Shell + Exposed-Modules: + Control.Monad.Shell + Control.Monad.Shell.Quote Build-Depends: base (>= 4.5), base < 5, containers, text, unix source-repository head