packages feed

shell-utility (empty) → 0.0

raw patch · 9 files changed

+325/−0 lines, 9 filesdep +basesetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2019, Henning Thielemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ shell-utility.cabal view
@@ -0,0 +1,42 @@+Name:           shell-utility+Version:        0.0+License:        BSD3+License-File:   LICENSE+Author:         Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:     Henning Thielemann <haskell@henning-thielemann.de>+Homepage:       http://hub.darcs.net/thielema/shell-utility/+Category:       Console+Synopsis:       Utility functions for writing command-line programs+Description:+  Utility functions for writing command-line programs including+  parsing of numbers with restrictions and enumerations+  for command-line arguments,+  verbosity controlled output,+  escaping shell arguments, exit with message.+  .+  The package has very light dependencies and is Haskell 98.+Tested-With:    GHC==7.4.2, GHC==8.6.5+Cabal-Version:  >=1.6+Build-Type:     Simple+Source-Repository this+  Tag:         0.0+  Type:        darcs+  Location:    http://hub.darcs.net/thielema/shell-utility/++Source-Repository head+  Type:        darcs+  Location:    http://hub.darcs.net/thielema/shell-utility/++Library+  Build-Depends:+    base >=4.3 && <5++  GHC-Options:    -Wall+  Hs-Source-Dirs: src+  Exposed-Modules:+    Shell.Utility.Exit+    Shell.Utility.ParseArgument+    Shell.Utility.GetOpt+    Shell.Utility.Quote+    Shell.Utility.Verbosity+    Shell.Utility.Log
+ src/Shell/Utility/Exit.hs view
@@ -0,0 +1,33 @@+{- |+The Exit mechanism is not compositional+and thus should not be used in larger long-running programs.+However, in small command-line utilities+and especially for signaling errors in command-line arguments+it is acceptable.++The 'IO' instance is useful for 'GetOpt' and immediate exit.+The 'Either' instance is useful for 'Optparse.Applicative.eitherReader'.+-}+module Shell.Utility.Exit where++import qualified System.Exit as Exit+import qualified System.IO as IO++import Control.Applicative (Applicative)++import Data.String (IsString, fromString)+++class Applicative f => Exit f where+   {- |+   Also known as 'System.Exit.die' in newer versions of 'base'.+   -}+   exitFailureMsg :: String -> f a++instance Exit IO where+   exitFailureMsg msg = do+      IO.hPutStrLn IO.stderr msg+      Exit.exitFailure++instance (IsString str) => Exit (Either str) where+   exitFailureMsg = Left . fromString
+ src/Shell/Utility/GetOpt.hs view
@@ -0,0 +1,15 @@+module Shell.Utility.GetOpt where++import qualified System.Console.GetOpt as G+++fmapArgDescr :: (a -> b) -> (G.ArgDescr a -> G.ArgDescr b)+fmapArgDescr f d =+    case d of+        G.NoArg a -> G.NoArg $ f a+        G.ReqArg g str -> G.ReqArg (f.g) str+        G.OptArg g str -> G.OptArg (f.g) str++fmapOptDescr :: (a -> b) -> (G.OptDescr a -> G.OptDescr b)+fmapOptDescr f (G.Option short long arg help) =+    G.Option short long (fmapArgDescr f arg) help
+ src/Shell/Utility/Log.hs view
@@ -0,0 +1,70 @@+{- |+Primitive verbosity controlled logging.+-}+module Shell.Utility.Log (+   warn, notice, info, debug,+   wrapWords,+   ) where++import Shell.Utility.Verbosity++import qualified System.IO as IO+import Control.Monad (when)++import qualified Data.List as List+++{- |+Non fatal condition that may indicate a problem.++Display on 'IO.stderr' at 'normal' verbosity and above.+-}+warn :: Verbosity -> String -> IO ()+warn = atLevel normal $ IO.hPutStrLn IO.stderr . ("Warning: " ++)++{- |+Useful status message.++Display at 'normal' verbosity and above.++This is for the ordinary helpful status messages that users see.+Just enough information to know that things are working+but not floods of detail.+-}+notice :: Verbosity -> String -> IO ()+notice = atLevel normal putStrLn++{- |+More detail on the operation of some action.++Display at 'verbose' verbosity and above.+-}+info :: Verbosity -> String -> IO ()+info = atLevel verbose putStrLn++{- |+Detailed internal debugging information++Display for 'deafening' verbosity.+-}+debug :: Verbosity -> String -> IO ()+debug = atLevel deafening putStrLn++atLevel ::+   (Monad m, Ord verbosity) =>+   verbosity -> (msg -> m ()) -> verbosity -> msg -> m ()+atLevel minVerbosity act verbosity msg =+   when (verbosity >= minVerbosity) $ act msg+++wrapWords :: Int -> [String] -> String+wrapWords width =+   drop 1 . concat . snd .+   List.mapAccumL+      (\pos w ->+         let len = length w+             newPos = pos + 1 + len+         in if newPos <= width+               then (newPos, ' ':w)+               else (len, '\n':w))+      (-1)
+ src/Shell/Utility/ParseArgument.hs view
@@ -0,0 +1,39 @@+{- |+Both "System.Console.GetOpt" and "Optparse.Applicative"+do not have built-in support for number or enumeration arguments.+But there is usually a lot to check,+e.g. whether numbers are positive, not too big, etc.+We provide argument parsers here in a way that can be used+in all command-line parsing libraries.+-}+module Shell.Utility.ParseArgument where++import qualified Shell.Utility.Exit as Exit++import Control.Applicative (pure)+import Text.Printf (printf)+import Data.Maybe (listToMaybe)+++parseNumber ::+   (Exit.Exit m, Read a) => String -> (a -> Bool) -> String -> String -> m a+parseNumber name constraint constraintName str =+   case reads str of+      [(n, "")] ->+         if constraint n+            then pure n+            else Exit.exitFailureMsg $+                 name ++ " must be a " ++ constraintName ++ " number"+      _ ->+         Exit.exitFailureMsg $+         name ++ " must be a number, but is '" ++ str ++ "'"+++enumMaybe :: (Bounded a, Enum a, Eq str) => (a -> str) -> str -> Maybe a+enumMaybe fmt str =+   listToMaybe $ dropWhile ((str/=) . fmt) [minBound .. maxBound]++enumeration ::+   (Bounded a, Enum a) => String -> (a -> String) -> String -> Either String a+enumeration name fmt str =+   maybe (Left $ printf "unknown %s: %s" name str) Right $ enumMaybe fmt str
+ src/Shell/Utility/Quote.hs view
@@ -0,0 +1,47 @@+module Shell.Utility.Quote (always, minimal, lazy) where++mustEscape, mustQuote :: [Char]+mustEscape = "\"$`\\!"+mustQuote = "' \t\n|&;()<>{}[]*?^#"+++{- |+Escape a single character if it is necessary to escape it even within quotes.+The exclamation mark is also escaped+for compatibility with the history expansion misfeature of Bash.+-}+escapeChar :: Char -> String+escapeChar c = (if elem c mustEscape then ('\\':) else id) [c]+++enclose :: String -> String+enclose txt = '"' : txt ++ '"' : []++{- |+Put a string in quotes and escape characters as necessary.+This allows you to construct shell commands+such that a shell interprets the arguments in the right way.+-}+always :: String -> String+always = enclose . concatMap escapeChar++{- |+Like 'always' but encloses in quotes only if necessary.+-}+minimal :: String -> String+minimal txt =+   if null txt || any (flip elem mustQuote) txt+      then always txt+      else concatMap escapeChar txt++{- |+Similar to 'minimal' but starts quoting only as soon as it becomes necessary.+This is lazy both with respect to quoting and with respect to processing.+-}+lazy :: String -> String+lazy "" = "\"\""+lazy txt =+   let go "" = ""+       go str@(c:cs) =+         if elem c mustQuote then always str else escapeChar c ++ go cs+   in go txt
+ src/Shell/Utility/Verbosity.hs view
@@ -0,0 +1,45 @@+module Shell.Utility.Verbosity (+   Verbosity,+   silent, normal, verbose, deafening,+   parse,+   ) where++import qualified Shell.Utility.Exit as Exit++import Control.Applicative (pure)+++data Verbosity = Silent | Normal | Verbose | Deafening+   deriving (Show, Read, Eq, Ord, Enum, Bounded)+++-- | We shouldn't print /anything/ unless an error occurs in silent mode+silent :: Verbosity+silent = Silent++-- | Print stuff we want to see by default+normal :: Verbosity+normal = Normal++-- | Be more verbose about what's going on+verbose :: Verbosity+verbose = Verbose++{- |+Not only are we verbose ourselves+(perhaps even noisier than when being 'verbose'),+but we tell everything we run to be verbose too+-}+deafening :: Verbosity+deafening = Deafening++parse :: (Exit.Exit m) => String -> m Verbosity+parse "" = Exit.exitFailureMsg "empty verbosity identifier"+parse [c] =+   case c of+      '0' -> pure Silent+      '1' -> pure Normal+      '2' -> pure Verbose+      '3' -> pure Deafening+      _ -> Exit.exitFailureMsg "verbosity must be a number from [0..3]"+parse _ = Exit.exitFailureMsg "more than one character for verbosity"